Implement 5.50 compiled meta-circular evaluator executed by regsim

ex-5_50-52.scm

@@ -1,24 +1,88 @@
 (load "shared/util")
-(load "shared/sicp-load-eceval-compiler")
-(load "shared/sicp-compiler")
+(load "shared/ch5-regsim")
+(load "shared/ch5-compiler")
+(load "shared/ch5-eceval-support")
 
 (display "\nex-5.50 - compile-metacircular-evaluator\n")
 
-; Exercise 5.50.  Use the compiler to compile the metacircular evaluator of
-; section 4.1 and run this program using the register-machine simulator. (To
-; compile more than one definition at a time, you can package the definitions
-; in a begin.) The resulting interpreter will run very slowly because of the
-; multiple levels of interpretation, but getting all the details to work is an
-; instructive exercise.
+(define mceval-code
+  (let ((port (open-input-file "shared/ch4-mceval.scm")))
+    (read port)))
 
-(compile-and-go
- '(begin
-    (define (factorial n)
-      (if (= n 1)
-        1
-        (* (factorial (- n 1)) n)))
-    (factorial 10)))
+(define mceval-compiled
+  (append
+    (list '(assign env (op get-global-environment)))
+    (statements (compile mceval-code 'val 'next))))
+
+;; write assembly to file for debug purposes
+; (let ((port (open-output-file "f-mceval-compiled.scm")))
+;   (define (write-list-to-port xs port)
+;     (if (null? xs) '()
+;       (begin (display (car xs) port) (display "\n" port)
+;              (write-list-to-port (cdr xs) port))))
+;   (write-list-to-port mceval-compiled port)
+;   (close-output-port port))
+
+(define eceval-operations (list
+   (list 'list list)
+   (list 'cons cons)
+
+   (list 'true? true?)
+   (list 'false? false?)    ;for compiled code
+   (list 'make-procedure make-procedure)
+   (list 'compound-procedure? compound-procedure?)
+   (list 'procedure-parameters procedure-parameters)
+   (list 'procedure-body procedure-body)
+   (list 'procedure-environment procedure-environment)
+   (list 'extend-environment extend-environment)
+   (list 'lookup-variable-value lookup-variable-value)
+   (list 'set-variable-value! set-variable-value!)
+   (list 'define-variable! define-variable!)
+   (list 'primitive-procedure? primitive-procedure?)
+   (list 'apply-primitive-procedure apply-primitive-procedure)
+   (list 'prompt-for-input prompt-for-input)
+   (list 'announce-output announce-output)
+   (list 'user-print user-print)
+   (list 'empty-arglist empty-arglist)
+   (list 'adjoin-arg adjoin-arg)
+   (list 'last-operand? last-operand?)
+   (list 'no-more-exps? no-more-exps?)  ;for non-tail-recursive machine
+   (list 'get-global-environment get-global-environment)
+
+   ;;for compiled code (also in eceval-support.scm)
+   (list 'make-compiled-procedure make-compiled-procedure)
+   (list 'compiled-procedure? compiled-procedure?)
+   (list 'compiled-procedure-entry compiled-procedure-entry)
+   (list 'compiled-procedure-env compiled-procedure-env)
+  ))
+
+(define the-global-environment (setup-environment))
+(define mceval-machine
+  (make-machine
+    '(exp env val proc argl continue unev)
+    eceval-operations
+    mceval-compiled))
+
+(start mceval-machine)
+;; (factorial 5) computed by compiled mceval executed by register simulator
+(assert (get-register-contents mceval-machine 'val) 120)
+
+;; Uncomment driver loop within shared/ch4-mceval.scm and load in mit-scheme
+;; for REPL:
+
+; λ symposium sicp → λ git master* → mit-scheme
+; 1 ]=> (load "ex-5_50-52")
+; ;;; M-Eval input:
+; (define (f n) (if (= n 1) 1 (* n (f (- n 1)))))
+; ;;; M-Eval value:
+; ok
+; ;;; M-Eval input:
+; (f 10)
+; ;;; M-Eval value:
+; 3628800
+; #magic
 
 (display "\nex-5.51\n")
 
-(display "\nex-5.52\n")
+;(display "\nex-5.52\n")
+