From 363f49d434ddca9c5ab63b0e24f9eb04a9157c97 Mon Sep 17 00:00:00 2001 From: Felix Martin Date: Sat, 1 May 2021 18:08:17 -0400 Subject: [PATCH] Implement 5.48 --- ex-5_45-xx.scm | 19 ++++++++++++++++--- shared/sicp-eceval-compiler.scm | 20 ++++++++++++++++++++ 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/ex-5_45-xx.scm b/ex-5_45-xx.scm index 281c69a..5d5ed72 100644 --- a/ex-5_45-xx.scm +++ b/ex-5_45-xx.scm @@ -152,10 +152,23 @@ (display "[done]\n") -(display "\nex-5.48\n") +(display "\nex-5.48 - compile-and-run\n") + +;; compile-and-go is implemented in sicp-eceval-compiler.scm +(start-eceval) +;; To test this exercise uncomment the previous line, then: +;; $ mit-scheme +;; 1 ]=> (load "ex-5_45-xx") +;; 2 ]=> (compile-and-run (define (f n) (if (= n 1) 1 (* n (f (- n 1)))))) +;; 3 ]=> (f 5) + +(display "[done]\n") + +(display "\nex-5.49\n") + +(display "\nex-5.50\n") + -; (display "\nex-5.49\n") -; (display "\nex-5.50\n") ; (display "\nex-5.51\n") ; (display "\nex-5.52\n") diff --git a/shared/sicp-eceval-compiler.scm b/shared/sicp-eceval-compiler.scm index b0d1070..51a536b 100644 --- a/shared/sicp-eceval-compiler.scm +++ b/shared/sicp-eceval-compiler.scm @@ -57,6 +57,16 @@ (set-register-contents! eceval 'flag true) (start eceval))) +;;; For 5.48 ec-compile-and-run +(define (compile-and-run? expression) + (tagged-list? expression 'compile-and-run)) +(define (compile-and-run expression) + (let ((instructions + (assemble (statements + (compile (cadr expression) 'val 'return)) + eceval))) + (set-register-contents! eceval 'val instructions))) + ;;**NB. To [not] monitor stack operations, comment in/[out] the line after ;; print-result in the machine controller below ;;**Also choose the desired make-stack version in regsim.scm @@ -128,6 +138,10 @@ (list 'compiled-procedure? compiled-procedure?) (list 'compiled-procedure-entry compiled-procedure-entry) (list 'compiled-procedure-env compiled-procedure-env) + + ;; ex-5.48 + (list 'compile-and-run? compile-and-run?) + (list 'compile-and-run compile-and-run) )) (define eceval @@ -196,6 +210,8 @@ eval-dispatch (branch (label ev-lambda)) (test (op begin?) (reg exp)) (branch (label ev-begin)) + (test (op compile-and-run?) (reg exp)) + (branch (label compile-and-run)) (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) @@ -216,6 +232,10 @@ ev-lambda (reg unev) (reg exp) (reg env)) (goto (reg continue)) +compile-and-run + (perform (op compile-and-run) (reg exp)) + (goto (reg val)) + ev-application (save continue) (save env)