application/octet-stream
•
3.48 KB
•
149 lines
; Contains native nujel implementations of some
; core language constructs and essential macros
[defmacro comment [...body]
"Does nothing"
#nil
]
[defun not [v]
"Return true if V is false"
[if v #f #t]
]
[defun list [...arguments]
"Return ARGUMENTS as a list"
...arguments
]
[defun default [arg default-value]
"Returns ARG or DEFAULT-VALUE if ARG is #nil"
[if arg arg default-value]
]
[defun caar [p]
"[car [car p]]"
[car [car p]]
]
[defun cadr [p]
"[car [cdr p]]"
[car [cdr p]]
]
[defun cdar [p]
"[cdr [car p]]"
[cdr [car p]]
]
[defun cddr [p]
"[cdr [cdr p]]"
[cdr [cdr p]]
]
[defun cadar [p]
"[cdr [car p]]"
[car [cdr [car p]]]
]
[defun caddr [p]
"[car [cdr [cdr p]]]"
[car [cdr [cdr p]]]
]
[defun cdddr [p]
"[cdr [cdr [cdr p]]]"
[cdr [cdr [cdr p]]]
]
[defun cadddr [p]
"[car [cdr [cdr [cdr p]]]]"
[car [cdr [cdr [cdr p]]]]
]
[defun caddddr [p]
"[car [cdr [cdr [cdr p]]]]"
[car [cdr [cdr [cdr [cdr p]]]]]
]
[defmacro if-not [pred then else]
`[if ~pred ~else ~then]
]
[defmacro if-let [binding then else]
`[let* [def ~[car binding] ~[cadr binding]]
[if ~[car binding] ~then ~else]
]
]
[defmacro when-let [binding ...body]
`[if-let ~binding ~[cons 'do ...body] #nil]
]
[defmacro when-not [pred ...body]
"Evalutes to BODY if PRED is false"
`[if ~pred #nil [do ~@...body]]
]
[defmacro when [pred ...body]
"Evalutes to BODY if PRED is true"
`[if ~pred [do ~@...body] #nil]
]
[defun let/arg [arg]
[when-not [pair? arg] [throw `[:invalid-let-form "Please fix the structure of the let form" ~arg]]]
[when-not [symbol? [car arg]] [throw `[:invalid-let-form "Please fix the structure of the let form" ~arg]]]
`[def ~[car arg] ~[cadr arg]]
]
[defun let/args [args]
[if args
[cons [let/arg [car args]]
[let/args [cdr args]]]
#nil]
]
[defmacro let [bindings ...body]
"Evalutes to BODY if PRED is true"
`[let* [do ~@[let/args bindings] ~@...body]]
]
[def gensym/counter 0]
[defun gensym []
[set! gensym/counter [+ 1 gensym/counter]]
[str->sym ["ΓεnΣym-" gensym/counter]]
]
[defun case/clauses/multiple [key-sym cases]
[when cases
[cons [list 'eq? key-sym [car cases]]
[case/clauses/multiple key-sym [cdr cases]]]]
]
[defun case/clauses [key-sym clauses]
[when clauses
[if [eq? [caar clauses] 'otherwise]
[cons 'do [cdar clauses]]
[list 'if
[if [pair? [caar clauses]]
[cons 'or [case/clauses/multiple key-sym [caar clauses]]]
[list 'eq? key-sym [caar clauses]]]
[cons 'do [cdar clauses]]
[case/clauses key-sym [cdr clauses]]]]]
]
[defmacro case [key-form ...clauses]
[def key-sym [gensym]]
[list 'let*
[list 'def key-sym key-form]
[case/clauses key-sym ...clauses]]
]
[defmacro cond [...body]
"Contains multiple cond clauses"
[when ...body
[list 'if
[caar ...body]
[cons 'do [cdar ...body]]
[macro-apply cond [cdr ...body]]]]
]
[def root-closure [current-closure]]
