Implement 5.25 lazy-evaluation

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")
 

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 env)
-  (save unev)
+  ;(save unev)
-  (assign continue (label ev-appl-accumulate-arg-delay))
+  (assign val (op delay-it) (reg exp) (reg env))
-  (goto (label eval-dispatch))
+  ;(assign continue (label ev-appl-accumulate-arg-delay))
+  ;(goto (label eval-dispatch))
 ev-appl-accumulate-arg-delay
-  (restore unev)
+  ;(restore unev)
-  (restore env)
+  ;(restore env)
-  (restore argl)
+  ;(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))
+  (assign val (op delay-it) (reg exp) (reg env))
-  (goto (label eval-dispatch))
+  ;(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
    )))