Start to work on Scheme to C translator

ex-5_50-52.scm

@@ -1,71 +1,71 @@
 (load "shared/util")
-(load "shared/ch5-regsim")
-(load "shared/ch5-compiler")
-(load "shared/ch5-eceval-support")
-
-(display "\nex-5.50 - compile-metacircular-evaluator\n")
-
-(define mceval-code
-  (let ((port (open-input-file "shared/ch4-mceval.scm")))
-    (read port)))
-
-(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)
+;(load "shared/ch5-regsim")
+;(load "shared/ch5-compiler")
+;(load "shared/ch5-eceval-support")
+;
+;(display "\nex-5.50 - compile-metacircular-evaluator\n")
+;
+;(define mceval-code
+;  (let ((port (open-input-file "shared/ch4-mceval.scm")))
+;    (read port)))
+;
+;(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:
@@ -91,6 +91,44 @@
 
 (display "\nex-5.52\n")
 
-; YAS, almost done!
-(display "TBD!!!\n")
+(load "shared/scm2c-compiler")
+
+; My goal is to compile to C. Not to compile the metacircular evaluator.
+
+(define c-preamble '(
+  "#include <stdio.h>"
+  ""
+  "int main() {"
+  "    int val;"
+  "    int *argl;"
+  ""
+  ))
+
+(define c-epilog '(
+  "}"
+  ))
+
+(define (compile-to-file code)
+  (define (write-list-to-line xs port)
+    (cond
+      ((null? xs) '())
+      ((pair? xs) (display (car xs) port)
+                  (write-list-to-line (cdr xs) port))
+      (else (display xs port))))
+
+  (define (write-list-to-port xs port)
+    (if (null? xs) '()
+      (begin (write-list-to-line (car xs) port)
+             (display "\n" port)
+             (write-list-to-port (cdr xs) port))))
+  (let ((port (open-output-file "main.c"))
+        (stmts (statements (compile code 'val 'next))))
+     (write-list-to-port c-preamble port)
+     (write-list-to-port stmts port)
+     (write-list-to-port c-epilog port)
+     (close-output-port port)))
+
+(compile-to-file '(+ 1 1))
+
+; write assembly to file for debug purposes