2021-05-02 00:30:24 +02:00
|
|
|
(load "shared/util")
|
2021-06-05 03:42:51 +02:00
|
|
|
;(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)
|
2021-05-09 05:20:45 +02:00
|
|
|
|
|
|
|
;; 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
|
2021-05-02 00:30:24 +02:00
|
|
|
|
2021-06-12 00:05:03 +02:00
|
|
|
(display "\nex-5.51 - Scheme Interpreter in Rust\n")
|
2021-05-02 00:30:24 +02:00
|
|
|
|
2021-06-04 03:25:36 +02:00
|
|
|
; I have implemented a crude Scheme interpreter in Rust:
|
|
|
|
; https://git.felixm.de/felixm/schemers
|
|
|
|
|
|
|
|
(display "[ok]\n")
|
|
|
|
|
2021-06-12 00:05:03 +02:00
|
|
|
(display "\nex-5.52 - Scheme to C Translator\n")
|
2021-06-04 03:25:36 +02:00
|
|
|
|
2021-06-12 00:05:03 +02:00
|
|
|
(load "shared/scm2c/translator")
|
2021-06-05 03:42:51 +02:00
|
|
|
|
2021-06-12 00:05:03 +02:00
|
|
|
; My goal is to create proof of concept. Not to compile the metacircular
|
|
|
|
; evaluator.
|
2021-06-05 03:42:51 +02:00
|
|
|
|
|
|
|
(define c-preamble '(
|
|
|
|
"#include <stdio.h>"
|
2021-06-12 16:51:50 +02:00
|
|
|
"#include <stdint.h>"
|
|
|
|
"#include <stdlib.h>"
|
|
|
|
""
|
|
|
|
"#include \"datum.h\""
|
2021-06-05 03:42:51 +02:00
|
|
|
""
|
|
|
|
"int main() {"
|
2021-06-12 16:51:50 +02:00
|
|
|
" datum *val;"
|
|
|
|
" datum *argl[10];"
|
|
|
|
" datum *proc;"
|
|
|
|
" void *cont, *entry, *env;"
|
2021-06-05 03:42:51 +02:00
|
|
|
""
|
|
|
|
))
|
|
|
|
|
|
|
|
(define c-epilog '(
|
2021-06-12 16:51:50 +02:00
|
|
|
" printf(\"%u\\n\", val->value);"
|
2021-06-05 03:42:51 +02:00
|
|
|
"}"
|
|
|
|
))
|
|
|
|
|
2021-06-12 00:05:03 +02:00
|
|
|
(define (compile-to-file file-name code)
|
2021-06-05 03:42:51 +02:00
|
|
|
(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))))
|
2021-06-12 00:05:03 +02:00
|
|
|
(let ((port (open-output-file file-name))
|
2021-06-05 03:42:51 +02:00
|
|
|
(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)
|
2021-06-12 00:05:03 +02:00
|
|
|
(display "[cc ") (display file-name)
|
|
|
|
(display "]") (newline)
|
2021-06-05 03:42:51 +02:00
|
|
|
(close-output-port port)))
|
|
|
|
|
2021-06-12 16:51:50 +02:00
|
|
|
(compile-to-file "shared/scm2c/main.c" '(+ 42 3))
|
2021-06-05 03:42:51 +02:00
|
|
|
|
|
|
|
; write assembly to file for debug purposes
|
2021-05-09 05:20:45 +02:00
|
|
|
|