Update readme and work on SCM to C translator
This commit is contained in:
18
README.md
18
README.md
@@ -1,5 +1,7 @@
|
|||||||
# SICP
|
# SICP
|
||||||
|
|
||||||
|
**This is currently (2021/06/11) work in progress.**
|
||||||
|
|
||||||
These are my solutions to the CS classic [Structure and Interpretation of
|
These are my solutions to the CS classic [Structure and Interpretation of
|
||||||
Computer Programs](https://mitpress.mit.edu/sites/default/files/sicp/index.html).
|
Computer Programs](https://mitpress.mit.edu/sites/default/files/sicp/index.html).
|
||||||
I have looked up the answer for some exercises on the
|
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
|
`mit-scheme --quiet < script.scm`. You can also use the shell script `./run
|
||||||
script.scm`.
|
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
|
# Chapter 1
|
||||||
|
|||||||
@@ -82,53 +82,58 @@
|
|||||||
; 3628800
|
; 3628800
|
||||||
; #magic
|
; #magic
|
||||||
|
|
||||||
(display "\nex-5.51\n")
|
(display "\nex-5.51 - Scheme Interpreter in Rust\n")
|
||||||
|
|
||||||
; I have implemented a crude Scheme interpreter in Rust:
|
; I have implemented a crude Scheme interpreter in Rust:
|
||||||
; https://git.felixm.de/felixm/schemers
|
; https://git.felixm.de/felixm/schemers
|
||||||
|
|
||||||
(display "[ok]\n")
|
(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 '(
|
(define c-preamble '(
|
||||||
"#include <stdio.h>"
|
"#include <stdio.h>"
|
||||||
|
"#include \"scm_support.h\""
|
||||||
""
|
""
|
||||||
"int main() {"
|
"int main() {"
|
||||||
" int val;"
|
" int val;"
|
||||||
" int *argl;"
|
" int *argl;"
|
||||||
|
" void *cont, *entry, *proc, *env;"
|
||||||
""
|
""
|
||||||
))
|
))
|
||||||
|
|
||||||
(define c-epilog '(
|
(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)
|
(define (write-list-to-line xs port)
|
||||||
(cond
|
(cond
|
||||||
((null? xs) '())
|
((null? xs) '())
|
||||||
((pair? xs) (display (car xs) port)
|
((pair? xs) (display (car xs) port)
|
||||||
(write-list-to-line (cdr xs) port))
|
(write-list-to-line (cdr xs) port))
|
||||||
(else (display xs port))))
|
(else (display xs port))))
|
||||||
|
|
||||||
(define (write-list-to-port xs port)
|
(define (write-list-to-port xs port)
|
||||||
(if (null? xs) '()
|
(if (null? xs) '()
|
||||||
(begin (write-list-to-line (car xs) port)
|
(begin (write-list-to-line (car xs) port)
|
||||||
(display "\n" port)
|
(display "\n" port)
|
||||||
(write-list-to-port (cdr xs) 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))))
|
(stmts (statements (compile code 'val 'next))))
|
||||||
(write-list-to-port c-preamble port)
|
(write-list-to-port c-preamble port)
|
||||||
(write-list-to-port stmts port)
|
(write-list-to-port stmts port)
|
||||||
(write-list-to-port c-epilog port)
|
(write-list-to-port c-epilog port)
|
||||||
|
(display "[cc ") (display file-name)
|
||||||
|
(display "]") (newline)
|
||||||
(close-output-port port)))
|
(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
|
; write assembly to file for debug purposes
|
||||||
|
|
||||||
|
|||||||
24
shared/scm2c/main.c
Normal file
24
shared/scm2c/main.c
Normal file
@@ -0,0 +1,24 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#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);
|
||||||
|
}
|
||||||
15
shared/scm2c/scm2c.h
Normal file
15
shared/scm2c/scm2c.h
Normal file
@@ -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;
|
||||||
|
}
|
||||||
@@ -87,8 +87,8 @@
|
|||||||
(end-with-linkage linkage
|
(end-with-linkage linkage
|
||||||
(make-instruction-sequence '(env) (list target)
|
(make-instruction-sequence '(env) (list target)
|
||||||
`((" "
|
`((" "
|
||||||
,target " " = " " lookup-variable-value
|
,target " " = " " lookup_variable_value
|
||||||
"(" "\"" ,exp "\"" ", " env ")")))))
|
"(" "\"" ,exp "\"" ", " env ");")))))
|
||||||
|
|
||||||
(define (compile-assignment exp target linkage)
|
(define (compile-assignment exp target linkage)
|
||||||
(let ((var (assignment-variable exp))
|
(let ((var (assignment-variable exp))
|
||||||
@@ -245,45 +245,41 @@
|
|||||||
;;;applying procedures
|
;;;applying procedures
|
||||||
|
|
||||||
(define (compile-procedure-call target linkage)
|
(define (compile-procedure-call target linkage)
|
||||||
(let ((primitive-branch (make-label 'primitive-branch))
|
(let ((primitive-branch (make-label 'primitivebranch))
|
||||||
(compiled-branch (make-label 'compiled-branch))
|
(compiled-branch (make-label 'compiledbranch))
|
||||||
(after-call (make-label 'after-call)))
|
(after-call (make-label 'aftercall)))
|
||||||
(let ((compiled-linkage
|
(let ((compiled-linkage
|
||||||
(if (eq? linkage 'next) after-call linkage)))
|
(if (eq? linkage 'next) after-call linkage)))
|
||||||
(append-instruction-sequences
|
(append-instruction-sequences
|
||||||
(make-instruction-sequence '(proc) '()
|
(make-instruction-sequence '(proc) '()
|
||||||
`((test (op primitive-procedure?) (reg proc))
|
`((" if (" primitive_procedure "(proc) == 1)")
|
||||||
(branch (label ,primitive-branch))))
|
(" goto " ,primitive-branch ";")))
|
||||||
(parallel-instruction-sequences
|
(parallel-instruction-sequences
|
||||||
(append-instruction-sequences
|
(append-instruction-sequences
|
||||||
compiled-branch
|
(make-instruction-sequence '() '() `((,compiled-branch ":")))
|
||||||
(compile-proc-appl target compiled-linkage))
|
(compile-proc-appl target compiled-linkage))
|
||||||
(append-instruction-sequences
|
(append-instruction-sequences
|
||||||
primitive-branch
|
(make-instruction-sequence '() '() `((,primitive-branch ":")))
|
||||||
(end-with-linkage linkage
|
(end-with-linkage linkage
|
||||||
(make-instruction-sequence '(proc argl)
|
(make-instruction-sequence '(proc argl)
|
||||||
(list target)
|
(list target)
|
||||||
`((assign ,target
|
`((" val = proc(argl);"))))))
|
||||||
(op apply-primitive-procedure)
|
(make-instruction-sequence '() '() `((,after-call ":")))))))
|
||||||
(reg proc)
|
|
||||||
(reg argl)))))))
|
|
||||||
after-call))))
|
|
||||||
|
|
||||||
;;;applying compiled procedures
|
;;;applying compiled procedures
|
||||||
|
|
||||||
(define (compile-proc-appl target linkage)
|
(define (compile-proc-appl target linkage)
|
||||||
(cond ((and (eq? target 'val) (not (eq? linkage 'return)))
|
(cond ((and (eq? target 'val) (not (eq? linkage 'return)))
|
||||||
(make-instruction-sequence '(proc) all-regs
|
(make-instruction-sequence '(proc) all-regs
|
||||||
`((assign continue (label ,linkage))
|
`((" " cont " = &&" ,linkage ";")
|
||||||
(assign val (op compiled-procedure-entry)
|
(" " entry " = " compiled_procedure_entry "(proc);")
|
||||||
(reg proc))
|
(" goto *entry;"))))
|
||||||
(goto (reg val)))))
|
|
||||||
((and (not (eq? target 'val))
|
((and (not (eq? target 'val))
|
||||||
(not (eq? linkage 'return)))
|
(not (eq? linkage 'return)))
|
||||||
(let ((proc-return (make-label 'proc-return)))
|
(let ((proc-return (make-label 'proc-return)))
|
||||||
(make-instruction-sequence '(proc) all-regs
|
(make-instruction-sequence '(proc) all-regs
|
||||||
`((assign continue (label ,proc-return))
|
`((assign continue (label ,proc-return))
|
||||||
(assign val (op compiled-procedure-entry)
|
(assign val (op compiled_procedure_entry)
|
||||||
(reg proc))
|
(reg proc))
|
||||||
(goto (reg val))
|
(goto (reg val))
|
||||||
,proc-return
|
,proc-return
|
||||||
Reference in New Issue
Block a user