felixm/SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Work on 5.25

Browse Source
This commit is contained in:
Felix Martin
2021-04-07 22:14:42 -04:00
parent 80fb79b001
commit 5902b43652
2 changed files with 138 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
misc/sicp-eceval.scm
View File

@@ -13,6 +13,7 @@
;: (start eceval)
(load "misc/sicp-eceval-support.scm")
(load "misc/sicp-leval.scm")
;; To restart, can do just
;: (start eceval)
@@ -92,6 +93,11 @@
(list 'cond? cond?)
(list 'let->combination let->combination)
(list 'let? let?)
;;5.25
(list 'delay-it delay-it)
(list 'thunk? thunk?)
))
(define eceval
@@ -176,30 +182,62 @@ ev-appl-did-operator
(test (op no-operands?) (reg unev))
(branch (label apply-dispatch))
(save proc)
ev-appl-operand-loop
(test (op primitive-procedure?) (reg proc))
(branch (label ev-appl-operand-loop-force))
(test (op compound-procedure?) (reg proc))
(branch (label ev-appl-operand-loop-delay))
ev-appl-operand-loop-force
(save argl)
(assign exp (op first-operand) (reg unev))
(test (op last-operand?) (reg unev))
(branch (label ev-appl-last-arg))
(branch (label ev-appl-last-arg-force))
(save env)
(save unev)
(assign continue (label ev-appl-accumulate-arg))
(assign continue (label ev-appl-accumulate-arg-force))
(goto (label eval-dispatch))
ev-appl-accumulate-arg
ev-appl-accumulate-arg-force
(restore unev)
(restore env)
(restore argl)
(assign argl (op adjoin-arg) (reg val) (reg argl))
(assign unev (op rest-operands) (reg unev))
(goto (label ev-appl-operand-loop))
ev-appl-last-arg
(assign continue (label ev-appl-accum-last-arg))
(goto (label ev-appl-operand-loop-force))
ev-appl-last-arg-force
(assign continue (label ev-appl-accum-last-arg-force))
(goto (label eval-dispatch))
ev-appl-accum-last-arg
ev-appl-accum-last-arg-force
(restore argl)
(assign argl (op adjoin-arg) (reg val) (reg argl))
(restore proc)
(goto (label apply-dispatch))
ev-appl-operand-loop-delay
(save argl)
(assign exp (op first-operand) (reg unev))
(test (op last-operand?) (reg unev))
(branch (label ev-appl-last-arg-delay))
(save env)
(save unev)
(assign continue (label ev-appl-accumulate-arg-delay))
(goto (label eval-dispatch))
ev-appl-accumulate-arg-delay
(restore unev)
(restore env)
(restore argl)
(assign argl (op adjoin-arg) (reg val) (reg argl))
(assign unev (op rest-operands) (reg unev))
(goto (label ev-appl-operand-loop-delay))
ev-appl-last-arg-delay
(assign continue (label ev-appl-accum-last-arg-delay))
(goto (label eval-dispatch))
ev-appl-accum-last-arg-delay
(restore argl)
(assign argl (op adjoin-arg) (reg val) (reg argl))
(restore proc)
(goto (label apply-dispatch))
apply-dispatch
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-apply))