dane/scm-to-vm
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Pluggable instruction sets

Browse Source
This commit is contained in:
Dane Johnson
2026-02-10 10:58:48 -06:00
parent e4fe2c6bff
commit 4280841719
6 changed files with 226 additions and 188 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
scmvm/language/scheme.scm
View File

@@ -299,6 +299,7 @@
(primitive-eval `(display (call/cc (lambda (ktail) ,(ir-convert prgm)))))
(newline))
(ir-interpreter))
;; Optimization
(define-syntax-rule (define-cps-type name field ...)
(begin
@@ -349,11 +350,11 @@
[($ $constant val) val]
[($ $primitive name) `(cps-prim ,name)]
[($ $var name) name]
[($ $abstraction vars body ktail) `(lambda (,@vars ,ktail) ,body)]
[($ $alternative pred kt kf) `(if ,pred ,kt ,kf)]
[($ $fix vars exps body) `(letrec ,(zip vars exps) ,body)]
[($ $assignment var expr cont) `(set!-then ,var ,expr ,cont)]
[($ $application fun args ktail) `(,fun ,@args ,ktail)]
[($ $abstraction vars body ktail) `(lambda (,@(map unparse-cps vars) ,ktail) ,(unparse-cps body))]
[($ $alternative pred kt kf) `(if ,(unparse-cps pred) ,kt ,kf)]
[($ $fix vars exps body) `(letrec ,(zip (map unparse-cps vars) (map unparse-cps exps)) ,(unparse-cps body))]
[($ $assignment var expr cont) `(set!-then ,(unparse-cps var) ,(unparse-cps expr) ,(unparse-cps cont))]
[($ $application fun args ktail) `(,(unparse-cps fun) ,@(map unparse-cps args) ,ktail)]
[_ (error "Unexpected cps while unparsing" exp)]))
;; Compilation