application/octet-stream
•
10.49 KB
•
242 lines
; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
; This project uses the MIT license, a copy should be included under /LICENSE
;; Contains the self-hosting Nujel compiler
[def compile/environment [current-closure]]
[def compile/verbose #f]
[defn compile/do/args [args]
[if [last? 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]]]]]
[defn compile/do [source]
[def args [compile/do/args source]]
[if [last? args]
[car args]
[cons 'do args]]]
[defn compile/def [source]
[list 'def [cadr source] [compile* [caddr source]]]]
[defn compile/set! [source]
[list 'set! [cadr source] [compile* [caddr source]]]]
[defn compile/λ* [source]
[list 'λ*
[cadr source]
[caddr source]
[cadddr source]
[compile [caddddr source]]]]
[defn compile/fn* [source]
[list 'fn*
[cadr source]
[caddr source]
[cadddr source]
[compile [caddddr source]]]]
[defn compile/macro* [source]
[list 'macro*
[cadr source]
[caddr source]
[cadddr source]
[compile [caddddr source]]]]
[defn compile/μ* [source]
[list 'μ*
[cadr source]
[caddr source]
[cadddr source]
[compile [caddddr source]]]]
[defn compile/ω* [source]
[list 'ω* [compile/do [cdr source]]]]
[defn compile/try [source]
[list 'try [compile* [cadr source]] [compile/do [cddr source]]]]
[defn compile/if [source]
[list 'if [compile* [cadr source]] [compile* [caddr source]] [compile* [cadddr source]]]]
[defn compile/let* [source]
[list 'let* [compile/do [cdr source]]]]
[defn compile/and [source]
[compile/procedure/arg source]]
[defn compile/or [source]
[compile/procedure/arg source]]
[defn compile/while [source]
[list 'while [compile* [cadr source]] [compile/do [cddr source]]]]
[defn compile/macro [macro source]
[compile* [macro-apply macro [cdr source]]]]
[defn compile/procedure/arg [source]
[when [pair? source]
[cons [compile* [car source]]
[compile/procedure/arg [cdr source]]]]]
[defn compile/procedure [proc source]
[compile/procedure/arg source]]
[defn compile* [source]
"Compile the forms in source"
[def op [if [apply compile/environment `[do [resolves? ~[list 'quote [car source]]]]]
[apply compile/environment `[do [resolve ~[list 'quote [car source]]]]]
[car source]]]
[case [type-of op]
[:special-form [case op
[do [compile/do source]]
[def [compile/def source]]
[set! [compile/set! source]]
[let* [compile/let* source]]
[λ* [compile/λ* source]]
[fn* [compile/fn* source]]
[macro* [compile/macro* source]]
[μ* [compile/μ* source]]
[ω* [compile/ω* source]]
[if [compile/if source]]
[try [compile/try source]]
[and [compile/and source]]
[or [compile/or source]]
[while [compile/while source]]
[quote source ]
[otherwise [throw [list :panic "Unknown special form, please fix the compiler!" source]]]]]
[:macro [compile/macro op source]]
[[:lambda :native-function] [compile/procedure op source]]
[:object [compile/procedure/arg source]]
[:pair [compile/procedure/arg source]]
[[:int :float :vec] [compile/procedure/arg source]]
[:array [compile/procedure/arg source]]
[:string [compile/procedure/arg source]]
[:tree [compile/procedure/arg source]]
[otherwise [if [last? source]
source
[compile/procedure/arg source]]]]]
[defn compile [source new-environment new-verbose]
"Compile the forms in source"
[when-not new-environment [set! new-environment [current-closure]]]
[when-not new-verbose [set! new-verbose #f]]
[set! compile/environment new-environment]
[set! compile/verbose new-verbose]
[compile* source]]
[defn load/forms [source-raw environment]
"Load multiple forms, evaluating the results in environment, so we can make use of macros we just defined"
[def source #nil]
[def source-next source-raw]
[def forms-compiled 0]
[defn try-again [source]
[set! source-next [cons source source-next]]]
[while source-next
[def forms-compiled-last forms-compiled]
[set! source source-next]
[set! source-next #nil]
[def errors #nil]
[for-in [form source]
[try [fn [err]
[set! errors [cons err errors]]
[case [car err]
[:unresolved-procedure [try-again [car source]]]
[:runtime-macro [try-again [car source]]]
[otherwise [throw err]]]]
[def compiled-form [compile form environment #t]]
[when compiled-form [apply environment `[eval* ~compiled-form]]
[++ forms-compiled]]]]
[set! source-next [nreverse source-next]]
[when [<= forms-compiled forms-compiled-last]
[for-each errors display/error]
[throw [list :you-can-not-advance "The compiler got stuck trying to compile various forms, the final pass did not have a single form that compiled without errors"]]]]]
[defn compile/forms [source-raw environment]
"Compile multiple forms, evaluation the results in a temporary environment, so we can make use of macros we just defined"
[when-not environment [set! environment [ω]]]
[load/forms source-raw environment]
[compile source-raw environment]]
[defmacro defmacro [name args . body]
"Define a new macro"
[def doc-string [if-not [string? [car body]] ""
[car body]]]
[list 'def name [compile [list 'μ* name args doc-string [cons 'do body]] [current-closure]]]]
[defmacro defmac [name args . body]
"Define a new bytecoded macro"
[def doc-string [if-not [string? [car body]] ""
[car body]]]
[list 'def name [list macro* name args doc-string [-> [cons 'do body]
[compile [current-closure]]
bytecompile
assemble*]]]]
[defmacro macro [args . body]
"Return a new bytecoded macro"
[def doc-string [if-not [string? [car body]] ""
[car body]]]
[list macro* name args doc-string [-> [cons 'do body]
[compile [current-closure]]
bytecompile
assemble*]]]
[defmacro μ [args . body]
"Define a λ with the self-hosting Nujel compiler"
[def doc-string [if-not [string? [car body]] ""
[car body]]]
[compile [list 'μ* #nil args doc-string [cons 'do body]] [current-closure]]]
[defmacro fn [args . body]
"Define a λδ with the self-hosting Nujel compiler"
[def doc-string [if-not [string? [car body]] ""
[car body]]]
[list fn* 'anonymous args doc-string [-> [cons 'do body]
[compile [current-closure]]
bytecompile
assemble*]]]
[defmacro defn [name args . body]
"Define a new bytecoded function"
[def doc-string [if-not [string? [car body]] ""
[car body]]]
[list 'def name [list fn* name args doc-string [-> [cons 'do body]
[compile [current-closure]]
bytecompile
assemble*]]]]
[defmacro ω body
"Defines and returns new object after evaluating body within"
[compile [cons 'ω* body]]]
[def defobj ω]
[defmacro eval [expr]
"Compile, Evaluate and then return the result of EXPR"
`[eval* [compile ~expr [current-closure]]]]
[defn eval-compile [expr closure]
"Compile and the immediatly evaluate the result, mostly used by lRun()"
[try display/error [eval* [compile expr closure]]]]
[defn read-eval-compile [expr closure]
"Compile and the immediatly evaluate the result, mostly used by lRun()"
[try display/error [eval* [compile [read expr] closure]]]]
[defn eval-load [expr closure]
"Compile and the immediatly evaluate the result, mostly used by lRun()"
[try display/error [load/forms expr closure]]]
[defn read-eval-load [expr closure]
"Compile and the immediatly evaluate the result, mostly used by lRun()"
[try display/error [load/forms [read expr] closure]]]
[defmacro typecheck/only [v t]
`[when-not [== [type-of ~v] ~t] [throw [list :type-error ~[fmt "Expected a value of type {t}"] ~v [current-lambda]]]]]
