application/octet-stream
•
82.04 KB
•
2002 lines
[do [def comment [μ* comment [...body] "Does nothing" #nil]]
[def not [λ* not
[v]
"Return true if V is false"
[if v
#f
#t]]]
[def list [λ* list
[...arguments]
"Return ARGUMENTS as a list"
...arguments]]
[def default [λ* default
[arg default-value]
"Returns ARG or DEFAULT-VALUE if ARG is #nil"
[if arg
arg
default-value]]]
[def caar [λ* caar
[p]
"[car [car p]]"
[car [car p]]]]
[def cadr [λ* cadr
[p]
"[car [cdr p]]"
[car [cdr p]]]]
[def cdar [λ* cdar
[p]
"[cdr [car p]]"
[cdr [car p]]]]
[def cddr [λ* cddr
[p]
"[cdr [cdr p]]"
[cdr [cdr p]]]]
[def cadar [λ* cadar
[p]
"[cdr [car p]]"
[car [cdr [car p]]]]]
[def caddr [λ* caddr
[p]
"[car [cdr [cdr p]]]"
[car [cdr [cdr p]]]]]
[def cdddr [λ* cdddr
[p]
"[cdr [cdr [cdr p]]]"
[cdr [cdr [cdr p]]]]]
[def cadddr [λ* cadddr
[p]
"[car [cdr [cdr [cdr p]]]]"
[car [cdr [cdr [cdr p]]]]]]
[def caddddr [λ* caddddr
[p]
"[car [cdr [cdr [cdr p]]]]"
[car [cdr [cdr [cdr [cdr p]]]]]]]
[def if-not [μ* if-not [pred then else] "" [cons 'if [cons pred [cons else [cons then #nil]]]]]]
[def if-let [μ* if-let [binding then else] "" [cons 'let* [cons [cons 'def [cons [car binding] [cons [cadr binding] #nil]]] [cons [cons 'if [cons [car binding] [cons then [cons else #nil]]]] #nil]]]]]
[def when-let [μ* when-let [binding ...body] "" [cons 'if-let [cons binding [cons [cons 'do ...body] [cons #nil #nil]]]]]]
[def when-not [μ* when-not [pred ...body] "Evalutes to BODY if PRED is false" [cons 'if [cons pred [cons #nil [cons [cons 'do [append ...body #nil]] #nil]]]]]]
[def when [μ* when [pred ...body] "Evalutes to BODY if PRED is true" [cons 'if [cons pred [cons [cons 'do [append ...body #nil]] [cons #nil #nil]]]]]]
[def let/arg [λ* let/arg
[arg]
""
[do [if [pair? arg]
#nil
[throw [cons ':invalid-let-form [cons "Please fix the structure of the let form" [cons arg #nil]]]]]
[if [symbol? [car arg]]
#nil
[throw [cons ':invalid-let-form [cons "Please fix the structure of the let form" [cons arg #nil]]]]]
[cons 'def [cons [car arg] [cons [cadr arg] #nil]]]]]]
[def let/args [λ* let/args
[args]
""
[if args
[cons [let/arg [car args]] [let/args [cdr args]]]
#nil]]]
[def let [μ* let [bindings ...body] "Evalutes to BODY if PRED is true" [cons 'let* [cons [cons 'do [append [let/args bindings] [append ...body #nil]]] #nil]]]]
[def gensym/counter 0]
[def gensym [λ* gensym
[]
""
[do [set! gensym/counter [+ 1 gensym/counter]]
[str->sym ["ΓεnΣym-" gensym/counter]]]]]
[def case/clauses/multiple [λ* case/clauses/multiple
[key-sym cases]
""
[if cases
[cons [list 'eq? key-sym [car cases]] [case/clauses/multiple key-sym [cdr cases]]]
#nil]]]
[def case/clauses [λ* case/clauses
[key-sym clauses]
""
[if 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]]]]
#nil]]]
[def case [μ* case [key-form ...clauses] "" [do [def key-sym [gensym]]
[list 'let* [list 'def key-sym key-form] [case/clauses key-sym ...clauses]]]]]
[def cond [μ* cond [...body] "Contains multiple cond clauses" [if ...body
[list 'if [caar ...body] [cons 'do [cdar ...body]] [macro-apply cond [cdr ...body]]]
#nil]]]
[def root-closure [current-closure]]][do [def numeric? [λ* numeric?
[a]
"Return #t if a is a number"
[or [int? a] [float? a] [vec? a]]]]
[def last? [λ* last?
[a]
"Return #t if a is the last pair in a list"
[nil? [cdr a]]]]
[def pos? [λ* pos?
[a]
"Return #t if a is positive"
[>= a 0]]]
[def zero-neg? [λ* zero-neg?
[a]
"Return #t if a is zero or negative"
[<= a 0]]]
[def neg? [λ* neg?
[a]
"Returns #t if a is negative"
[< a 0]]]
[def odd? [λ* odd?
[a]
"Predicate that returns #t if a is odd"
[= [% [int a] 2] 1]]]
[def even? [λ* even?
[a]
"Predicate that returns #t if a is even"
[= [% [int a] 2] 0]]]
[def zero? [λ* zero?
[val]
"#t if VAL is zero"
[eq? 0 val]]]
[def not-zero? [λ* not-zero?
[val]
"#t if VAL is not zero"
[ineq? 0 val]]]
[def list-equal? [λ* list-equal?
[a b]
"#t if A and B are equal"
[if [eq? [type-of a] [type-of b]]
[if [pair? a]
[and [list-equal? [car a] [car b]] [list-equal? [cdr a] [cdr b]]]
[eq? a b]]
#nil]]]
[def there-exists? [λ* there-exists?
[l pred]
"Applies predicate to each element and return #t if it holds true for any element, otherwise #f"
[if [nil? l]
#f
[if [pred [car l]]
#t
[if #t
[there-exists? [cdr l] pred]
#nil]]]]]
[def for-all? [λ* for-all?
[l pred]
"Applies predicate to each element returns #t if it holds true for every element, otherwise #f"
[if [nil? l]
#t
[if [not [pred [car l]]]
#f
[if #t
[for-all? [cdr l] pred]
#nil]]]]]
[def int? [λ* int?
[val]
"#t if VAL is a integer"
[eq? :int [type-of val]]]]
[def float? [λ* float?
[val]
"#t if VAL is a floating-point number"
[eq? :float [type-of val]]]]
[def vec? [λ* vec?
[val]
"#t if VAL is a vector"
[eq? :vec [type-of val]]]]
[def bool? [λ* bool?
[val]
"#t if VAL is a boolean"
[eq? :bool [type-of val]]]]
[def pair? [λ* pair?
[val]
"#t if VAL is a pair"
[eq? :pair [type-of val]]]]
[def arr? [λ* arr?
[val]
"#t if VAL is an array"
[eq? :array [type-of val]]]]
[def string? [λ* string?
[val]
"#t if VAL is a string"
[eq? :string [type-of val]]]]
[def symbol? [λ* symbol?
[val]
"#t if VAL is a symbol"
[eq? :symbol [type-of val]]]]
[def object? [λ* object?
[val]
"#t if VAL is an object"
[eq? :object [type-of val]]]]
[def tree? [λ* tree?
[val]
"#t if VAL is an object"
[eq? :tree [type-of val]]]]
[def macro? [λ* macro?
[val]
"#t if VAL is an object"
[eq? :macro [type-of val]]]]
[def lambda? [λ* lambda?
[val]
"#t if VAL is a lambda"
[or [eq? :lambda [type-of val]] [eq? :dynamic [type-of val]]]]]
[def native? [λ* native?
[val]
"#t if VAL is a native function"
[eq? :native-function [type-of val]]]]
[def special-form? [λ* special-form?
[val]
"#t if VAL is a native function"
[eq? :special-form [type-of val]]]]
[def procedure? [λ* procedure?
[val]
"#t if VAL is a native or lisp function"
[or [lambda? val] [native? val]]]]
[def in-range? [λ* in-range?
[v min max]
""
[and [>= v min] [<= v max]]]]][do [def quasiquote-real [λ* quasiquote-real
[l depth]
""
[if [nil? l]
#nil
[if [pair? l]
[if [eq? [caar l] 'unquote-splicing]
[if [zero? depth]
[list 'append [cadr [car l]] [quasiquote-real [cdr l] depth]]
[list 'unquote-splicing [quasiquote-real [cadr l] [+ -1 depth]]]]
[if [eq? [car l] 'unquote]
[if [zero? depth]
[cadr l]
[list 'unquote [quasiquote-real [cadr l] [+ -1 depth]]]]
[if [eq? [car l] 'quasiquote]
[quasiquote-real [quasiquote-real [cadr l] [+ 1 depth]] depth]
[if [zero? depth]
[list 'cons [quasiquote-real [car l] depth] [quasiquote-real [cdr l] depth]]
[cons [quasiquote-real [car l] depth] [quasiquote-real [cdr l] depth]]]]]]
[if [and [zero? depth] [symbol? l]]
[cons 'quote [cons l]]
l]]]]]
[def quasiquote [μ* quasiquote [l] "" [quasiquote-real l 0]]]
[def unquote [λ* unquote
[expr]
""
[throw [list :unquote-without-quasiquote "unquote should only occur inside a quasiquote, never evaluated directly"]]]]
[def unquote-splicing [λ* unquote-splicing
[expr]
""
[throw [list :unquote-splicing-without-quasi "unquote-splicing should only occur inside a quasiquote, never evaluated directly"]]]]][do [def test-context "Nujel"]
[def test-list #nil]
[def test-count 0]
[def nujel-start 0]
[def success-count 0]
[def error-count 0]
[def print-errors #t]
[def print-passes #f]
[def test/add* [λ* test/add*
[result expr]
""
[do [set! test-list [cons [cons result expr] test-list]]
[set! test-count [+ test-count 1]]]]]
[def test/add [μ* test/add [result ...expr] "Add a test where ...EXPR must eval to RESULT" [cons 'test/add* [cons result [cons [list 'quote [cons 'do ...expr]] #nil]]]]]
[def display-results [λ* display-results
[]
"Prints the result Message"
[do [random/seed-initialize!]
[error [cat test-context " [" OS " " ARCH "] - " [if [and [zero? error-count] [> test-count 0]]
"Success - ["
"Failed! - ["] [ansi-green success-count] " / " [ansi-red error-count] "] in " [- [time/milliseconds] nujel-start] "ms - " [if [and [zero? error-count] [> test-count 0]]
[ansi-rainbow "Everything is working, very nice!"]
[ansi-red "Better fix those!"]] "\r\n"]]]]]
[def test-success [λ* test-success
[res-should res-is expr i]
"Should be called after a test has finished successfully"
[do [if print-passes
[error [cat "stdlib/tests.nuj:" i ":1: " [ansi-green "[PASS] -> "] [ansi-green [str/write res-is]] " != " [ansi-green [str/write res-should]] "\r\n" [str/write expr] "\r\n\r\n"]]
#nil]
[set! success-count [+ 1 success-count]]]]]
[def test-failure [λ* test-failure
[res-should res-is expr i]
"Should be called if EXPR does not equal RES"
[do [if print-errors
[error [cat "stdlib/tests.nuj:" i ":1: " [ansi-red "[FAIL] -> "] [ansi-red [str/write res-is]] " != " [ansi-green [str/write res-should]] "\r\n" [str/write expr] "\r\n\r\n"]]
#nil]
[set! error-count [+ 1 error-count]]]]]
[def test-default [λ* test-default
[result rawexpr i]
"Tests that RAWEXPR evaluates to RESULT"
[try [λ* #nil
[err]
""
[test-failure result err rawexpr i]] [do [def expr [eval* [compile rawexpr [current-closure]]]]
[def pred? eq?]
[if [string? result]
[set! expr [str/write expr]]
#nil]
[if [pair? result]
[set! pred? list-equal?]
#nil]
[if [pred? result expr]
[test-success result expr rawexpr i]
[test-failure result expr rawexpr i]]]]]]
[def test-forked [λ* test-forked
[nujel-runtime]
""
[λ* #nil
[result rawexpr i]
"Tests that RAWEXPR evaluates to RESULT in a separate runtime"
[do [def eval-result [eval/forked nujel-runtime rawexpr]]
[def expr [cdr eval-result]]
[def pred? eq?]
[if [string? result]
#nil
[set! expr [car [read expr]]]]
[if [pair? result]
[set! pred? list-equal?]
#nil]
[if [and [zero? [car eval-result]] [pred? result expr]]
[test-success result expr rawexpr i]
[test-failure result expr rawexpr i]]]]]]
[def test-run-iter [λ* test-run-iter
[test l i]
"Recurse through LIST and runs eatch test"
[if l
[do [test [caar l] [cdar l] i]
[test-run-iter test [cdr l] [- i 1]]]
#nil]]]
[def test-run-real [λ* test-run-real
[test]
""
[do [set! nujel-start [time/milliseconds]]
[set! success-count 0]
[set! error-count 0]
[test-run-iter test test-list test-count]
[display-results]
error-count]]]
[def test-run [λ* test-run
[output-passes hide-errors]
"Run through all automated Tests"
[do [set! print-errors [not [bool hide-errors]]]
[set! print-passes [bool output-passes]]
[test-run-real test-default]]]]
[def test-run-forked [λ* test-run-forked
[\ [nujel-runtime output-passes hide-errors] "Run through all automated Tests in a separate runtime" [set! print-errors [not [bool hide-errors]]] [set! print-passes [bool output-passes]] [test-run-real [test-forked nujel-runtime]]]
""
do]]
][do [def ansi-reset "\e[0m"]
[def ansi-fg-reset "\e[0;39m"]
[def ansi-bg-reset "\e[49m"]
[def ansi-fg [arr "\e[0;30m" "\e[0;31m" "\e[0;32m" "\e[0;33m" "\e[0;34m" "\e[0;35m" "\e[0;36m" "\e[0;37m" "\e[1;30m" "\e[1;31m" "\e[1;32m" "\e[1;33m" "\e[1;34m" "\e[1;35m" "\e[1;36m" "\e[1;37m"]]
[def ansi-reset "\e[0m"]
[def ansi-bg [arr "\e[40m" "\e[41m" "\e[42m" "\e[43m" "\e[44m" "\e[45m" "\e[46m" "\e[47m"]]
[def ansi-wrap [λ* ansi-wrap
[code string]
"Wrap STRING in the ansi color CODE"
[cat [ansi-fg code] string ansi-reset]]]
[def ansi-black [λ* ansi-black
[...args]
"Wrap ARGS in black"
[ansi-wrap 0 [apply cat ...args]]]]
[def ansi-dark-red [λ* ansi-dark-red
[...args]
"Wrap ARGS in dark red"
[ansi-wrap 1 [apply cat ...args]]]]
[def ansi-dark-green [λ* ansi-dark-green
[...args]
"Wrap ARGS in dark green"
[ansi-wrap 2 [apply cat ...args]]]]
[def ansi-brown [λ* ansi-brown
[...args]
"Wrap ARGS in brown"
[ansi-wrap 3 [apply cat ...args]]]]
[def ansi-dark-blue [λ* ansi-dark-blue
[...args]
"Wrap ARGS in dark blue"
[ansi-wrap 4 [apply cat ...args]]]]
[def ansi-purple [λ* ansi-purple
[...args]
"Wrap ARGS in purple"
[ansi-wrap 5 [apply cat ...args]]]]
[def ansi-teal [λ* ansi-teal
[...args]
"Wrap ARGS in teal"
[ansi-wrap 6 [apply cat ...args]]]]
[def ansi-dark-gray [λ* ansi-dark-gray
[...args]
"Wrap ARGS in dark gray"
[ansi-wrap 7 [apply cat ...args]]]]
[def ansi-gray [λ* ansi-gray
[...args]
"Wrap ARGS in gray"
[ansi-wrap 8 [apply cat ...args]]]]
[def ansi-red [λ* ansi-red
[...args]
"Wrap ARGS in red"
[ansi-wrap 9 [apply cat ...args]]]]
[def ansi-green [λ* ansi-green
[...args]
"Wrap ARGS in green"
[ansi-wrap 10 [apply cat ...args]]]]
[def ansi-yellow [λ* ansi-yellow
[...args]
"Wrap ARGS in yellow"
[ansi-wrap 11 [apply cat ...args]]]]
[def ansi-blue [λ* ansi-blue
[...args]
"Wrap ARGS in blue"
[ansi-wrap 12 [apply cat ...args]]]]
[def ansi-pink [λ* ansi-pink
[...args]
"Wrap ARGS in pink"
[ansi-wrap 13 [apply cat ...args]]]]
[def ansi-cyan [λ* ansi-cyan
[...args]
"Wrap ARGS in cyan"
[ansi-wrap 14 [apply cat ...args]]]]
[def ansi-white [λ* ansi-white
[...args]
"Wrap ARGS in white"
[ansi-wrap 15 [apply cat ...args]]]]
[def ansi-rainbow [λ* ansi-rainbow
[...args]
"Wrap ARGS in the colors of the rainbow!"
[let* [do [def count 0]
[cat [join [map [λ* #nil
[a]
""
[do [set! count [logand [+ 1 count] 7]]
[cat [ansi-fg [if [zero? count]
7
[+ count 8]]] a]]] [split [apply cat ...args] ""]] ""] ansi-fg-reset]]]]]
[def ansi-rainbow-bg [λ* ansi-rainbow-bg
[...args]
"Wrap ARGS in the colors of the rainbow!"
[do [def count 0]
[def split-args [split [apply cat ...args] ""]]
[def colored-list [map [λ* #nil
[a]
""
[do [set! count [logand [+ 1 count] 7]]
[cat [ansi-fg [logxor count 7]] [ansi-bg count] a]]] split-args]]
[cat [join colored-list ""] ansi-reset]]]]
[def reprint-line [λ* reprint-line
[text width]
""
[do [if width
#nil
[set! width 20]]
[print "\r"]
[def i 0]
[while [< i width] [do [print " "]
[set! i [+ 1 i]]]]
[print "\r"]
[print text]]]]
[def test-reprint-line [λ* test-reprint-line
[]
""
[do [def i 0]
[print "\r\n"]
[while [i < 100000] [do [reprint-line [string i]]
[set! i [+ 1 i]]]]
[print " Done!\r\n"]]]]][do [def yield-queue #nil]
[def yield [λ* yield
[pred fun]
"Evaluates FUN once PRED is true"
[do [set! yield-queue [cons [cons pred fun] yield-queue]]
#t]]]
[def yield-run [λ* yield-run
[]
"Executes pending coroutines if their predicate evaluates to #t"
[do [def l yield-queue]
[def new #nil]
[def cur #nil]
[set! yield-queue #nil]
[while l [do [set! cur [car l]]
[if [[car cur]]
[[cdr cur]]
[set! yield-queue [cons cur yield-queue]]]
[set! l [cdr l]]]]]]]
[def timeout [λ* timeout
[milliseconds]
"Returns a function that evaluates to true once MILLISECONDS have passed"
[do [def goal [+ [time/milliseconds] milliseconds]]
[λ* #nil
[]
""
[> [time/milliseconds] goal]]]]]
[def event-bind [λ* event-bind
[event-name handler]
"Binds handler lambda to event-name"
[set! [str->sym event-name] [cons handler [resolve [str->sym event-name]]]]]]
[def event-clear [λ* event-clear
[event-name]
"Clears all event handlers for event-name"
[set! [str->sym event-name] '[]]]]
[def event-fire-iter [λ* event-fire-iter
[l v]
"Iter for event-fire"
[if [nil? l]
#t
[if #t
[do [apply [car l] v]
[event-fire-iter [cdr l] v]]
#nil]]]]
[def event-fire [λ* event-fire
[event-name ...val]
"Applies ...val to all event handlers associated with event-name"
[event-fire-iter [resolve [str->sym event-name]] ...val]]]][do [def length [λ* length
[a]
"Returns the length of a"
[if [string? a]
[string/length a]
[if [pair? a]
[list-length a]
[if #t
0
#nil]]]]]
[def describe/thing [λ* describe/thing
[o]
"Describe a specific value O"
[do [def doc [closure o]]
[cat [str/write [doc :arguments]] " - " [doc :documentation]]]]]
[def describe/string [λ* describe/string
[a]
"Descibe whatever value string A resolves to"
[describe/thing [resolve [str->sym a]]]]]
[def describe [λ* describe
[fun]
"Describe FUN, if there is documentation available"
[if [string? fun]
[describe/string fun]
[describe/thing fun]]]]
[def arr-fill! [λ* arr-fill!
[a v i]
"Fills array a with value v"
[if [>= [int i] [arr-length a]]
a
[if #t
[do [arr-set! a [int i] v]
[arr-fill! a v [+ 1 i]]]
#nil]]]]
[def lognand [λ* lognand
[...l]
"Returns the Nand of its arguments"
[lognot [apply logand ...l]]]]
[def mem [λ* mem
[]
"Return some pretty printed memory usage information"
[do [def info [memory-info]]
[cat [ansi-white "Memory Info"] "\n" [ansi-green "Values: "] [getf info :value] "\n" [ansi-blue "Closures: "] [getf info :closure] "\n" [ansi-red "Arrays: "] [getf info :array] "\n" [ansi-yellow "STrings: "] [getf info :string] "\n" [ansi-cyan "NFunc: "] [getf info :native-function] "\n" [ansi-purple "Vectors: "] [getf info :vector] "\n" [ansi-pink "Symbols: "] [getf info :symbol] "\n" ansi-reset]]]]
[def wrap-value [λ* wrap-value
[val min max]
"Constrains VAL to be within MIN and MAX, wrapping it around"
[+ min [% [- val min] [- max min]]]]]
[def symbol-table [λ* symbol-table
[off len environment]
"Return a list of LEN symbols defined in ENVIRONMENT starting at OFF"
[do [if environment
#nil
[set! environment root-closure]]
[if off
#nil
[set! off 0]]
[if len
#nil
[set! len 9999999]]
[sublist [environment [symbol-table*]] off [+ off len] #nil]]]]][do [def except-last-pair/iter [λ* except-last-pair/iter
[list rest]
"Iterator for except-last-pair"
[if [nil? [cdr list]]
[reverse rest]
[except-last-pair/iter [cdr list] [cons [car list] rest]]]]]
[def except-last-pair [λ* except-last-pair
[list]
"Return a copy of LIST without the last pair"
[except-last-pair/iter list #nil]]]
[def last-pair [λ* last-pair
[list]
"Return the last pair of l"
[if [cdr list]
[last-pair [cdr list]]
list]]]
[def make-list/iter [λ* make-list/iter
[number value l]
"Iterator for make-list"
[if [<= number 0]
l
[make-list/iter [- number 1] value [cons value l]]]]]
[def make-list [λ* make-list
[number value]
"Return a list of NUMBER elements containing VALUE in every car"
[make-list/iter number value #nil]]]
[def reduce [λ* reduce
[o l s]
"Combine all elements in l using operation o and starting value s"
[if [nil? l]
s
[reduce o [cdr l] [o s [car l]]]]]]
[def list-ref [λ* list-ref
[l i]
"Returns the the element of list l at location i"
[if [nil? l]
#nil
[if [<= i 0]
[car l]
[if #t
[list-ref [cdr l] [+ -1 i]]
#nil]]]]]
[def join/iter [λ* join/iter
[str l glue]
"Iterator for join/iter"
[if [nil? l]
[substr str 0 [- [string/length str] [string/length glue]]]
[if #t
[join/iter [cat str [car l] glue] [cdr l] glue]
#nil]]]]
[def join [λ* join
[l glue]
"Join LIST into a string with GLUE in between each element"
[join/iter "" l [string glue]]]]
[def split [λ* split
[str separator]
""
[do [def separator-len [string/length separator]]
[def slen [string/length str]]
[def start 0]
[def ret #nil]
[while [< start slen] [do [def pos-found [index-of str separator start]]
[if [>= pos-found 0]
[do [def pos-found [max pos-found [+ start 1]]]
[set! ret [cons [substr str start pos-found] ret]]
[set! start [+ separator-len pos-found]]]
[do [set! ret [cons [substr str start slen] ret]]
[set! start slen]]]]]
[reverse ret]]]]
[def reverse [λ* reverse
[l r]
"Return the list l in reverse order"
[if [nil? l]
r
[reverse [cdr l] [cons [car l] r]]]]]
[def list-length [λ* list-length
[a t]
"Returns the length of list a"
[if [nil? a]
t
[list-length [cdr a] [+ 1 t]]]]]
[def filter [λ* filter
[p l]
"Runs predicate p over every item in list l and returns a list consiting solely of items where p is true"
[do [def ret #nil]
[if l
[if [p [car l]]
[cons [car l] [filter p [cdr l]]]
[filter p [cdr l]]]
#nil]]]]
[def for-each [λ* for-each
[f l]
"Runs f over every item in list l and returns the resulting list"
[while l [do [f [car l]]
[set! l [cdr l]]]]]]
[def map [λ* map
[f l]
"Runs f over every item in list l and returns the resulting list"
[if [nil? l]
l
[cons [f [car l]] [map f [cdr l]]]]]]
[def append/iter [λ* append/iter
[a b]
"Iterator for append"
[if [nil? a]
b
[append/iter [cdr a] [cons [car a] b]]]]]
[def append [λ* append
[a b]
"Appends to two lists a and b together"
[append/iter [reverse a] b]]]
[def sublist [λ* sublist
[l start end ret]
"Returns a new list containing all elements of l from start to end"
[if [nil? l]
[reverse ret]
[if [neg? end]
[sublist l start [+ [length l] end]]
[if [zero? end]
[reverse ret]
[if [> start 0]
[sublist [cdr l] [+ -1 start] [+ -1 end] #nil]
[if [> end 0]
[sublist [cdr l] 0 [+ -1 end] [cons [car l] ret]]
#nil]]]]]]]
[def list-head [λ* list-head
[l k]
"Returns the first k elemnts of list l"
[sublist l 0 k]]]
[def list-tail [λ* list-tail
[l k]
"Returns the sublist of l obtained by omitting the first l elements"
[sublist l k [length l]]]]
[def member [λ* member
[m l]
"Returns the first pair of list l whose car is equal to m"
[if [nil? l]
#f
[if [eq? [car l] m]
l
[if #t
[member m [cdr l]]
#nil]]]]]
[def delete [λ* delete
[e l]
"Returns a filtered list l with all elements equal to e omitted"
[filter [λ* #nil
[a]
""
[not [eq? a e]]] l]]]
[def arg-list [λ* arg-list
[f]
"Return the Argument list of f which can be a Native Function or a Lambda"
[if [lambda? f]
[reduce cat [map [λ* #nil
[a]
""
[" " [car a]]] [cl-data f]]]
[if [native? f]
[reduce cat [map [λ* #nil
[a]
""
[" " a]] [car [cl-data f]]]]
[if #t
""
#nil]]]]]
[def getf [λ* getf
[l key]
"Return the value in LIST following KEY"
[if [nil? l]
#nil
[if [eq? key [car l]]
[cadr l]
[if #t
[getf [cdr l] key]
#nil]]]]]][do [def PI 3.14159]
[def π 3.14159]
[def ++ [μ* ++ [i] "Increment I by 1 and store the result in I" [cons 'set! [cons i [cons [cons '+ [cons 1 [cons i #nil]]] #nil]]]]]
[def -- [μ* -- [i] "Decrement I by 1 and store the result in I" [cons 'set! [cons i [cons [cons '+ [cons -1 [cons i #nil]]] #nil]]]]]
[def +x [λ* +x
[α]
"Return a function that adds α to it\'s argument, useful for mapping"
[λ* #nil
[β]
""
[+ α β]]]]
[def >> [λ* >>
[val amount]
"Shifts VAL by AMOUNT bits to the right"
[ash val [- amount]]]]
[def min/iter [λ* min/iter
[a l]
""
[if [nil? l]
a
[if [< a [car l]]
[min/iter a [cdr l]]
[if #t
[min/iter [car l] [cdr l]]
#nil]]]]]
[def min [λ* min
[...l]
"Returns the minimum value of its arguments"
[if [nil? ...l]
0
[if [nil? [cdr ...l]]
[car ...l]
[if #t
[min/iter [car ...l] [cdr ...l]]
#nil]]]]]
[def max/iter [λ* max/iter
[a l]
""
[if [nil? l]
a
[if [> a [car l]]
[max/iter a [cdr l]]
[if #t
[max/iter [car l] [cdr l]]
#nil]]]]]
[def max [λ* max
[...l]
"Returns the maximum value of its arguments"
[if [nil? ...l]
0
[if [nil? [cdr ...l]]
[car ...l]
[if #t
[max/iter [car ...l] [cdr ...l]]
#nil]]]]]
[def fib [λ* fib
[i]
"Terribly inefficient, but, useful for testing the GC"
[if [< i 2]
i
[+ [fib [- i 2]] [fib [- i 1]]]]]]][do [def random/seed 0]
[def random/seed-initialize! [λ* random/seed-initialize!
[]
""
[set! random/seed [logxor [time] [time/milliseconds]]]]]
[def random/rng! [λ* random/rng!
[]
""
[do [set! random/seed [+ 12345 [* random/seed 1103515245]]]
[logior [ash [logand random/seed 65535] 16] [logand [ash random/seed -16] 65535]]]]]
[def random/seed! [λ* random/seed!
[new-seed]
"Set a new seed value for the RNG"
[set! seed new-seed]]]
[def random/seed [λ* random/seed
[]
"Return the current RNG seed value"
seed]]
[def random [λ* random
[max]
"Return a value from 0 to MAX, or, if left out, a random int"
[if [numeric? max]
[mod [abs [random/rng!]] max]
[random/rng!]]]]
[random/seed-initialize!]][do [def describe/closure [λ* describe/closure
[c i]
""
[if c
[do [def info [closure c]]
[if [and info [info :call]]
[cat [ansi-blue [cat [int i] "# " [str/write c]]] " - " [str/write [info :data]] "\r\n" [describe/closure [closure-caller c] [+ [int i] 1]]]
#nil]]
#nil]]]
[def stacktrace [λ* stacktrace
[]
""
[display [describe/closure [closure-caller [current-lambda]]]]]]][do [def println [λ* println
[str]
"Print STR on a single line"
[print [cat str "\n"]]]]
[def display [λ* display
[value]
"Display VALUE"
[print value]]]
[def newline [λ* newline
[]
"Print a single line feed character"
[display "\n"]]]
[def br [λ* br
[num]
"Return NUM=1 linebreaks"
[if [or [nil? num] [<= [int num] 1]]
"\n"
["\n" [br [+ -1 num]]]]]]
[def path/ext?! [λ* path/ext?!
[ext]
"Return a predicate that checks if a path ends on EXT"
[λ* #nil
[path]
""
[eq? ext [lowercase [path/extension path]]]]]]
[def path/extension [λ* path/extension
[path]
"Return the extension of PATH"
[do [def last-period [last-index-of path "."]]
[if [>= last-period 0]
[substr path [+ 1 last-period] [string/length path]]
path]]]]
[def path/without-extension [λ* path/without-extension
[path]
"Return PATH, but without the extension part"
[do [def last-period [last-index-of path "."]]
[if [>= last-period 0]
[substr path 0 last-period]
path]]]]
[def int->string/binary [λ* int->string/binary
[α]
"Turn α into a its **binary** string representation"
[do [def ret ""]
[if α
#nil
[def α 0]]
[if [zero? α]
[set! ret "0"]
#nil]
[while [not-zero? α] [do [set! ret [cat [from-char-code [+ 48 [logand α 1]]] ret]]
[set! α [ash α -1]]]]
ret]]]
[def int->string/octal [λ* int->string/octal
[α]
"Turn α into a its **octal** string representation"
[do [def ret ""]
[if α
#nil
[def α 0]]
[if [zero? α]
[set! ret "0"]
#nil]
[while [not-zero? α] [do [set! ret [cat [from-char-code [+ 48 [logand α 7]]] ret]]
[set! α [ash α -3]]]]
ret]]]
[def int->string/hex [let* [do [def conversion-arr [arr "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]]
[λ* #nil
[α]
""
[do [def ret ""]
[if α
#nil
[def α 0]]
[if [zero? α]
[set! ret "0"]
#nil]
[while [not-zero? α] [do [set! ret [cat [conversion-arr [logand α 15]] ret]]
[set! α [ash α -4]]]]
ret]]]]]
[def int->string/decimal [λ* int->string/decimal
[α]
"Turn α into a its **decimal** string representation"
[string α]]]
[def int->string int->string/decimal]
[def string/pad-start [λ* string/pad-start
[text goal-length char]
"Pad out TEXT with CHAR at the start until it is GOAL-LENGTH chars long, may also truncate the string"
[do [if char
#nil
[set! char " "]]
[while [< [string/length text] goal-length] [set! text [cat char text]]]
[if [> [string/length text] goal-length]
[substr text [- [string/length text] goal-length] [string/length text]]
text]]]]
[def string/pad-end [λ* string/pad-end
[text goal-length char]
"Pad out TEXT with CHAR at the end until it is GOAL-LENGTH chars long, may also truncate the string"
[do [if char
#nil
[set! char " "]]
[while [< [string/length text] goal-length] [set! text [cat text char]]]
[if [> [string/length text] goal-length]
[substr text 0 goal-length]
text]]]]][do [test/add* 1073741824 '[do [ash 1 30]]]
[test/add* 2147483647 '[do [lognot [ash 1 31]]]]
[test/add* 1 '[do 1]]
[test/add* 3 '[do [+ 1 2]]]
[test/add* -1 '[do [+ 1 -2]]]
[test/add* 3 '[do [- 4 1]]]
[test/add* 5 '[do [- 4 -1]]]
[test/add* 8 '[do [* 4 2]]]
[test/add* 16 '[do [* 4 4]]]
[test/add* 2 '[do [/ 4 2]]]
[test/add* 2 '[do [do 2]]]
[test/add* 4 '[do [/ 8 2]]]
[test/add* 1 '[do [% 5 2]]]
[test/add* 0 '[do [% 4 2]]]
[test/add* 3.1 '[do [+ 1 2.1]]]
[test/add* 2.1 '[do [* 1 2.1]]]
[test/add* 3 '[do [int [vec/x [+ [vec 1.1 1.2 1.3] [vec 2 2 2]]]]]]
[test/add* 39 '[do [+ 42 [- 3]]]]
[test/add* 24 '[do [* 4 [- [+ 1 [+ 1 1]] [- 3 3 3]]]]]
[test/add* 3 '[do [div 9 3]]]
[test/add* 3 '[do [let [[vier -4]] [+ [% 9 4] [/ -9 vier]]]]]
[test/add* 69 '[do [+ [* 2 [/ 32 8] [- 16 8]] 5]]]
[test/add* 3 '[do [def eins 1]
[def zwei 2]
[+ eins zwei]]]
[test/add* -3 '[do [def eins 1]
[def zwei 2]
[def drei [+ eins zwei]]
[set! eins [- drei drei drei]]]]
[test/add* 128 '[do [def zahl 128]
zahl]]
[test/add* 10 '[do [let [[a 10]] a]]]
[test/add* 20 '[do [def b 20]
[let [[a b]] a]]]
[test/add* 10 '[do [def b 20]
[let [[a b]] [set! a 10] a]]]
[test/add* 20 '[do [def b 20]
[let [[a b]] [set! a 10] b]]]
[test/add* 42 '[do [let [[a 12] [b 30]] [+ a b]]]]
[test/add* 16 '[do [def square [λ [a]
[* a a]]]
[square 4]]]
[test/add* 0 '[do [- -1 -1]]]
[test/add* #t '[do [or #f [and [> 5 1] [not [< 5 1]] [>= 5 5] [<= 5 5]]]]]
[test/add* #t '[do [and [= #t #t] [= #f #f] [not [= #f #t]] [= 2 2]]]]
[test/add* 11 '[do [length "Hallo, Welt"]]]
[test/add* #t '[do [numeric? 0.1]]]
[test/add* #t '[do [bool #t]]]
[test/add* #f '[do [bool #nil]]]
[test/add* #f '[do [bool #f]]]
[test/add* #t '[do [bool 0]]]
[test/add* #t '[do [bool 1]]]
[test/add* #t '[do [bool 0.1]]]
[test/add* #t '[do [bool ""]]]
[test/add* #t '[do [bool "a"]]]
[test/add* 14 '[do [def abs [λ [a]
[if [neg? a]
[- 0 a]
a]]]
[+ [abs -7] [abs 7]]]]
[test/add* #t '[do [and [or #f #t] [and #t #t]]]]
[test/add* #t '[do [and [neg? -1] [neg? -0.01] [pos? 0] [pos? 0.01] [not [neg? 0]] [not [pos? -0.01]] [not [neg? #f]]]]]
[test/add* #t '[do [numeric? 1]]]
[test/add* #t '[do [numeric? -1]]]
[test/add* #t '[do [numeric? 0]]]
[test/add* #t '[do [numeric? 0.1]]]
[test/add* #t '[do [numeric? [vec 1 2 3]]]]
[test/add* #f '[do [numeric? [arr 1 2 3]]]]
[test/add* #f '[do [numeric? '[1 2 3]]]]
[test/add* #f '[do [numeric? [tree/new :a 1 :b 2 :c 3]]]]
[test/add* #t '[do [and [numeric? [vec 1]] [not [numeric? #f]] [not [numeric? "123"]]]]]
[test/add* #t '[do [and [numeric? 1] [numeric? -1] [numeric? 0] [numeric? 0.1] [numeric? [vec 1]] [not [numeric? #f]] [not [numeric? "123"]]]]]
[test/add* 12340 '[do [- [int [cat 12 "3" "45 Test"]] 5]]]
[test/add* 12340 '[do [let [[a [cat 12 "3" 45]]] [- [int a] [length a]]]]]
[test/add* 123 '[do [int [cat "123" "abc" 456]]]]
[test/add* 28 '[do [+ [int 10] [int 10.23] [int "8"]]]]
[test/add* #t '[do [and [not [< 3 2]] [zero? 0] [> 3.1 2.1] [> 3 2] [>= 4 "3"] [>= 3 3] [<= 3 3] [not [>= "2" 3]]]]]
[test/add* 1 '[do [int [float [+ [vec 1] [vec 0 9 9]]]]]]
[test/add* 0 '[do [- #nil]]]
[test/add* #t '[do [and [pair? [cons 1 '[2]]] [not [pair? 1]]]]]
[test/add* 1 '[do [car [cons 1 '[2]]]]]
[test/add* 2 '[do [+ [cadr '[1 2]] [cadr #nil] [cadr '[1]]]]]
[test/add* #t '[do [string? [describe "min"]]]]
[test/add* 3 '[do [+ 1 [- [length '[1 2 3]] 1]]]]
[test/add* #t '[do [and [for-all? '[1 2 3] int?] [not [for-all? '[1 2 3.0] int?]]]]]
[test/add* #t '[do [and [there-exists? '[1.0 2 3.0] int?] [not [there-exists? '[1.0 2.0 3.0] int?]]]]]
[test/add* #t '[do [and [eq? "asd" "asd"] [not [eq? "asd" "bsd"]] [not [eq? "asd" "asdasd"]]]]]
[test/add* 23 '[do [+ [reduce + [make-list 10 2] 0] [list-ref '[1 2 3 4] 1] [list-ref '[1 2] 0] [list-ref '[1 2] 3]]]]
[test/add* #t '[do [and [nil? #nil] [not [nil? "NotNil"] [vec? [vec 1]] [not [vec? "NotVec"]]]]]]
[test/add* 11 '[do [def count [let [[a 0]] [λ [b]
[set! a [+ a [cond [[numeric? b] b]
[#t 1]]]]]]]
[count 10]
[count]]]
[test/add* 4 '[do [let [[a 10]] [when [when #t [set! a [+ 2 "2"]] #f] [set! a -1]] a]]]
[test/add* 6 '[do [eval '[+ 1 2 3]]]]
[test/add* 4 '[do [arr-length [arr 1 2 3 4]]]]
[test/add* 2 '[do [arr-ref [arr 1 2 3 4] 1]]]
[test/add* 3 '[do [arr-length [arr-new 3]]]]
[test/add* #t '[do [arr? [arr 1 2 3]]]]
[test/add* #t '[do [arr? [arr-new 3]]]]
[test/add* #f '[do [arr? '[1 2 3]]]]
[test/add* #f '[do [arr? [tree/new :a 1 :b 2 :c 3]]]]
[test/add* 10 '[do [+ [apply + '[1 2 3]] [apply [λ [α]
[+ 1 α]] '[3]]]]]
[test/add* 0 '[do [apply +]]]
[test/add* 0 '[do [def cb '+]
[apply cb]]]
[test/add* 1 '[do [apply [λ [α]
[+ 1 α]]]]]
[test/add* 1 '[do [def cb [λ [α]
[+ 1 α]]]
[apply cb]]]
[test/add* 1 '[do [let [[cb [λ [α]
[+ 1 α]]]] [apply cb]]]]
[test/add* 1 '[do [let* [def cb [λ [α]
[+ 1 α]]] [apply cb]]]]
[test/add* 5 '[do [length "12345"]]]
[test/add* #f '[do [or 0 0]]]
[test/add* 2 '[do [and 1 2]]]
[test/add* #t '[do [bool [and 1 1]]]]
[test/add* #t '[do [bool 1]]]
[test/add* 6 '[do [[λ [a]
[+ a 4]] 2]]]
[test/add* 2 '[do [def test 1]
[def test 2]
test]]
[test/add* 0 '[do [max]]]
[test/add* 0 '[do [min]]]
[test/add* 1 '[do [max 1]]]
[test/add* 4 '[do [min 4]]]
[test/add* 4 '[do [min 4 9]]]
[test/add* 9 '[do [max 4 9]]]
[test/add* 25 '[do [max 1 4.0 9 25]]]
[test/add* 25 '[do [max 25 4.0 9 1]]]
[test/add* 1 '[do [min 1 4.0 9 25]]]
[test/add* 1 '[do [min 25 4.0 9 1]]]
[test/add* #t '[do [even? 2]]]
[test/add* #f '[do [even? 9]]]
[test/add* #t '[do [odd? 7]]]
[test/add* #f '[do [odd? 4]]]
[test/add* 256 '[do [int [pow 2 8]]]]
[test/add* 3 '[do [def ein-test-arr [arr 1 2 3]]
[ein-test-arr 2]]]
[test/add* 3 '[do [def ein-test-arr [arr 1 2 3]]
[ein-test-arr 2 9]
[ein-test-arr 2]]]
[test/add* 123 '[do [def i-assaultmegablaster 123]
i-assaultmegablaster]]
[test/add* #t '[do [int? [random]]]]
[test/add* #t '[do [set! random/seed 123]
[def first-value [random]]
[set! random/seed 123]
[eq? first-value [random]]]]
[test/add* #t '[do [!= [random] [random]]]]
[test/add* 1 '[do [def a 1]
[when-not [= 2 2] [set! a 4]]
a]]
[test/add* 4 '[do [def a 1]
[when-not [= 2 3] [set! a 4]]
a]]
[test/add* 4 '[do [def a 1]
[when [= 2 2] [set! a 4]]
a]]
[test/add* 1 '[do [def a 1]
[when [= 2 3] [set! a 4]]
a]]
[test/add* 3 '[do [def ein-test-arr [arr 1 2 3]]
[ein-test-arr 2.2]]]
[test/add* 123 '[do 123]]
[test/add* 6 '[do 6]]
[test/add* 10 '[do 10]]
[test/add* 15 '[do 15]]
[test/add* 7 '[do 7]]
[test/add* 192 '[do 192]]
[test/add* 255 '[do 255]]
[test/add* 255 '[do 255]]
[test/add* 160 '[do 160]]
[test/add* 31 '[do 31]]
[test/add* 30 '[do 30]]
[test/add* 50 '[do 50]]
[test/add* 256 '[do 256]]
[test/add* 0 '[do 0]]
[test/add* 7 '[do 7]]
[test/add* 10 '[do 10]]
[test/add* 26 '[do 26]]
[test/add* -1 '[do -1]]
[test/add* -1 '[do -1]]
[test/add* 2 '[do [- [+ 1 2] 1]]]
[test/add* 8 '[do [- [+ 1 8] 1]]]
[test/add* 16 '[do [- [+ 1 16] 1]]]
[test/add* 32 '[do [+ 16 16]]]
[test/add* 16 '[do [+ 16 #f]]]
[test/add* 32 '[do [+ 16 "16"]]]
[test/add* 32 '[do [+ 16 [+ 0 16]]]]
[test/add* 0 '[do [logand 240 15]]]
[test/add* 255 '[do [logior 240 15]]]
[test/add* 255 '[do [logior 255 255]]]
[test/add* 255 '[do [logxor 240 15]]]
[test/add* 240 '[do [logxor 255 15]]]
[test/add* -1 '[do [lognot 0]]]
[test/add* 0 '[do [lognot -1]]]
[test/add* 16 '[do [ash 1 4]]]
[test/add* 65536 '[do [ash 1 16]]]
[test/add* -1 '[do [ash -1 -1]]]
[test/add* -16 '[do [lognand 15 15]]]
[test/add* 6 '[do [eval [read "[+ 1 2 3]"]]]]
[test/add* '[3] '[do [let [[test-string "3"]] [read test-string] [read test-string]]]]
[test/add* "[vec 1.0 2.0 3.0]" '[do [abs [vec -1 -2 -3]]]]
[test/add* "3.33333" '[do [+ 1.11111 2.22222]]]
[test/add* "\"H#Hallo\"" '[do [let [[a "Hallo, Welt#"]] [cat [substr a 0 1] [substr a -1] [substr a 0 -7]]]]]
[test/add* "\"Test\"" '[do [def a "Test"]
a]]
[test/add* "11.6" '[do [+ [+ 1.1 2.2] [+ 1.1 3] [+ 1 3.2]]]]
[test/add* "20.1" '[do [+ [+ 1.1 3] [+ 1 3.3] [+ 3.3 4.1 4.3]]]]
[test/add* "15.54" '[do [add [mul 3.2 3.2] [sub 5.5 1.1 1 1.1] [div 9.9 3.3]]]]
[test/add* "0.7" '[do [% 10 3.1]]]
[test/add* "11.7" '[do [add [+ 1.1 2.2] [+ 1.1 3] [+ 1 3.3]]]]
[test/add* "11.75" '[do [+ [float 10] [int "10"] [float "-8.25"]]]]
[test/add* "30.3" '[do [+ [abs [int "-10"]] [int 8.2] 12.3]]]
[test/add* "[vec 12.0 12.0 12.0]" '[do [+ [vec 1] 1 10]]]
[test/add* "[vec 3.0 5.0 6.0]" '[do [+ [vec 1] [vec 1 2] [vec 1 2 3]]]]
[test/add* "[vec 3.0 3.0 3.0]" '[do [+ 1 [vec 1] 1.0]]]
[test/add* "[vec 3.0 3.0 3.0]" '[do [+ 1.0 [vec 1] "1"]]]
[test/add* "[vec -1.0 -1.0 -1.0]" '[do [- [vec 1] [vec 1.0] [vec "1"]]]]
[test/add* "2.7" '[do [+ [- 1 -1.0] [- 5 1.1 1] [- 1 1.1 1] [- 1 1.1 [int "1"]]]]]
[test/add* "[vec 3.0 3.0 3.0]" '[do [+ 1 [vec 1] 1.0]]]
[test/add* "[vec -1.0 -1.0 -1.0]" '[do [- 1 [vec 1] 1.0]]]
[test/add* "[vec 8.0 8.0 8.0]" '[do [* [vec 2] "4"]]]
[test/add* "[vec 1.0 1.0 1.0]" '[do [mod [vec 9] 2]]]
[test/add* "1.0" '[do [float [int [+ [vec 1] [vec 0 9 9]]]]]]
[test/add* '[] '[do [cons]]]
[test/add* "[]" '[do [cons]]]
[test/add* '[1] '[do [cons 1]]]
[test/add* "[1]" '[do [cons 1]]]
[test/add* 1 '[do [car [cons 1 2]]]]
[test/add* 2 '[do [cdr [cons 1 2]]]]
[test/add* "[1 . 2]" '[do [cons 1 2]]]
[test/add* "[1 2]" '[do [cons 1 '[2]]]]
[test/add* "[4 3 2 1]" '[do [reverse '[1 2 3 4]]]]
[test/add* "[1 2.0 3 1 2.0 3]" '[do [append '[1 2.0 3] '[1 2.0 3]]]]
[test/add* "[1 4]" '[do [filter int? '[1 2.0 #t 4]]]]
[test/add* "[2.0]" '[do [filter float? '[1 2.0 #t 4]]]]
[test/add* "[2.0]" '[do [filter float? '[1 2.0 #t 4]]]]
[test/add* "[#t]" '[do [filter bool? '[1 2.0 #t 4]]]]
[test/add* "[2 3]" '[do [sublist '[1 2 3 4 5 6] 1 3]]]
[test/add* "[1 2 3]" '[do [list-head '[1 2 3 4 5 6] 3]]]
[test/add* "[4 5 6]" '[do [list-tail [list 1 2 3 4 5 6] 3]]]
[test/add* "[3]" '[do [last-pair [list 1 2 3]]]]
[test/add* "[1 2]" '[do [except-last-pair '[1 2 3]]]]
[test/add* "[1.0 #t \"a\"]" '[do [let [[l '[1.0 #t "a"]]] [append [except-last-pair l] [last-pair l]]]]]
[test/add* "[\"asd\" #t #f]" '[do [member "asd" '[123 456 "asd" #t #f]]]]
[test/add* "[[vec 4.0 4.0 4.0] 9 16.0]" '[do [map [λ [a]
[* a a]] [cons [vec 2] '[3 4.0]]]]]
[test/add* "\"11.0\"" '[do [cat 1 1.0]]]
[test/add* "[vec 9.0 9.0 9.0]" '[do [div [vec 99] [cat 1 1.0]]]]
[test/add* "#[99 12 3 4]" '[do [let [[cur-arr [arr 1 2 3 4]]] [arr-set! cur-arr 0 99 12] cur-arr]]]
[test/add* "#[42 42 42 42 42 42]" '[do [arr-fill! [arr-new 6] 42]]]
[test/add* "#nil" '[do [apply #nil]]]
[test/add* "[vec 1.0 3.0 9.0]" '[do [def vs [λ [a]
[vec [vec/z a] [vec/y a] [vec/x a]]]]
[vs [vec 9 3.0 "1"]]]]
[test/add* "3" '[do [def fib [λ [a]
[cond [[zero? a] 0]
[[= a 1] 1]
[#t [+ [fib [- a 1]] [fib [- a 2]]]]]]]
[fib 4]]]
[test/add* "21" '[do [def fib [λ [a]
[cond [[zero? a] 0]
[[= a 1] 1]
[#t [+ [fib [- a 1]] [fib [- a 2]]]]]]]
[fib 8]]]
[test/add* "102334155" '[do [def fib-iter [λ [a b count]
[cond [[= count 0] b]
[#t [fib-iter [+ a b] a [- count 1]]]]]]
[def fib [λ [n]
[fib-iter 1 0 n]]]
[fib 40]]]
[test/add* "\"ASD123\"" '[do [uppercase "asD123"]]]
[test/add* "\"asd123\"" '[do [lowercase "aSD123"]]]
[test/add* "\"Asd123\"" '[do [capitalize "aSD123"]]]
[test/add* "[vec 1.0 1.0 1.0]" '[do [floor [vec 1.3 1.3 1.3]]]]
[test/add* "2.0" '[do [ceil 1.3]]]
[test/add* "[vec 2.0 2.0 2.0]" '[do [ceil [vec 1.3 1.3 1.3]]]]
[test/add* "1.0" '[do [round 1.3]]]
[test/add* "2.0" '[do [round 1.51]]]
[test/add* "3.0" '[do [sqrt 9]]]
[test/add* "[vec 5.0 5.0 5.0]" '[do [sqrt [vec 25 25 25]]]]
[test/add* "256.0" '[do [pow 2.0 8]]]
[test/add* "[vec 4.0 8.0 16.0]" '[do [pow 2.0 [vec 2.0 3.0 4.0]]]]
[test/add* "\"123\"" '[do [string 123]]]
[test/add* "\"#t\"" '[do [string #t]]]
[test/add* "#nil" '[do testerle]]
[test/add* ":testerle" '[do :testerle]]
[test/add* :testerle '[do :testerle]]
[test/add* '[:asd qwerty] '[do [:asd qwerty]]]
[test/add* :asd '[do [do [def :asd #t]
:asd]]]
[test/add* "[1 . 2]" '[do [def test [cons 1 2]]
test]]
[test/add* "\"Eins\"" '[do [def eins [ω [def say [λ []
"Eins"]]]]
[eins [say]]]]
[test/add* "\"Zwei\"" '[do [def eins [ω [def say [λ []
"Zwei"]]]]
[def zwei [eins [ω]]]
[zwei [say]]]]
[test/add* "\"asd\"" '[do ["a" "s" "d"]]]
[test/add* "\"a\"" '[do ["a"]]]
[test/add* "#nil" '[do [def testerle [arr 1 2 3]]
[testerle 4]]]
[test/add* "#nil" '[do [def testerle [arr 1 2 3]]
[testerle 40000]]]
[test/add* "#[1 2 3]" '[do [def testerle [arr 1 2 3]]
[testerle]]]
[test/add* "#nil" '[do [def testerle [arr 1 2 3]]
[testerle #t]]]
[test/add* "#nil" '[do [def testerle [arr 1 2 3]]
[testerle [vec 1 2 3]]]]
[test/add* "\"Trim Test\"" '[do [trim " Trim Test \n"]]]
[test/add* "\"1,asd,3.0,#f\"" '[do [join '[1 "asd" 3.0 #f] ","]]]
[test/add* "[1.0 2.0 3.0]" '[do [map float [split "1,2,3" ","]]]]
[test/add* "[\"dies ist\" \"ein\" \"test\"]" '[do [split "dies ist/ein/test" "/"]]]
[test/add* 1 '[do [index-of "1,2,3" ","]]]
[test/add* 291 '[do [car [read [join [cons "#x" [split "123" ""]]]]]]]
[test/add* 7 '[do [char-at "\a" 0]]]
[test/add* 5 '[do [char-at [from-char-code 5 10 20] 0]]]
[test/add* 2600 '[do [int [from-char-code [char-at "2" 0] 54 48 48]]]]
[test/add* #t '[do [eq? 32 32]]]
[test/add* #t '[do [eq? 8 8]]]
[test/add* #t '[do [eq? 9 [char-at "\t" 0]]]]
[test/add* #t '[do [and [eq? 13 13] [eq? 13 13]]]]
[test/add* #t '[do [and [eq? 10 10] [eq? 10 10]]]]
[test/add* 7 '[do [char-at "\a" 0]]]
[test/add* 8 '[do [char-at "\b" 0]]]
[test/add* 27 '[do [char-at "\e" 0]]]
[test/add* 12 '[do [char-at "\f" 0]]]
[test/add* 10 '[do [char-at "\n" 0]]]
[test/add* 13 '[do [char-at "\r" 0]]]
[test/add* 9 '[do [char-at "\t" 0]]]
[test/add* 11 '[do [char-at "\v" 0]]]
[test/add* 39 '[do [char-at "\'" 0]]]
[test/add* 34 '[do [char-at "\"" 0]]]
[test/add* #t '[do [> [symbol-count] 200]]]
[test/add* #t '[do [equal? + add]]]
[test/add* #t '[do [eq? min min]]]
[test/add* #t '[do [let [[some-value #f]] [not some-value]]]]
[test/add* 4 '[do [>> 8 1]]]
[test/add* 15 '[do [1 + 2 * [3 + 4]]]]
[test/add* 9 '[do [10 - 1]]]
[test/add* 5 '[do [10 / 2]]]
[test/add* 256 '[do [1 << 8]]]
[test/add* #t '[do [eq? :asd :asd]]]
[test/add* #t '[do [eq? :bool [type-of #f]]]]
[test/add* #t '[do [eq? :int [type-of 123]]]]
[test/add* #f '[do [eq? :int [type-of 123.123]]]]
[test/add* #t '[do [eq? :float [type-of 123.123]]]]
[test/add* #t '[do [eq? :vec [type-of [vec 1]]]]]
[test/add* #t '[do [eq? :native-function [type-of +]]]]
[test/add* #t '[do [eq? :lambda [type-of test/add*]]]]
[test/add* #t '[do [eq? :string [type-of "asd"]]]]
[test/add* 2 '[do [getf [list :a 1 :b 2 :c 3] :b]]]
[test/add* "#nil" '[do [getf [list :a 1 :b 2 :c 3] :d]]]
[test/add* "\"\\n\"" '[do "\n"]]
[test/add* "\"\\n\"" '[do [br]]]
[test/add* "\"\\n\\n\\n\"" '[do [br 3]]]
[test/add* :dies-ist-ein-test-ob-lange-sym '[do :dies-ist-ein-test-ob-lange-sym]]
[test/add* #t '[do [eq? [+ 2 2] [2 + 2]]]]
[test/add* #t '[do [eq? 4 [2 + 2]]]]
[test/add* #t '[do [eq? 4 [+ 2 2]]]]
[test/add* :int '[do [type-of [+ 2 2]]]]
[test/add* :int '[do [type-of [2 + 2]]]]
[test/add* :float '[do [type-of [+ 2.0 2.1]]]]
[test/add* :float '[do [type-of [2.0 + 2.1]]]]
[test/add* :float '[do [type-of [+ 2 2.1]]]]
[test/add* :float '[do [type-of [2 + 2.1]]]]
[test/add* -1 '[do [-1]]]
[test/add* -1 '[do [- 1]]]
[test/add* -1 '[do [let [[a 1]] [- a]]]]
[test/add* -1 '[do [let [[a 1]] [[[- a]]]]]]
[test/add* -1 '[do [let [[a 1]] [[- a]]]]]
[test/add* 0 '[do [wrap-value 0 0 2]]]
[test/add* 1 '[do [wrap-value 1 0 2]]]
[test/add* 0 '[do [wrap-value 2 0 2]]]
[test/add* 1 '[do [wrap-value 3 0 2]]]
[test/add* 0 '[do [wrap-value 4 0 2]]]
[test/add* #t '[do [zero-neg? 0]]]
[test/add* #t '[do [zero-neg? -4.0]]]
[test/add* #f '[do [zero-neg? 0.1]]]
[test/add* 0 '[do [let [[tmp [vec 0 0 0]]] [+ tmp [vec 1 1 1]] [vec/y tmp]]]]
[test/add* 0 '[do [let [[tmp 0]] [+ tmp 1] tmp]]]
[test/add* #t '[do [list-equal? '[] '[]]]]
[test/add* #f '[do [list-equal? '[] '[1]]]]
[test/add* #f '[do [list-equal? '[1] '[]]]]
[test/add* #t '[do [list-equal? '[1 "asd"] '[1 "asd"]]]]
[test/add* #f '[do [list-equal? '[1 "asd"] '[1 "as"]]]]
[test/add* #f '[do [list-equal? '[1 :asd] '[1 :as]]]]
[test/add* #t '[do [list-equal? '[1 :asd] '[1 :asd]]]]
[test/add* #t '[do [list-equal? '[1 asd] '[1 asd]]]]
[test/add* #t '[do [list-equal? '[1 #f] '[1 #f]]]]
[test/add* #f '[do [list-equal? '[1 #t] '[1 #f]]]]
[test/add* #t '[do [list-equal? '[1 2 3] '[1 2 3]]]]
[test/add* #f '[do [list-equal? '[1 2 3] '[1 2 4]]]]
[test/add* #f '[do [list-equal? '[1 2 3] '[1 2]]]]
[test/add* #f '[do [list-equal? '[1 2 3] '[1 2 [3 4]]]]]
[test/add* #t '[do [list-equal? '[1 2 [3 4]] '[1 2 [3 4]]]]]
[test/add* #t '[do [list-equal? '[1 2 [3 4]] '[1 2 [3 4]]]]]
[test/add* "do" '[do 'do]]
[test/add* "[123]" '[do '[123]]]
[test/add* "[123 #t]" '[do '[123 #t]]]
[test/add* "[123 \'do]" '[do '[123 'do]]]
[test/add* "[123 \"asd\"]" '[do '[123 "asd"]]]
[test/add* 2 '[do [wrap-value 2 2 4]]]
[test/add* 3 '[do [wrap-value 3 2 4]]]
[test/add* 2 '[do [wrap-value 4 2 4]]]
[test/add* 3 '[do [wrap-value 5 2 4]]]
[test/add* #t '[do [1 < 10]]]
[test/add* #f '[do [1 > 10]]]
[test/add* #t '[do [1 <> 10]]]
[test/add* #f '[do [1 <> 1]]]
[test/add* #t '[do [1 != 10]]]
[test/add* #f '[do [1 != 1]]]
[test/add* #f '[do [1 = 10]]]
[test/add* #t '[do [1 = 1]]]
[test/add* #t '[do [1 >= 1]]]
[test/add* #t '[do [1 <= 1]]]
[test/add* #t '[do [1 <= 4]]]
[test/add* #t '[do [4 >= 1]]]
[test/add* #f '[do [and #nil #nil]]]
[test/add* #t '[do [eq? #nil #nil]]]
[test/add* #t '[do [eq? #t #t]]]
[test/add* #f '[do [eq? #t #f]]]
[test/add* #t '[do [eq? #f #f]]]
[test/add* #f '[do [eq? '[] #f]]]
[test/add* #f '[do [eq? #f '[]]]]
[test/add* #f '[do [eq? '[] #t]]]
[test/add* #f '[do [eq? #t '[]]]]
[test/add* #t '[do [eq? '[] '[]]]]
[test/add* #f '[do [eq? '[] '[1]]]]
[test/add* #f '[do [eq? '[1] '[1]]]]
[test/add* #t '[do [list-equal? '[1] '[1]]]]
[test/add* #f '[do [eq? '[] #nil]]]
[test/add* 10000 '[do [let [] [def i 0] [while [< i 10000] [set! i [+ 1 i]]]]]]
[test/add* '[1 :a "q"] '[do '[1 :a "q"]]]
[test/add* 4 '[do [compile '[do "Test"
4]]]]
[test/add* '[do [display "Test"]
4] '[do [compile '[do [display "Test"]
4]]]]
[test/add* '[do [display "Test"]
4] '[do [compile '[do [display "Test"]
9
4]]]]
[test/add* '[λ* #nil
[v]
"Add 1 to V"
[+ 1 v]] '[do [compile '[λ [v]
"Add 1 to V"
[+ 1 v]]]]]
[test/add* '[λ* #nil
[v]
""
[+ 1 v]] '[do [compile '[λ [v]
[+ 1 v]]]]]
[test/add* '[λ* #nil
[v]
""
[do [display v]
[+ 1 v]]] '[do [compile '[λ [v]
[display v]
[+ 1 v]]]]]
[test/add* '[1 2] '[do [except-last-pair '[1 2 3]]]]
[test/add* '[3] '[do [last-pair '[1 2 3]]]]
[test/add* '[1 3 5] '[do [filter odd? '[1 2 3 4 5 6]]]]
[test/add* '[2 4 6] '[do [filter even? '[1 2 3 4 5 6]]]]
[test/add* '["vier"] '[do [filter string? '[1 2 3 "vier" 5 6]]]]
[test/add* '[1 2 3 5 6] '[do [filter int? '[1 2 3 "vier" 5 6]]]]
[test/add* '[2 3 4] '[do [map [λ [v]
[+ 1 v]] '[1 2 3]]]]
[test/add* '[2 4 6] '[do [map [λ [v]
[* 2 v]] '[1 2 3]]]]
[test/add* '["1" "2" "3"] '[do [map str/write '[1 2 3]]]]
[test/add* "[123 #nil]" '[do '[123 #nil]]]
[test/add* '[123 #nil] '[do '[123 #nil]]]
[test/add* "@[:asd 123]" '[do [tree/new :asd 123]]]
[test/add* "@[:asd 123]" '[do [tree/new :asd 123]]]
[test/add* #f '[do [tree/has? [tree/new :a 123] :b]]]
[test/add* #t '[do [tree/has? [tree/new :a 123] :a]]]
[test/add* 123 '[do [tree/get [tree/new :a 123] :a]]]
[test/add* 123 '[do [tree/get [tree/new :b 2 :a 123] :a]]]
[test/add* 9 '[do [tree/get [tree/set! [tree/new :b 2 :a 123] :a 9] :a]]]
[test/add* 2 '[do [tree/get [tree/new :b 2 :a 123] :b]]]
[test/add* #t '[do [let* [def keys [tree/keys [tree/new :b 2 :a 123]]] [or [list-equal? keys '[:b :a]] [list-equal? keys '[:a :b]]]]]]
[test/add* #t '[do [let* [def vals [tree/values [tree/new :b 2 :a 123]]] [or [list-equal? vals '[2 123]] [list-equal? vals '[123 2]]]]]]
[test/add* 2 '[do [length [tree/keys [tree/new :b 2 :a 123]]]]]
[test/add* 2 '[do [length [tree/values [tree/new :b 2 :a 123]]]]]
[test/add* 3 '[do [length [tree/keys [tree/new :b 2 :a 123 :c 7]]]]]
[test/add* '[:asd 123] '[do [car [read "{:asd 123}"]]]]
[test/add* '[123 [:asd]] '[do [car [read "[123[:asd]]"]]]]
[test/add* '[123 [:asd]] '[do [car [read "{123{:asd}}"]]]]
[test/add* '[123 [:asd]] '[do [car [read "(123(:asd))"]]]]
[test/add* '[123 [:asd]] '[do [car [read "(123{:asd})"]]]]
[test/add* '[:asd [123]] '[do [car [read "(:asd[123])"]]]]
[test/add* 291 '[do [car '[291 [156]]]]]
[test/add* '[156] '[do [cadr '[291 [156]]]]]
[test/add* 156 '[do [cadr '[291 156]]]]
[test/add* 5 '[do [car '[5 "asd"]]]]
[test/add* "\"asd\"" '[do [cadr '[5 "asd"]]]]
[test/add* #t '[do [pair? [symbol-table]]]]
[test/add* #t '[do [> [length [symbol-table]] 200]]]
[test/add* :one '[do [car '[:one :two :three]]]]
[test/add* :two '[do [cadr '[:one :two :three]]]]
[test/add* :three '[do [caddr '[:one :two :three]]]]
[test/add* '[:two :three] '[do [cdr '[:one :two :three]]]]
[test/add* '[:three] '[do [cddr '[:one :two :three]]]]
[test/add* 'two '[do [cadr '[:one two :three]]]]
[test/add* :value '[do [car [memory-info]]]]
[test/add* #t '[do [int? [cadr [memory-info]]]]]
[test/add* 102334155 '[do [let* [def i 1] [def a 0] [def b 1] [while [< i 40] [let [[new [+ a b]]] [set! a b] [set! b new] [set! i [+ 1 i] new]]] b]]]
[test/add* 832040 '[do [let* [def i 1] [def a 0] [def b 1] [while [< i 30] [let [[new [+ a b]]] [set! a b] [set! b new] [set! i [+ 1 i] new]]] b]]]
[test/add* 17711 '[do [let* [def i 1] [def a 0] [def b 1] [while [< i 22] [let [[new [+ a b]]] [set! a b] [set! b new] [set! i [+ 1 i] new]]] b]]]
[test/add* 6765 '[do [let* [def fib-slow [λ [v]
[if [< v 2]
v
[+ [fib-slow [- v 2]] [fib-slow [- v 1]]]]]] [fib-slow 20]]]]
[test/add* 10946 '[do [let* [def fib-slow [λ [v]
[if [< v 2]
v
[+ [fib-slow [- v 1]] [fib-slow [- v 2]]]]]] [fib-slow 21]]]]
[test/add* 4 '[do [[λ [v]
[+ v 2]] 2]]]
[test/add* 4 '[do [[λ [λ]
[+ λ 2]] 2]]]
[test/add* 4 '[do [[λ [+ *]
[- + *]] 6 2]]]
[test/add* 246 '[do [let* [def - 123] [+ - -]]]]
[test/add* 'v '[do [car '[v]]]]
[test/add* '+ '[do [car '[+]]]]
[test/add* #t '[do [eq? '+ [str->sym "+"]]]]
[test/add* 3 '[do [[eval* [str->sym "+"]] 1 2]]]
[test/add* '-- '[do [car '[--]]]]
[test/add* '- '[do [car '[-]]]]
[test/add* -1 '[do [let* [def + -] [+ 1 2]]]]
[test/add* #t '[do [procedure? [let* [def t -] t]]]]
[test/add* #nil '[do [when #f 1]]]
[test/add* 1 '[do [when #t 1]]]
[test/add* "[]" '[do '[]]]
[test/add* "[]" '[do '[]]]
[test/add* "[#nil #nil]" '[do '[#nil #nil]]]
[test/add* "[and #nil #nil]" '[do '[and #nil #nil]]]
[test/add* '[1 . 2] '[do [cons 1 2]]]
[test/add* '[1 . 2] '[do '[1 . 2]]]
[test/add* 1 '[do [car '[1 . 2]]]]
[test/add* 2 '[do [cdr '[1 . 2]]]]
[test/add* 1 '[do [[arr 1 2 3] 0]]]
[test/add* 2 '[do [[tree/new :asd 1 :bsd 2] :bsd]]]
[test/add* 0 '[do [+ #nil]]]
[test/add* 0 '[do [- #nil]]]
[test/add* 0 '[do [* #nil]]]
[test/add* 0 '[do [/ #nil]]]
[test/add* :unresolved-procedure '[do [try [λ [err]
[if [eq? [caddr err] 'asdqwe]
[car err]
#nil]] [asdqwe qweasdzxc]]]]
[test/add* #t '[do [try [λ [error]
[string? [cadr error]]] [/ 3 0]]]]
[test/add* :success '[do [try [λ [error]
error] [throw :success] :failure]]]
[test/add* 123 '[do [try [λ [error]
error] [throw 123] 0]]]
[test/add* #t '[do [try [λ [error]
error] [throw #t] #f]]]
[test/add* "\"asd\"" '[do [try [λ [error]
error] [throw "asd"] #nil]]]
[test/add* :test-exception '[do [try [λ [error]
[car error]] [throw [list :test-exception "Testing the exception system"]] #nil]]]
[test/add* #t '[do [try [λ [error]
[string? [cadr error]]] [throw [list :test-exception "Testing the exception system"]] #nil]]]
[test/add* :division-by-zero '[do [try [λ [err]
[car err]] [try [λ [err]
[/ 3 0]
err] [throw :test-exception]]]]]
[test/add* :test '[do [[λ [e]
[car e]] [cons :test "Test"]]]]
[test/add* 10 '[do 10]]
[test/add* 10.1 '[do 10.1]]
[test/add* -10.1 '[do -10.1]]
[test/add* -31 '[do -31]]
[test/add* -15 '[do -15]]
[test/add* -3 '[do -3]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#b1111-0000"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#x1-F"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#o12378"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#d1F"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#qwe"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "\"\\z\""]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "123kg"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "123.123m"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "123.123.123"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#xF.F"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#o7.7"]]]]
[test/add* :invalid-literal '[do [try [λ [err]
[car err]] [read "#b1.1"]]]]
[test/add* :division-by-zero '[do [try [λ [error]
[car error]] [/ 3 0]]]]
[test/add* :division-by-zero '[do [try [λ [error]
[car error]] [try [λ [error]
[/ 3 0]
error] [throw :test-exception]]]]]
[test/add* :float-inf '[do [try [λ [err]
[car err]] [/ 1.0 0.0]]]]
[test/add* :float-nan '[do [try [λ [err]
[car err]] [/ 0.0 0.0]]]]
[test/add* :float-inf '[do [try [λ [err]
[car err]] [/ -1.0 0.0]]]]
[test/add* "\"0\"" '[do [int->string 0]]]
[test/add* "\"123\"" '[do [int->string 123]]]
[test/add* "\"999\"" '[do [int->string/decimal 999]]]
[test/add* "\"0\"" '[do [int->string/binary 0]]]
[test/add* "\"1100\"" '[do [int->string/binary 12]]]
[test/add* "\"1010\"" '[do [int->string/binary 10]]]
[test/add* "\"1001\"" '[do [int->string/binary 9]]]
[test/add* "\"100000000\"" '[do [int->string/binary 256]]]
[test/add* "\"0\"" '[do [int->string/octal 0]]]
[test/add* "\"17\"" '[do [int->string/octal 15]]]
[test/add* "\"36\"" '[do [int->string/octal 30]]]
[test/add* "\"400\"" '[do [int->string/octal 256]]]
[test/add* "\"1000\"" '[do [int->string/hex 4096]]]
[test/add* "\"100\"" '[do [int->string/hex 256]]]
[test/add* "\"FF\"" '[do [int->string/hex 255]]]
[test/add* "\"1F\"" '[do [int->string/hex 31]]]
[test/add* "\"0\"" '[do [int->string/hex 0]]]
[test/add* "0.1" '[do 0.1]]
[test/add* "0.02" '[do 0.02]]
[test/add* "0.003" '[do 0.003]]
[test/add* "0.01234" '[do 0.01234]]
[test/add* "0.1" '[do [car [read "0.1"]]]]
[test/add* "0.1001" '[do [car [read "0.1001"]]]]
[test/add* "0.913" '[do [car [read "0.913"]]]]
[test/add* "0.00012" '[do [car [read "0.00012"]]]]
[test/add* 1 '[do [quasiquote 1]]]
[test/add* '[1] '[do [quasiquote [1]]]]
[test/add* '[1 2] '[do [quasiquote [1 2]]]]
[test/add* '[1 "asd"] '[do [quasiquote [1 "asd"]]]]
[test/add* '[1 :asd] '[do [quasiquote [1 :asd]]]]
[test/add* '[[tree/new :asd 123]] '[do [quasiquote [[tree/new :asd 123]]]]]
[test/add* '[[arr 1 2 3]] '[do [quasiquote [[arr 1 2 3]]]]]
[test/add* '[1.0001] '[do [quasiquote [1.0001]]]]
[test/add* '[:asd] '[do [quasiquote [:asd]]]]
[test/add* '[1 2 3] '[do [quasiquote [1 [unquote [1 + 1]] 3]]]]
[test/add* '[1 2 3 4] '[do [quasiquote [1 [unquote [1 + 1]] [unquote-splicing [read "3 4"]]]]]]
[test/add* '[1 2 3] '[do [let* [def v 2] [quasiquote [1 [unquote v] 3]]]]]
[test/add* '[resolve 123] '[do [do [let [[source [cons 123] #nil]] [quasiquote [resolve [unquote [car source]]]]]]]]
[test/add* '[resolve asd] '[do [do [let [[source [cons 'asd #nil]]] [quasiquote [resolve [unquote [car source]]]]]]]]
[test/add* #t '[do [macro? [μ [] #f]]]]
[test/add* #t '[do [macro? +1]]]
[test/add* #f '[do [macro? min]]]
[test/add* #f '[do [macro? 123]]]
[test/add* 4 '[do [let* [defun double [α] [* α 2]] [double 2]]]]
[test/add* #t '[do [in-range? 3 1 5]]]
[test/add* #f '[do [in-range? -3 1 5]]]
[test/add* #f '[do [in-range? 9 1 5]]]
[test/add* #t '[do [in-range? -3 -10 5]]]
[test/add* #t '[do [in-range? -3 -10.0 5]]]
[test/add* #t '[do [in-range? -3 -10.0 5.0]]]
[test/add* #t '[do [in-range? -3.0 -10.0 5.0]]]
[test/add* 6 '[do [let* [def sum 0] [for-each [λ [a]
[set! sum [+ sum a]]] '[1 2 3]] sum]]]
[test/add* "\"nuj\"" '[do [path/extension "test.nuj"]]]
[test/add* "\"nuj\"" '[do [path/extension "Another/test.nuj"]]]
[test/add* "\"NUJ\"" '[do [uppercase [path/extension "Another/test.nuj"]]]]
[test/add* "\"no\"" '[do [path/extension "asd/test.nuj.no"]]]
[test/add* "\"asd/test.nuj\"" '[do [path/without-extension "asd/test.nuj.no"]]]
[test/add* #t '[do [[path/ext?! "nuj"] "tests.nuj"]]]
[test/add* #f '[do [[path/ext?! "nuj"] "tests.nu"]]]
[test/add* #t '[do [resolves? '+]]]
[test/add* #t '[do [resolves? 'map]]]
[test/add* #t '[do [resolves? 'π]]]
[test/add* #f '[do [resolves? :asd]]]
[test/add* #f '[do [resolves? 'asdqwe]]]
[test/add* #t '[do [[length [symbol-search "abs"]] > 0]]]
[test/add* #t '[do [tree? [tree/new :asd 123]]]]
[test/add* #f '[do [tree? [arr 123]]]]
[test/add* #f '[do [tree? '[:asd 123]]]]
[test/add* #f '[do [tree? #nil]]]
[test/add* #f '[do [tree? 123]]]
[test/add* #f '[do [tree? "asd"]]]
[test/add* #f '[do [tree? #t]]]
[test/add* #t '[do [tree? [closure +]]]]
[test/add* 'source '[do [car [[closure compile] :arguments]]]]
[test/add* :invalid-literal '[do [try [λ [e]
[car e]] [read "#inf"]]]]
[test/add* 3 '[do [+ '1 '[2]]]]
[test/add* -1 '[do [- '1 '[2]]]]
[test/add* -1 '[do [- '1 '[2 3]]]]
[test/add* :type-error '[do [try [λ [e]
[car e]] [+ "1" "2"]]]]
[test/add* :type-error '[do [try [λ [e]
[car e]] [sin 1]]]]
[test/add* :type-error '[do [try [λ [e]
[car e]] [ceil 1]]]]
[test/add* :type-error '[do [try [λ [e]
[car e]] [floor 1]]]]
[test/add* :type-error '[do [try [λ [e]
[car e]] [round 1]]]]
[test/add* '[1 2 3] '[do [quasiquote [1 [unquote-splicing [quasiquote [2 3]]]]]]]
[test/add* '[+ 1 2] '[do [compile '[+1 2]]]]
[test/add* '[1 [2 [3 4]]] '[do [quasiquote [1 [quasiquote [2 [unquote [3 [unquote [+ 2 2]]]]]]]]]]
[test/add* 2 '[do [cadar '[[1 2 3] 4 5]]]]
[test/add* #nil '[do [when-not #t 123]]]
[test/add* 123 '[do [when-not #f 123]]]
[test/add* '[if #t
123
#nil] '[do [compile '[when #t 123]]]]
[test/add* '[if #t
#nil
123] '[do [compile '[when-not #t 123]]]]
[test/add* :invalid-let-form '[do [try [λ [err]
[car err]] [compile '[let [1] 1]]]]]
[test/add* :invalid-let-form '[do [try [λ [err]
[car err]] [compile '[let [[] 1] 1]]]]]
[test/add* #t '[do [symbol? 'asd]]]
[test/add* #t '[do [symbol? :asd]]]
[test/add* #t '[do [symbol? [gensym]]]]
[test/add* #t '[do [ineq? [gensym] [gensym]]]]
[test/add* #f '[do [symbol? 123]]]
[test/add* #f '[do [symbol? "asd"]]]
[test/add* #f '[do [symbol? [arr 123 'asd]]]]
[test/add* #f '[do [symbol? [tree/new :a 123]]]]
[test/add* 1 '[do [if #t
1
2]]]
[test/add* 2 '[do [if-not :test 1 2]]]
[test/add* 1 '[do [if-not #f 1 2]]]
[test/add* 7 '[do [if-let [a 3] [+ a 4] 1]]]
[test/add* 1 '[do [if-let [a #f] [+ a 4] 1]]]
[test/add* 7 '[do [when-let [a 3] [+ a 4]]]]
[test/add* #nil '[do [when-let [a #nil] [+ a 4]]]]
[test/add* #t '[do [last? '[]]]]
[test/add* #t '[do [last? '[1]]]]
[test/add* #f '[do [last? '[1 2]]]]
[test/add* #t '[do [object? [ω]]]]
[test/add* #t '[do [object? [current-closure]]]]
[test/add* #t '[do [native? +]]]
[test/add* #f '[do [native? min]]]
[test/add* #f '[do [lambda? +]]]
[test/add* #t '[do [lambda? min]]]
[test/add* #t '[do [special-form? if]]]
[test/add* #f '[do [special-form? when]]]
[test/add* #nil '[do [def #nil #nil]]]
[test/add* #nil '[do [def]]]
[test/add* #nil '[do [set! #nil #nil]]]
[test/add* #nil '[do [set!]]]
[test/add* "\" 1\"" '[do [string/pad-start "1" 4]]]
[test/add* "\"0001\"" '[do [string/pad-start "1" 4 "0"]]]
[test/add* "\"asd1\"" '[do [string/pad-start "1" 4 "asdasd"]]]
[test/add* "\"1 \"" '[do [string/pad-end "1" 4]]]
[test/add* "\"1000\"" '[do [string/pad-end "1" 4 "0"]]]
[test/add* "\"1asd\"" '[do [string/pad-end "1" 4 "asdasd"]]]
[test/add* 128 '[do oneTwoThreeTest]]
[test/add* "[quote . 123]" '[do [cons 'quote 123]]]
[test/add* "[quote . asd]" '[do [cons 'quote 'asd]]]
[test/add* "[quote . asd]" '[do [cons 'quote 'asd]]]
[test/add* 34 '[do [time/seconds 1637755714]]]
[test/add* 8 '[do [time/minutes 1637755714]]]
[test/add* 12 '[do [time/hours 1637755714]]]
[test/add* 59 '[do [time/seconds 1637755739]]]
[test/add* 0 '[do [time/seconds 1637755740]]]
[test/add* '[4 5 6] '[do [map [+x 3] '[1 2 3]]]]
[test/add* 4 '[do [def α 3]
[++ α]
α]]
[test/add* 2 '[do [cbrt 8]]]
[test/add* 3 '[do [cbrt 27]]]
[test/add* 2.0 '[do [cbrt 8.0]]]
[test/add* 3.0 '[do [cbrt 27.0]]]
[test/add* 2.0 '[do [vec/x [cbrt [vec 8]]]]]
[test/add* #t '[do [case "1" [[1] #f] [['1] #f] [["1"] #t]]]]
[test/add* #t '[do [case "asd" [["as"] #f] [["qwe"] #f] [["asd"] #t]]]]
[test/add* #t '[do [case [+ 1 2] [[3.1] #f] [[3.0] #t] [[3] #f]]]]
[test/add* #t '[do [case [+ 1 2] [[1] #f] [[2 3] #t]]]]
[test/add* #t '[do [case [+ 1 1] [[1] #f] [[2 3] #t]]]]
[test/add* #f '[do [case [+ 0 1] [[1] #f] [[2 3] #t]]]]
[test/add* #nil '[do [case [+ 2 2] [[1] #f] [[2 3] #t]]]]
[test/add* 123 '[do [case [+ 2 2] [[1] #f] [[2 3] #t] [otherwise 123]]]]
[test/add* #t '[do [def i 1]
[case [++ i] [[9] #f] [[4] #f] [[2] #t]]]]
[test/add* :too-many-args '[do [try [\ [err] [car err]] [cons 123 234 345]]]]
[test/add* #t '[do [eq? λ [resolve [car '[λ asd]]]]]]
[test/add* #t '[do [pos? [index-of [describe/closure [[defun stackTraceTest [] [current-lambda]]]] "stackTraceTest"]]]]
[test/add* 2 '[do [case 'asd [['qwe] 1] [['asd] 2] [otherwise 3]]]]
[def oneTwoThreeTest [+ 123 5]]
[def +123 [μ* +123 [v] "" [cons '+ [cons 123 [cons v #nil]]]]]
][do [def time/seconds [λ* time/seconds
[timestamp]
"Return the seconds part of TIMESTAMP, defaults to current time"
[% [default timestamp [time]] 60]]]
[def time/minutes [λ* time/minutes
[timestamp]
"Return the minutes part of TIMESTAMP, defaults to current time"
[% [/ [default timestamp [time]] 60] 60]]]
[def time/hours [λ* time/hours
[timestamp]
"Return the hours part of TIMESTAMP, defaults to current time"
[% [/ [default timestamp [time]] 3600] 24]]]
[def profile-form [λ* profile-form
[raw]
""
[do [def start-time [time/milliseconds]]
[def val [eval* [compile raw [current-closure]]]]
[def end-time [time/milliseconds]]
[display [cat "Evaluating " [ansi-yellow [str/write raw]] " to " [ansi-green [str/write val]] " took " [ansi-red [cat [- end-time start-time] "ms"] "\n"]]]]]]
[def profile [μ* profile [...body] "Measure and display how much time and ressources it takes for BODY to be evaluated" [cons 'profile-form [cons [cons 'quote [cons [if [last? ...body]
[car ...body]
[cons 'do ...body]] #nil]] #nil]]]]][do [def compile/environment [current-closure]]
[def compile/verbose #f]
[def compile/do/args [λ* compile/do/args
[args]
""
[if [last? args]
[cons [compile* [car args]] #nil]
[if [pair? [car args]]
[let* [do [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]]]]]]
[def compile/do [λ* compile/do
[source]
""
[let* [do [def args [compile/do/args source]]
[if [last? args]
[car args]
[cons 'do args]]]]]]
[def compile/def [λ* compile/def
[source]
""
[list 'def [cadr source] [compile* [caddr source]]]]]
[def compile/set! [λ* compile/set!
[source]
""
[list 'set! [cadr source] [compile* [caddr source]]]]]
[def compile/λ* [λ* compile/λ*
[source]
""
[list 'λ* [cadr source] [caddr source] [cadddr source] [compile [caddddr source]]]]]
[def compile/μ* [λ* compile/μ*
[source]
""
[list 'μ* [cadr source] [caddr source] [cadddr source] [compile [caddddr source]]]]]
[def compile/ω [λ* compile/ω
[source]
""
[list 'ω [compile/do [cdr source]]]]]
[def compile/try [λ* compile/try
[source]
""
[list 'try [compile* [cadr source]] [compile/do [cddr source]]]]]
[def compile/if [λ* compile/if
[source]
""
[list 'if [compile* [cadr source]] [compile* [caddr source]] [compile* [cadddr source]]]]]
[def compile/let* [λ* compile/let*
[source]
""
[list 'let* [compile/do [cdr source]]]]]
[def compile/and [λ* compile/and
[source]
""
[compile/procedure/arg source]]]
[def compile/or [λ* compile/or
[source]
""
[compile/procedure/arg source]]]
[def compile/while [λ* compile/while
[source]
""
[list 'while [compile* [cadr source]] [compile/do [cddr source]]]]]
[def compile/macro [λ* compile/macro
[macro source]
""
[compile* [macro-apply macro [cdr source]]]]]
[def compile/procedure/arg [λ* compile/procedure/arg
[source]
""
[if [pair? source]
[cons [compile* [car source]] [compile/procedure/arg [cdr source]]]
#nil]]]
[def compile/procedure [λ* compile/procedure
[proc source]
""
[compile/procedure/arg source]]]
[def compile* [λ* compile*
[source]
"Compile the forms in source"
[let* [do [def op [if [apply compile/environment [cons 'do [cons [cons 'resolves? [cons [list 'quote [car source]] #nil]] #nil]]]
[apply compile/environment [cons 'do [cons [cons 'resolve [cons [list 'quote [car source]] #nil]] #nil]]]
[car source]]]
[let* [do [def ΓεnΣym-4 [type-of op]]
[if [eq? ΓεnΣym-4 :special-form]
[let* [do [def ΓεnΣym-5 op]
[if [eq? ΓεnΣym-5 do]
[compile/do source]
[if [eq? ΓεnΣym-5 def]
[compile/def source]
[if [eq? ΓεnΣym-5 set!]
[compile/set! source]
[if [eq? ΓεnΣym-5 let*]
[compile/let* source]
[if [eq? ΓεnΣym-5 λ*]
[compile/λ* source]
[if [eq? ΓεnΣym-5 μ*]
[compile/μ* source]
[if [eq? ΓεnΣym-5 ω]
[compile/ω source]
[if [eq? ΓεnΣym-5 if]
[compile/if source]
[if [eq? ΓεnΣym-5 try]
[compile/try source]
[if [eq? ΓεnΣym-5 and]
[compile/and source]
[if [eq? ΓεnΣym-5 or]
[compile/or source]
[if [eq? ΓεnΣym-5 while]
[compile/while source]
[if [eq? ΓεnΣym-5 quote]
source
[throw [list :unknown-special-form "The compiler does not know the current special form, please fix the compiler!" [car source]]]]]]]]]]]]]]]]]]
[if [eq? ΓεnΣym-4 :macro]
[compile/macro op source]
[if [or [eq? ΓεnΣym-4 :lambda] [eq? ΓεnΣym-4 :native-function]]
[compile/procedure op source]
[if [eq? ΓεnΣym-4 :pair]
[compile/procedure/arg source]
[if [or [eq? ΓεnΣym-4 :int] [eq? ΓεnΣym-4 :float] [eq? ΓεnΣym-4 :vec]]
[compile/procedure/arg source]
[if [eq? ΓεnΣym-4 :array]
[compile/procedure/arg source]
[if [eq? ΓεnΣym-4 :string]
[compile/procedure/arg source]
[if [eq? ΓεnΣym-4 :tree]
[compile/procedure/arg source]
source]]]]]]]]]]]]]]
[def compile [λ* compile
[source new-environment new-verbose]
"Compile the forms in source"
[do [if new-environment
#nil
[set! new-environment [current-closure]]]
[if new-verbose
#nil
[set! new-verbose #f]]
[set! compile/environment new-environment]
[set! compile/verbose new-verbose]
[compile* source]]]]
[def compile/forms [λ* 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"
[do [if environment
#nil
[set! environment [ω #nil]]]
[def source #nil]
[def source-next source-raw]
[def passes 0]
[def max-passes 100]
[def try-again [λ* try-again
[source]
""
[set! source-next [cons source source-next]]]]
[while source-next [do [set! source source-next]
[set! source-next #nil]
[while source [do [try [λ* #nil
[err]
""
[let* [do [def ΓεnΣym-6 [car err]]
[if [eq? ΓεnΣym-6 :unresolved-procedure]
[try-again [car source]]
[if [eq? ΓεnΣym-6 :runtime-macro]
[try-again [car source]]
[throw err]]]]]] [do [def compiled-form [compile [car source] environment #t]]
[if compiled-form
[apply environment [cons [cons 'eval* [cons compiled-form #nil]] #nil]]
#nil]]]
[set! source [cdr source]]]]
[set! source-next [reverse source-next]]
[if [> [set! passes [+ 1 passes]] max-passes]
[throw [list :too-many-passes "The compiler couldn\'t produce a valid result in a 100 passes, probably something wrong with the code."]]
#nil]]]
[compile source-raw environment]]]]
[def defmacro [μ* defmacro [name args ...body] "Define a new macro" [do [def doc-string [if [string? [car ...body]]
[car ...body]
""]]
[list 'def name [compile [list 'μ* name args doc-string [cons 'do ...body]] [current-closure]]]]]]
[def defun [μ* defun [name args ...body] "Define a new function" [do [def doc-string [if [string? [car ...body]]
[car ...body]
""]]
[list 'def name [compile [list 'λ* name args doc-string [cons 'do ...body]] [current-closure]]]]]]
[def μ [μ* μ [args ...body] "Define a λ with the self-hosting Nujel compiler" [do [def doc-string [if [string? [car ...body]]
[car ...body]
""]]
[compile [list 'μ* #nil args doc-string [cons 'do ...body]] [current-closure]]]]]
[def \ [μ* \ [args ...body] "Define a λ with the self-hosting Nujel compiler" [do [def doc-string [if [string? [car ...body]]
[car ...body]
""]]
[compile [list 'λ* #nil args doc-string [cons 'do ...body]] [current-closure]]]]]
[def λ \]
[def eval [μ* eval [expr] "Compile, Evaluate and then return the result of EXPR" [cons 'eval* [cons [cons 'compile [cons expr [cons [cons 'current-closure #nil] #nil]]] #nil]]]]
[def +1 [μ* +1 [v] "" [cons '+ [cons 1 [cons v #nil]]]]]
[def optimize/code/rest [λ* optimize/code/rest
[code]
""
[if [pair? code]
[cons [optimize/code [car code]] [optimize/code/rest [cdr code]]]
code]]]
[def optimize/code [λ* optimize/code
[code]
""
[if [pair? code]
[if [and [symbol? [car code]] [resolves? [car code]]]
[cons [resolve [car code]] [optimize/code/rest [cdr code]]]
[cons [optimize/code [car code]] [optimize/code/rest [cdr code]]]]
code]]]
[def optimize! [λ* optimize!
[fun]
"Optimize FUN via mutation"
[if [lambda? fun]
[closure! fun [tree/new :code [optimize/code [[closure fun] :code]]]]
#f]]]
[def optimize-all! [λ* optimize-all!
[]
"Return a list of all lambdas in CTX"
[for-each optimize! [filter lambda? [map resolve [symbol-table]]]]]]
[def bench-while [λ* bench-while
[]
""
[do [def i 0]
[while [< i 10000000] [set! i [+ 1 i]]]
[println i]
i]]]
[optimize-all!]]
