From bcabdd32120e4adae617073d0c2f682f20a3dace Mon Sep 17 00:00:00 2001 From: Felix Martin Date: Fri, 11 Jun 2021 18:05:03 -0400 Subject: [PATCH] Update readme and work on SCM to C translator --- README.md | 18 +++++++++- ex-5_50-52.scm | 21 +++++++----- shared/scm2c/main.c | 24 +++++++++++++ shared/scm2c/scm2c.h | 15 ++++++++ .../translator.scm} | 34 ++++++++----------- 5 files changed, 84 insertions(+), 28 deletions(-) create mode 100644 shared/scm2c/main.c create mode 100644 shared/scm2c/scm2c.h rename shared/{scm2c-compiler.scm => scm2c/translator.scm} (93%) diff --git a/README.md b/README.md index 2835341..c289e3e 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@ # SICP +**This is currently (2021/06/11) work in progress.** + These are my solutions to the CS classic [Structure and Interpretation of Computer Programs](https://mitpress.mit.edu/sites/default/files/sicp/index.html). I have looked up the answer for some exercises on the @@ -11,7 +13,21 @@ execute `pacman -S mit-scheme` to install it. Then run the scripts via `mit-scheme --quiet < script.scm`. You can also use the shell script `./run script.scm`. -**This is currently (2021/05/13) work in progress.** +I haven't completely solved the following exercises. + +- Exercise 1.13. I wasn't able to do the proof. +- Exercise 4.78. I managed to use the amb-evaluator for the query system, but it + does not work for joined queries. +- Exercise 4.79. I did not attempt to solve this exercise because of not + finishing the previous one, and it is the last one in the chapter. +- Exercise 5.52. I have implemented the basic structure of a Scheme to C + translator, but I only finished a basic proof-of-concept. Most of the + additional work would be similar to 5.51. + +I had a great time working through this book. I feel like my mental capabilities +improved throughout the process, and finishing all the exercises gives me an +incredible feeling of accomplishment. I have written short summaries for each of +the chapters below. # Chapter 1 diff --git a/ex-5_50-52.scm b/ex-5_50-52.scm index 33e117e..fae5c7a 100644 --- a/ex-5_50-52.scm +++ b/ex-5_50-52.scm @@ -82,53 +82,58 @@ ; 3628800 ; #magic -(display "\nex-5.51\n") +(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\n") +(display "\nex-5.52 - Scheme to C Translator\n") -(load "shared/scm2c-compiler") +(load "shared/scm2c/translator") -; My goal is to compile to C. Not to compile the metacircular evaluator. +; My goal is to create proof of concept. Not to compile the metacircular +; evaluator. (define c-preamble '( "#include " + "#include \"scm_support.h\"" "" "int main() {" " int val;" " int *argl;" + " void *cont, *entry, *proc, *env;" "" )) (define c-epilog '( + " printf(\"%u\\n\", val);" "}" )) -(define (compile-to-file code) +(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 "main.c")) + (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 '(+ 1 1)) +(compile-to-file "shared/scm2c/main.c" '(+ 1 1)) ; write assembly to file for debug purposes diff --git a/shared/scm2c/main.c b/shared/scm2c/main.c new file mode 100644 index 0000000..0c03d41 --- /dev/null +++ b/shared/scm2c/main.c @@ -0,0 +1,24 @@ +#include +#include "scm_support.h" + +int main() { + int val; + int *argl; + void *cont, *entry, *proc, *env; + + proc = lookup_variable_value("+", env); + val = 1; + argl = list(val); + val = 1; + argl = cons(val, argl); + if (primitive_procedure(proc) == 1) + goto primitivebranch3; +compiledbranch2: + cont = &&aftercall1; + entry = compiled_procedure_entry(proc); + goto *entry; +primitivebranch3: + val = proc(argl); +aftercall1: + printf("%u\n", val); +} diff --git a/shared/scm2c/scm2c.h b/shared/scm2c/scm2c.h new file mode 100644 index 0000000..c8405ca --- /dev/null +++ b/shared/scm2c/scm2c.h @@ -0,0 +1,15 @@ +void* lookup_variable_value(char* c, void* e) { + return NULL; +} + +int* list(int n) { + return NULL; +} + +int* cons(int n, int* argl) { + return NULL; +} + +int primitive_procedure(void* p) { + return 1; +} diff --git a/shared/scm2c-compiler.scm b/shared/scm2c/translator.scm similarity index 93% rename from shared/scm2c-compiler.scm rename to shared/scm2c/translator.scm index de18947..aafc9bf 100644 --- a/shared/scm2c-compiler.scm +++ b/shared/scm2c/translator.scm @@ -87,8 +87,8 @@ (end-with-linkage linkage (make-instruction-sequence '(env) (list target) `((" " - ,target " " = " " lookup-variable-value - "(" "\"" ,exp "\"" ", " env ")"))))) + ,target " " = " " lookup_variable_value + "(" "\"" ,exp "\"" ", " env ");"))))) (define (compile-assignment exp target linkage) (let ((var (assignment-variable exp)) @@ -245,45 +245,41 @@ ;;;applying procedures (define (compile-procedure-call target linkage) - (let ((primitive-branch (make-label 'primitive-branch)) - (compiled-branch (make-label 'compiled-branch)) - (after-call (make-label 'after-call))) + (let ((primitive-branch (make-label 'primitivebranch)) + (compiled-branch (make-label 'compiledbranch)) + (after-call (make-label 'aftercall))) (let ((compiled-linkage (if (eq? linkage 'next) after-call linkage))) (append-instruction-sequences (make-instruction-sequence '(proc) '() - `((test (op primitive-procedure?) (reg proc)) - (branch (label ,primitive-branch)))) + `((" if (" primitive_procedure "(proc) == 1)") + (" goto " ,primitive-branch ";"))) (parallel-instruction-sequences (append-instruction-sequences - compiled-branch + (make-instruction-sequence '() '() `((,compiled-branch ":"))) (compile-proc-appl target compiled-linkage)) (append-instruction-sequences - primitive-branch + (make-instruction-sequence '() '() `((,primitive-branch ":"))) (end-with-linkage linkage (make-instruction-sequence '(proc argl) (list target) - `((assign ,target - (op apply-primitive-procedure) - (reg proc) - (reg argl))))))) - after-call)))) + `((" val = proc(argl);")))))) + (make-instruction-sequence '() '() `((,after-call ":"))))))) ;;;applying compiled procedures (define (compile-proc-appl target linkage) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '(proc) all-regs - `((assign continue (label ,linkage)) - (assign val (op compiled-procedure-entry) - (reg proc)) - (goto (reg val))))) + `((" " cont " = &&" ,linkage ";") + (" " entry " = " compiled_procedure_entry "(proc);") + (" goto *entry;")))) ((and (not (eq? target 'val)) (not (eq? linkage 'return))) (let ((proc-return (make-label 'proc-return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,proc-return)) - (assign val (op compiled-procedure-entry) + (assign val (op compiled_procedure_entry) (reg proc)) (goto (reg val)) ,proc-return