Implement 5.48

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

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)