application/octet-stream
•
7.61 KB
•
209 lines
;; Contains the self-hosting Nujel compiler
[defun compile/do/args [args]
;[display ["[do-args] " [str/write args] "\n\n"]]
[if [nil? [cdr args]]
[cons [compile [car args]] #nil]
[if [pair? [car args]]
[let* [def ocar [compile [car args]]]
[if [pair? ocar]
[cons ocar [compile/do/args [cdr args]]]
[compile/do/args [cdr args]]]
]
[compile/do/args [cdr args]]]]
]
[defun compile/do [source]
;[display ["[do] " [str/write source] "\n\n"]]
[let* [def args [compile/do/args source]]
[if [nil? [cdr args]]
[car args]
[cons 'do args]]
]
]
[defun compile/def [source]
;[display ["[def] " [str/write source] "\n\n"]]
[list 'def [cadr source] [compile [caddr source]]]
]
[defun compile/set! [source]
;[display ["[set] " [str/write source] "\n\n"]]
[list 'set! [cadr source] [compile [caddr source]]]
]
[defun compile/λ [source]
;[display ["[λ] " [str/write source] "\n\n"]]
[if [string? [caddr source]]
[list 'λ* [cadr source] [caddr source] [compile/do [cddr source]]]
[list 'λ* [cadr source] "" [compile/do [cddr source]]]]
]
[defun compile/λ* [source]
source
]
[defun compile/δ [source]
;[display ["[λ] " [str/write source] "\n\n"]]
[if [string? [caddr source]]
[list 'δ* [cadr source] [caddr source] [compile/do [cddr source]]]
[list 'δ* [cadr source] "" [compile/do [cddr source]]]]
]
[defun compile/δ* [source]
source
]
[defun compile/μ [source]
;[display ["[λ] " [str/write source] "\n\n"]]
[if [string? [caddr source]]
[list 'μ* [cadr source] [caddr source] [compile/do [cddr source]]]
[list 'μ* [cadr source] "" [compile/do [cddr source]]]]
]
[defun compile/μ* [source]
source
]
[defun compile/ω [source]
[list 'ω [compile/do [cdr source]]]
]
[defun compile/try [source]
;[display ["[let] " [str/write source] "\n\n"]]
[list 'try [compile [cadr source]] [compile/do [cddr source]]]
]
[defun compile/if [source]
;[display ["[let] " [str/write source] "\n\n"]]
[list 'if [compile [cadr source]] [compile [caddr source]] [compile [cadddr source]]]
]
[defun compile/let/arg [source]
;[display ["[let-arg] " [str/write source] "\n\n"]]
source
[list [car source] [compile [cadr source]]]
]
[defun compile/let/args [source]
[if source
[cons [compile/let/arg [car source]]
[compile/let/args [cdr source]]]]
]
[defun compile/let [source]
;[display ["[let] " [str/write source] "\n\n"]]
[list 'let [compile/let/args [cadr source]] [compile/do [cddr source]]]
]
[defun compile/let* [source]
;[display ["[let*] " [str/write source] "\n\n"]]
[list 'let* [compile/do [cdr source]]]
]
[defun compile/cond/clause [source]
[cons [compile [car source]]
[cons [compile/do [cdr source]]]]
]
[defun compile/cond/clauses [source]
[if source
[cons [compile/cond/clause [car source]]
[compile/cond/clauses [cdr source]]
#nil]]
]
[defun compile/cond [source]
[cons 'cond [compile/cond/clauses [cdr source]]]
]
[defun compile/when [source]
[list 'when [compile [cadr source]] [compile/do [cddr source]]]
]
[defun compile/and [source]
[compile/procedure/arg source]
]
[defun compile/or [source]
[compile/procedure/arg source]
]
[defun compile/while [source]
[list 'while [compile [cadr source]] [compile/do [cddr source]]]
]
[defun compile/macro [macro source]
[compile [macro-apply macro [cdr source]]]
]
[defun compile/procedure/arg [source]
;[println [cat "** " [str/write source]]]
[if [pair? source]
[cons [compile [car source]]
[compile/procedure/arg [cdr source]]]
#nil]
]
[defun compile/procedure [proc source]
[compile/procedure/arg source]
]
[defun compile [source]
"Compile the forms in source"
;[display ["[opt] " [str/write [resolve [car source]]] "\n" [str/write source] "\n\n"]]
[let* [def op [if [resolves? [car source]]
[resolve [car source]]
[car source]]]
[cond [[special-form? op]
[cond [[eq? op do] [compile/do source]]
[[eq? op def] [compile/def source]]
[[eq? op set!] [compile/set! source]]
[[eq? op let] [compile/let source]]
[[eq? op let*] [compile/let* source]]
[[eq? op δ] [compile/δ source]]
[[eq? op δ*] [compile/δ* source]]
[[eq? op λ] [compile/λ source]]
[[eq? op λ*] [compile/λ* source]]
[[eq? op μ] [compile/μ source]]
[[eq? op μ*] [compile/μ* source]]
[[eq? op ω] [compile/ω source]]
[[eq? op if] [compile/if source]]
[[eq? op try] [compile/try source]]
[[eq? op cond] [compile/cond source]]
[[eq? op when] [compile/when source]]
[[eq? op and] [compile/and source]]
[[eq? op or] [compile/or source]]
[[eq? op while] [compile/while source]]
[[eq? op quote] source ]
[#t [throw [list :unknown-special-form "The compiler does not know the current special form, please fix the compiler!" [car source]]]]
]]
[[macro? op] [compile/macro op source]]
[[procedure? op] [compile/procedure op source]]
[[pair? op] [compile/procedure/arg source]]
[[numeric? op] [compile/procedure/arg source]]
[[arr? op] [compile/procedure/arg source]]
[[string? op] [compile/procedure/arg source]]
[[tree? op] [compile/procedure/arg source]]
[#t source]]
]
]
[def defun [μ [name args ...body]
[list 'def name [compile [cons 'λ [cons args ...body]]]]
]]
[def defmacro [μ [name args ...body]
[list 'def name [compile [cons 'μ [cons args ...body]]]]
]]
[defmacro \ [...body]
"Define a λ with the self-hosting Nujel compiler"
[compile [cons 'λ ...body]]
]
[defmacro eval [expr]
"Compile, Evaluate and then return the result of EXPR"
`[eval* [compile ,expr]]
]
[defmacro +1 [v]
`[+ 1 ,v]
]
[defun test [a] [+2 a]]
;[defmacro +2 [v] `[+ 2 ,v]]
