SICP/ex-5_50-52.scm

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

;; 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 - Scheme Interpreter in Rust\n")

; I have implemented a crude Scheme interpreter in Rust:
; https://git.felixm.de/felixm/schemers

(display "[ok]\n")

(display "\nex-5.52 - Scheme to C Translator\n")

(load "shared/scm2c/translator")

(define c-preamble '(
  "#include <stdio.h>"
  "#include <stdint.h>"
  "#include <stdlib.h>"
  ""
  "#include \"datum.h\""
  "#include \"env.h\""
  "#include \"stack.h\""
  ""
  "int main() {"
  "    datum *val, *argl, *proc;"
  "    void *continu, *entry;"
  "    environment *env = get_global_environment();"
  "    stack *proc_stack = create_stack();"
  "    stack *env_stack = create_stack();"
  "    stack *argl_stack = create_stack();"
  "    stack *continu_stack = create_stack();"
  ""
  ))

(define c-epilog '(
  "    print_datum(val);"
  "    printf(\"\\n\");"
  "}"
  ""
  ))

(define (compile-to-file file-name 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 file-name))
        (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)
     (display "[cc ") (display file-name)
     (display "]") (newline)
     (close-output-port port)))

(compile-to-file
  "shared/scm2c/main.c"
  '(begin
     (define (fac n) (if (= n 1) 1 (* n (fac (- n 1)))))
     (define (fib n) (if (< n 2) 1 (+ (fib (- n 2)) (fib (- n 1)))))
     (fac 10)))

; I haven't implemented all expressions and data types, so I cannot

; λ → cd shared/scm2c/
; λ → make
; λ → ./aout
; 3628800

; I haven't implemented all expressions and datatypes, so I cannot compile the
; metacircular evaluator. Nevertheless, I have implemented procedure
; definitions and environment support, and I can compute factorials and
; Fibonacci numbers. That's all that ever counts. The whole C program is a
; massive memory leak that I could resolve by using reference-counting
; pointers. I am happy, grateful, and proud that I have finished working
; through this book. All that remains are the summaries for Chapters 4 and 5,
; and then I will move on to even more ambitious goals. LFG!

(display "[FIN :]\n")