application/octet-stream
•
4.18 KB
•
106 lines
[defn load/forms [source environment]
"Load multiple forms, evaluating the results in environment, so we can make use of macros we just defined"
[doseq [form source]
[apply environment [compile* source environment]]]]
[defn macroexpand/forms [source-raw environment]
"Expand multiple forms, evaluating the source in a temporary environment, so we can make use of macros we just defined."
[when-not environment [set! environment [environment*]]]
[load/forms source-raw environment]
[macroexpand source-raw environment]]
[defn compile* [source environment]
"Compile SOURCE so it can be evaluated/applied"
[-> [macroexpand source environment]
constant-fold
backend]]
[defn compile/debug [expr]
[disassemble [compile expr]]]
[defn compile/do* [source environment]
[if [pair? source]
[compile* [cons do source] environment]
source]]
[defmacro compile [source]
"Compile SOURCE so it can be evaluated/applied"
`[compile* ~source [current-closure]]]
[defmacro compile/do [source]
"Compile SOURCE so it can be evaluated/applied"
`[compile* [cons do ~source] [current-closure]]]
[defn meta/parse/body [type args body]
[def meta @[]]
[doseq [v body]
[case [type-of v]
[:pair [return meta]]
[:string [tree/set! meta :documentation [trim [cat [string [tree/ref meta :documentation]]
"\n"
v]]]]
[:keyword [tree/set! meta v #t]]]]
[return meta]]
[defmacro defmacro [name args . body]
"Define a new macro"
`[def ~name [macro* '~name
'~args
~[tree/set! [meta/parse/body :macro args body] :source body]
'~[compile/do* body [current-closure]]]]]
[defn fn/check [args body]
[when-not args [exception :type-error "Every function needs an argument list" args]]
[while args
[when-not [or [symbol? args]
[pair? args]]
[exception :type-error "Wrong type for argument list" args]]
[cdr! args]]
[when-not body [exception :type-error "Every function needs a body" body]]]
[defmacro fn [args . body]
"Define an anonymous function"
[fn/check args body]
`[fn* 'anonymous
'~args
~[tree/set! [meta/parse/body :lambda args body] :source body]
'~[compile/do* body [current-closure]]]]
[defmacro defn [name args . body]
"Define a new function"
[fn/check args body]
`[def ~name [fn* '~name
'~args
~[tree/set! [meta/parse/body :lambda args body] :source body]
'~[compile/do* body [current-closure]]]]]
[defn eval-in [closure expr]
"Compile and the immediatly evaluate the result"
""
"Mostly used by lRun()"
[apply closure [compile* expr closure]]]
[defmacro eval [expr]
"Compile, Evaluate and then return the result of EXPR"
`[eval-in [current-closure] ~expr]]
[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]]]]]
[defn typecheck/numeric/single [v]
`[when-not [numeric? ~v] [throw [list :type-error ~[fmt "Expected numeric value"] ~v [current-lambda]]]]]
[defmacro typecheck/numeric v
[map v typecheck/numeric/single]]
[defn profile-form [raw]
[def start-time [time/milliseconds]]
[def val [eval raw]]
[def end-time [time/milliseconds]]
[display [cat "Evaluating " [ansi-yellow [string/write raw]] " to " [ansi-green [string/write val]] " took " [ansi-red [cat [- end-time start-time] "ms"] "\n"]]]]
[defmacro profile body
"Measure and display how much time and ressources it takes for BODY to be evaluated"
`[profile-form '~[if [last? body]
[car body]
[cons 'do body]]]]
