application/octet-stream
•
5.09 KB
•
128 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains some high level functions/macros, mainly abstacting the low level
;;; interface to the compiler
[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]
[bytecode-eval* [compile* source environment] 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 source body]
[def meta @[]]
[while body
[def v [car body]]
[case [type-of v]
[:pair [return meta]]
[:string [tree/set! meta :documentation [trim [cat [string [tree/ref meta :documentation]]
"\n"
v]]]]
[:keyword [case v
[:inline [tree/set! meta v #t]
[tree/set! meta :source source]]
[:export-as [tree/set! meta :export [cadr body]]
[cdr! body]]
[:cat [tree/set! meta :cat [cadr body]]
[cdr! body]]
[otherwise [tree/set! meta v #t]]]]]
[cdr! body]]
[return meta]]
[defmacro defmacro [name args . body]
"Define a new macro"
`[def ~name [macro* '~name
'~args
~[meta/parse/body :macro args 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
~[meta/parse/body :lambda args body]
'~[compile/do* body [current-closure]]]]
[defmacro defn [name args . body]
"Define a new function"
[fn/check args body]
[def fn-meta [meta/parse/body :lambda args body]]
[def def-form `[def ~name [fn* '~name
'~args
~fn-meta
'~[compile/do* body [current-closure]]]]]
[if [tree/ref fn-meta :export]
[list 'export [if [symbol? [tree/ref fn-meta :export]]
[tree/ref fn-meta :export]
name] def-form]
def-form]]
[defn eval-in [closure expr]
"Compile and the immediatly evaluate the result"
""
"Mostly used by lRun() and [eval]"
[bytecode-eval* [compile* expr closure] 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]]
[println [cat "Evaluating " [string/write raw] " to " [string/write val] " took " [cat [- end-time start-time] "ms"]]]]
[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]]]]
