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

Implement 5.25 lazy-evaluation

main
Felix Martin 2021-04-08 08:48:37 -04:00
parent 5902b43652
commit 1851b11288
2 changed files with 36 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ex-5_23-xx.scm
View File

@ -38,17 +38,15 @@
(start eceval)
(assert (get-register-contents eceval 'val) 10)
(display "\nex-5.25 - lazy-evaluation\n")
(set-register-contents! eceval 'exp
'(begin
(define (try a b)
(if (= a 0) 1 b))
(try 0 (/ 1 1))))
(try 0 (/ 1 0))))
(start eceval)
(assert (get-register-contents eceval 'val) 1)
(display "\nex-5.26\n")

47
misc/sicp-eceval.scm
View File

@ -97,6 +97,8 @@
;;5.25
(list 'delay-it delay-it)
(list 'thunk? thunk?)
(list 'thunk-exp thunk-exp)
(list 'thunk-env thunk-env)
))
@ -108,7 +110,7 @@
(perform (op initialize-stack))
(assign env (op get-global-environment))
(assign continue (label ev-done))
(assign continue (label ev-almost-done))
(goto (label eval-dispatch))
unknown-expression-type
@ -187,6 +189,12 @@ ev-appl-did-operator
(branch (label ev-appl-operand-loop-force))
(test (op compound-procedure?) (reg proc))
(branch (label ev-appl-operand-loop-delay))
(goto (label unknown-procedure-type))
ev-force-it
(assign env (op thunk-env) (reg val))
(assign exp (op thunk-exp) (reg val))
(goto (label eval-dispatch))
ev-appl-operand-loop-force
(save argl)
@ -198,6 +206,8 @@ ev-appl-operand-loop-force
(assign continue (label ev-appl-accumulate-arg-force))
(goto (label eval-dispatch))
ev-appl-accumulate-arg-force
(test (op thunk?) (reg val))
(branch (label ev-force-it))
(restore unev)
(restore env)
(restore argl)
@ -208,32 +218,36 @@ ev-appl-last-arg-force
(assign continue (label ev-appl-accum-last-arg-force))
(goto (label eval-dispatch))
ev-appl-accum-last-arg-force
(test (op thunk?) (reg val))
(branch (label ev-force-it))
(restore argl)
(assign argl (op adjoin-arg) (reg val) (reg argl))
(restore proc)
(goto (label apply-dispatch))
ev-appl-operand-loop-delay
(save argl)
;(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))
;(save env)
;(save unev)
(assign val (op delay-it) (reg exp) (reg env))
;(assign continue (label ev-appl-accumulate-arg-delay))
;(goto (label eval-dispatch))
ev-appl-accumulate-arg-delay
(restore unev)
(restore env)
(restore argl)
;(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))
(assign val (op delay-it) (reg exp) (reg env))
;(assign continue (label ev-appl-accum-last-arg-delay))
;(goto (label eval-dispatch))
ev-appl-accum-last-arg-delay
(restore argl)
;(restore argl)
(assign argl (op adjoin-arg) (reg val) (reg argl))
(restore proc)
(goto (label apply-dispatch))
@ -369,6 +383,15 @@ ev-definition-1
(op define-variable!) (reg unev) (reg val) (reg env))
(assign val (const ok))
(goto (reg continue))
ev-almost-done
(test (op thunk?) (reg val))
(branch (label ev-thunk-before-done))
(goto (label ev-done))
ev-thunk-before-done
(assign env (op thunk-env) (reg val))
(assign exp (op thunk-exp) (reg val))
(assign continue (label ev-done))
(goto (label eval-dispatch))
ev-done
)))