diff --git a/ex-5_23-30.scm b/ex-5_23-30.scm new file mode 100644 index 0000000..aa86d5d --- /dev/null +++ b/ex-5_23-30.scm @@ -0,0 +1,145 @@ +(load "util.scm") +(load "misc/sicp-regsim.scm") +(load "misc/sicp-eceval.scm") + +(define the-global-environment (setup-environment)) +(set-register-contents! eceval 'exp '(if false 1 2)) +(start eceval) +(assert (get-register-contents eceval 'val) 2) + +(display "\nex-5.23 - derived-expressions\n") + +(set-register-contents! eceval 'exp + '(cond + ((= 1 2) 0) + ((= 2 3) 1) + ((= 0 4) 2) + (else 3))) +(start eceval) +(assert (get-register-contents eceval 'val) 3) + +(set-register-contents! eceval 'exp + '(begin + (define (square x) (* x x)) + (let ((y (square 3))) + y))) +(start eceval) +(assert (get-register-contents eceval 'val) 9) + + +(display "\nex-5.24 - cond-special-form\n") + +(set-register-contents! eceval 'exp + '(cond + ((= 2 1) 0) + ((= 2 3) 1) + ((= 0 4) 2) + (else (* 2 5)))) +(start eceval) +(assert (get-register-contents eceval 'val) 10) + +(display "\nex-5.25 - lazy-evaluation\n") + +(set-register-contents! eceval-lazy 'exp + '(begin + (define (try a b) + (if (= a 0) 1 b)) + (try 0 (/ 1 0)))) +(start eceval-lazy) +(assert (get-register-contents eceval-lazy 'val) 1) + + +(display "\nex-5.26 - fact-iter-stack-analysis\n") + +(set-register-contents! eceval 'exp + '(begin + (define (factorial n) + (define (iter product counter) + (if (> counter n) + product + (iter (* product counter) (+ counter 1)))) + (iter 1 1)) + (factorial 5))) +(start eceval) +(assert (get-register-contents eceval 'val) 120) + +; | 1 | 2 | 3 | 4 | 5 | n +; |----|----|----|----|----| +; | 10| 10| 10| 10| 10| depth +; | 70| 105| 140| 175| 210| push count + +; depth = 10 +; push-count = 35 * (n + 1) + +(display "\nex-5.27 - fact-rec-stack-analysis\n") + +(set-register-contents! eceval 'exp + '(begin + (define (factorial n) + (if (= n 1) + 1 + (* n (factorial (- n 1))))) + (factorial 5))) +(start eceval) +(assert (get-register-contents eceval 'val) 120) + +; | 1 | 2 | 3 | 4 | 5 | n +; |----|----|----|----|----| +; | 8| 11| 14| 17| 20| depth +; | 22| 54| 86| 118| 150| push count + +; depth = 5 + n * 3 +; push-count = 22 + (n - 1) * 32 + +(display "\nex-5.28 - fact-lazy-stack-analysis\n") + +(set-register-contents! eceval-lazy 'exp + '(begin + (define (factorial n) + (define (iter product counter) + (if (> counter n) + product + (iter (* product counter) (+ counter 1)))) + (iter 1 1)) + (factorial 5))) +(start eceval-lazy) +(assert (get-register-contents eceval-lazy 'val) 120) + +(set-register-contents! eceval-lazy 'exp + '(begin + (define (factorial n) + (if (= n 1) + 1 + (* n (factorial (- n 1))))) + (factorial 5))) +(start eceval-lazy) +(assert (get-register-contents eceval-lazy 'val) 120) + +; | 1 | 2 | 3 | 4 | 5 | n +; |----|----|----|----|----| +; lazy-iter | 13| 18| 23| 28| 33| depth +; | 61| 108| 171| 250| 345| push count +; |----|----|----|----|----| +; lazy-rec | 8| 16| 24| 32| 40| depth +; | 21| 52| 99| 162| 241| push count + +(display "\nex-5.29 - fib-stack-analysis\n") + +(set-register-contents! eceval 'exp + '(begin + (define (fib n) + (if (< n 2) + n + (+ (fib (- n 1)) (fib (- n 2))))) + (fib 7))) +(start eceval) +(assert (get-register-contents eceval 'val) 13) + +; | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | +; |----|----|----|----|----|----|----|----|----|----| +; | | | | | | | | | | | depth +; | | | | | | | | | | | push count + +(display "\nex-5.30\n") + + diff --git a/ex-5_23-xx.scm b/ex-5_23-xx.scm deleted file mode 100644 index 5ffd654..0000000 --- a/ex-5_23-xx.scm +++ /dev/null @@ -1,52 +0,0 @@ -(load "util.scm") -(load "misc/sicp-regsim.scm") -(load "misc/sicp-eceval.scm") - -(define the-global-environment (setup-environment)) -(set-register-contents! eceval 'exp '(if false 1 2)) -(start eceval) -(assert (get-register-contents eceval 'val) 2) - -(display "\nex-5.23 - derived-expressions\n") - -(set-register-contents! eceval 'exp - '(cond - ((= 1 2) 0) - ((= 2 3) 1) - ((= 0 4) 2) - (else 3))) -(start eceval) -(assert (get-register-contents eceval 'val) 3) - -(set-register-contents! eceval 'exp - '(begin - (define (square x) (* x x)) - (let ((y (square 3))) - y))) -(start eceval) -(assert (get-register-contents eceval 'val) 9) - - -(display "\nex-5.24 - cond-special-form\n") - -(set-register-contents! eceval 'exp - '(cond - ((= 2 1) 0) - ((= 2 3) 1) - ((= 0 4) 2) - (else (* 2 5)))) -(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 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 972e8e6..3583071 100644 --- a/misc/sicp-eceval.scm +++ b/misc/sicp-eceval.scm @@ -102,7 +102,9 @@ )) -(define eceval +; Below is the original version of the evaluator-machine from the book modified +; for lazy-evaluation. +(define eceval-lazy (make-machine '(exp env val proc argl continue unev) eceval-operations @@ -393,6 +395,245 @@ ev-thunk-before-done (assign continue (label ev-done)) (goto (label eval-dispatch)) ev-done - ))) + ;;(perform (op print-stack-statistics)) + ))) + +; Below is the original version of the evaluator from the book without the +; read-eval-print loop. We assign to the expression before we start the +; machine. The machine has added support for let and cond. +(define eceval + (make-machine + '(exp env val proc argl continue unev) + eceval-operations + '( + (perform (op initialize-stack)) + (assign env (op get-global-environment)) + (assign continue (label ev-done)) + (goto (label eval-dispatch)) + +unknown-expression-type + (assign val (const unknown-expression-type-error)) + (goto (label signal-error)) + +unknown-procedure-type + (restore continue) + (assign val (const unknown-procedure-type-error)) + (goto (label signal-error)) + +signal-error + (perform (op user-print) (reg val)) + (goto (label ev-done)) + +;;SECTION 5.4.1 +eval-dispatch + (test (op cond?) (reg exp)) + (branch (label ev-cond)) + (test (op let?) (reg exp)) + (branch (label ev-let)) + (test (op self-evaluating?) (reg exp)) + (branch (label ev-self-eval)) + (test (op variable?) (reg exp)) + (branch (label ev-variable)) + (test (op quoted?) (reg exp)) + (branch (label ev-quoted)) + (test (op assignment?) (reg exp)) + (branch (label ev-assignment)) + (test (op definition?) (reg exp)) + (branch (label ev-definition)) + (test (op if?) (reg exp)) + (branch (label ev-if)) + (test (op lambda?) (reg exp)) + (branch (label ev-lambda)) + (test (op begin?) (reg exp)) + (branch (label ev-begin)) + (test (op application?) (reg exp)) + (branch (label ev-application)) + (goto (label unknown-expression-type)) + +ev-self-eval + (assign val (reg exp)) + (goto (reg continue)) +ev-variable + (assign val (op lookup-variable-value) (reg exp) (reg env)) + (goto (reg continue)) +ev-quoted + (assign val (op text-of-quotation) (reg exp)) + (goto (reg continue)) +ev-lambda + (assign unev (op lambda-parameters) (reg exp)) + (assign exp (op lambda-body) (reg exp)) + (assign val (op make-procedure) + (reg unev) (reg exp) (reg env)) + (goto (reg continue)) + +ev-application + (save continue) + (save env) + (assign unev (op operands) (reg exp)) + (save unev) + (assign exp (op operator) (reg exp)) + (assign continue (label ev-appl-did-operator)) + (goto (label eval-dispatch)) +ev-appl-did-operator + (restore unev) + (restore env) + (assign argl (op empty-arglist)) + (assign proc (reg val)) + (test (op no-operands?) (reg unev)) + (branch (label apply-dispatch)) + (save proc) +ev-appl-operand-loop + (save argl) + (assign exp (op first-operand) (reg unev)) + (test (op last-operand?) (reg unev)) + (branch (label ev-appl-last-arg)) + (save env) + (save unev) + (assign continue (label ev-appl-accumulate-arg)) + (goto (label eval-dispatch)) +ev-appl-accumulate-arg + (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 eval-dispatch)) +ev-appl-accum-last-arg + (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)) + (test (op compound-procedure?) (reg proc)) + (branch (label compound-apply)) + (goto (label unknown-procedure-type)) + +primitive-apply + (assign val (op apply-primitive-procedure) + (reg proc) + (reg argl)) + (restore continue) + (goto (reg continue)) + +compound-apply + (assign unev (op procedure-parameters) (reg proc)) + (assign env (op procedure-environment) (reg proc)) + (assign env (op extend-environment) + (reg unev) (reg argl) (reg env)) + (assign unev (op procedure-body) (reg proc)) + (goto (label ev-sequence)) + +;;;SECTION 5.4.2 +ev-begin + (assign unev (op begin-actions) (reg exp)) + (save continue) + (goto (label ev-sequence)) + +ev-cond + (save continue) + (assign unev (op cond-clauses) (reg exp)) ; unev contains all clauses +ev-cond-loop + (assign exp (op cond-first-clause) (reg unev)) ; exp contains first clause + (test (op cond-else-clause?) (reg exp)) ; test for else-clause + (branch (label ev-cond-done)) + (assign continue (label ev-cond-decide)) + (save unev) + (assign exp (op cond-predicate) (reg exp)) ; exp contains first predicate + (goto (label eval-dispatch)) ; eval predicate +ev-cond-decide + (restore unev) + (test (op true?) (reg val)) ; test if predicate is true + (branch (label ev-cond-done)) + (assign unev (op cond-clauses) (reg unev)) ; unev contains remainging clauses + (goto (label ev-cond-loop)) +ev-cond-done + (restore continue) + (assign exp (op cond-first-clause) (reg unev)) ; exp contains true clause + (goto (label ev-begin)) + +ev-let + (assign exp (op let->combination) (reg exp)) + (goto (label eval-dispatch)) + +ev-sequence + (assign exp (op first-exp) (reg unev)) + (test (op last-exp?) (reg unev)) + (branch (label ev-sequence-last-exp)) + (save unev) + (save env) + (assign continue (label ev-sequence-continue)) + (goto (label eval-dispatch)) +ev-sequence-continue + (restore env) + (restore unev) + (assign unev (op rest-exps) (reg unev)) + (goto (label ev-sequence)) +ev-sequence-last-exp + (restore continue) + (goto (label eval-dispatch)) + +;;;SECTION 5.4.3 + +ev-if + (save exp) + (save env) + (save continue) + (assign continue (label ev-if-decide)) + (assign exp (op if-predicate) (reg exp)) + (goto (label eval-dispatch)) +ev-if-decide + (restore continue) + (restore env) + (restore exp) + (test (op true?) (reg val)) + (branch (label ev-if-consequent)) +ev-if-alternative + (assign exp (op if-alternative) (reg exp)) + (goto (label eval-dispatch)) +ev-if-consequent + (assign exp (op if-consequent) (reg exp)) + (goto (label eval-dispatch)) + +ev-assignment + (assign unev (op assignment-variable) (reg exp)) + (save unev) + (assign exp (op assignment-value) (reg exp)) + (save env) + (save continue) + (assign continue (label ev-assignment-1)) + (goto (label eval-dispatch)) +ev-assignment-1 + (restore continue) + (restore env) + (restore unev) + (perform + (op set-variable-value!) (reg unev) (reg val) (reg env)) + (assign val (const ok)) + (goto (reg continue)) + +ev-definition + (assign unev (op definition-variable) (reg exp)) + (save unev) + (assign exp (op definition-value) (reg exp)) + (save env) + (save continue) + (assign continue (label ev-definition-1)) + (goto (label eval-dispatch)) +ev-definition-1 + (restore continue) + (restore env) + (restore unev) + (perform + (op define-variable!) (reg unev) (reg val) (reg env)) + (assign val (const ok)) + (goto (reg continue)) +ev-done + ;(perform (op print-stack-statistics)) + ))) '(EXPLICIT CONTROL EVALUATOR LOADED)