diff --git a/ex-5_23-xx.scm b/ex-5_23-xx.scm index afd15f1..5ffd654 100644 --- a/ex-5_23-xx.scm +++ b/ex-5_23-xx.scm @@ -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") diff --git a/misc/sicp-eceval.scm b/misc/sicp-eceval.scm index ced4ac4..972e8e6 100644 --- a/misc/sicp-eceval.scm +++ b/misc/sicp-eceval.scm @@ -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 )))