Ben/Nujel - bootstrap/stdlib.no

Ben (X13/Void) Fixed [cat] stopping on first #nil 0b7ed2c 4 years ago 303 Commits
Raw
application/octet-stream • 83.53 KB • 1 line
[do [def ansi-reset "\e[0m"] [def ansi-fg-reset "\e[0;39m"] [def ansi-bg-reset "\e[49m"] [def ansi-fg [array/new "\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 [array/new "\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"] [let* [do [def i 0] [while [!= i width] [do [print " "] [set! i [add/int 1 i]]]]]] [print "\r"] [print text]]]] [def test-reprint-line [λ* test-reprint-line [] "" [do [print "\r\n"] [let* [do [def i 0] [while [!= i 100000] [do [reprint-line [string i]] [set! i [add/int 1 i]]]]]] [print " Done!\r\n"]]]]][do [def array/+= [λ* array/+= [a i v] "" [array/set! a i [+ v [array/ref a i]]]]] [def array/++ [λ* array/++ [a i] "" [array/+= a i 1]]] [def array/fill! [λ* array/fill! [a v i] "Fills array a with value v" [do [def len [array/length a]] [let* [do [def i 0] [while [!= i len] [do [array/set! a i v] [set! i [add/int 1 i]]]]]] a]]] [def array/reduce [λ* array/reduce [fun arr α] "" [do [def len [array/length arr]] [let* [do [def i 0] [while [!= i len] [do [set! α [fun α [arr i]]] [set! i [add/int 1 i]]]]]] α]]] [def array/map [λ* array/map [fun arr] "" [do [def len [array/length arr]] [let* [do [def i 0] [while [!= i len] [do [array/set! arr i [fun [arr i]]] [set! i [add/int 1 i]]]]]] arr]]] [def array/filter [λ* array/filter [pred arr] "" [do [def ri 0] [def len [array/length arr]] [def ret [array/allocate len]] [let* [do [def ai 0] [while [!= ai len] [do [if [pred [arr ai]] [do [array/set! ret ri [arr ai]] [set! ri [+ 1 ri]]] #nil] [set! ai [add/int 1 ai]]]]]] [array/length! ret ri]]]]][do [def array/2d/allocate [λ* array/2d/allocate [width height] "" [tree/new :data [array/fill! [array/allocate [* width height]] 0] :width width :height height]]] [def array/2d/ref [λ* array/2d/ref [data x y] "" [if [or [> x [data :width]] [> y [data :height]]] [throw [list :out-of-bounds "Trying to access an array out of bounds" data [current-lambda]]] [array/ref [data :data] [add/int x [mul/int y [data :width]]]]]]] [def array/2d/set! [λ* array/2d/set! [data x y val] "" [if [or [> x [data :width]] [> y [data :height]]] [throw [list :out-of-bounds "Trying to access an array out of bounds" data [current-lambda]]] [array/set! [data :data] [add/int x [mul/int y [data :width]]] val]]]] [def array/2d/print [λ* array/2d/print [data] "" [let* [do [def y 0] [while [!= y [data :height]] [do [let* [do [def x 0] [while [!= x [data :width]] [do [display [cat [array/2d/ref data x y] " "]] [set! x [add/int 1 x]]]]]] [newline] [set! y [add/int 1 y]]]]]]]]][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 lognand [λ* lognand [...l] "Returns the Nand of its arguments" [lognot [apply logand ...l]]]] [def bit-set?! [λ* bit-set?! [i] "" [do [def mask [ash 1 i]] [λ* #nil [α] "" [not [zero? [logand α mask]]]]]]] [def bit-clear?! [λ* bit-clear?! [i] "" [do [def mask [ash 1 i]] [λ* #nil [α] "" [zero? [logand α mask]]]]]]][do [def sum [λ* sum [c] "Return the sum of every value in collection C" [reduce + c 0]]] [def join [λ* join [l glue] "Join every element of α together into a string with GLUE inbetween" [do [if glue #nil [set! glue ""]] [if l [reduce [λ* #nil [a b] "" [if a [cat a glue b] b]] l #nil] ""]]]] [def for-each [λ* for-each [f l] "Runs F over every item in collection L and returns the resulting list" [reduce [λ* #nil [a b] "" [f b]] l #nil]]] [def count [λ* count [p l] "Count the number of items in L where P is true" [reduce [λ* #nil [a b] "" [+ a [if [p b] 1 0]]] l 0]]]][do [def ref [λ* ref [l i] "Return whatver is at position I in L" [let* [do [def ΓεnΣym-6 [type-of l]] [if [or [== ΓεnΣym-6 :nil]] #nil [if [or [== ΓεnΣym-6 :tree]] [tree/ref l i] [if [or [== ΓεnΣym-6 :string]] [char-at l i] [if [or [== ΓεnΣym-6 :array]] [array/ref l i] [if [or [== ΓεnΣym-6 :pair]] [list/ref l i] [throw [list :invalid-type "You can only use ref with a collection" l [current-lambda]]]]]]]]]]]] [def filter [λ* filter [p l] "Runs predicate p over every item in collection l and returns a list consiting solely of items where p is true" [let* [do [def ΓεnΣym-7 [type-of l]] [if [or [== ΓεnΣym-7 :nil]] #nil [if [or [== ΓεnΣym-7 :pair]] [list/filter p l] [if [or [== ΓεnΣym-7 :array]] [array/filter p l] [throw [list :invalid-type "You can only use filter with a collection" l [current-lambda]]]]]]]]]] [def reduce [λ* reduce [f l α] "Combine all elements in collection l using operation F and starting value α" [let* [do [def ΓεnΣym-8 [type-of l]] [if [or [== ΓεnΣym-8 :nil]] α [if [or [== ΓεnΣym-8 :pair]] [list/reduce f l α] [if [or [== ΓεnΣym-8 :array]] [array/reduce f l α] [throw [list :invalid-type "You can only use reduce with a collection" l [current-lambda]]]]]]]]]] [def length [λ* length [α] "Returns the length of collection α" [let* [do [def ΓεnΣym-9 [type-of α]] [if [or [== ΓεnΣym-9 :nil]] 0 [if [or [== ΓεnΣym-9 :array]] [array/length α] [if [or [== ΓεnΣym-9 :pair]] [list/length α] [if [or [== ΓεnΣym-9 :string]] [string/length α] [if [or [== ΓεnΣym-9 :tree]] [tree/size α] [throw [list :invalid-type "You can only use length with a collection" α [current-lambda]]]]]]]]]]]] [def map [λ* map [f l] "Runs f over every item in collection l and returns the resulting list" [let* [do [def ΓεnΣym-10 [type-of l]] [if [or [== ΓεnΣym-10 :nil]] #nil [if [or [== ΓεnΣym-10 :pair]] [list/map f l] [if [or [== ΓεnΣym-10 :array]] [array/map f l] [throw [list :invalid-type "You can only use map with a collection" l [current-lambda]]]]]]]]]]][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-14 [type-of op]] [if [== ΓεnΣym-14 :special-form] [let* [do [def ΓεnΣym-15 op] [if [== ΓεnΣym-15 do] [compile/do source] [if [== ΓεnΣym-15 def] [compile/def source] [if [== ΓεnΣym-15 set!] [compile/set! source] [if [== ΓεnΣym-15 let*] [compile/let* source] [if [== ΓεnΣym-15 λ*] [compile/λ* source] [if [== ΓεnΣym-15 μ*] [compile/μ* source] [if [== ΓεnΣym-15 ω] [compile/ω source] [if [== ΓεnΣym-15 if] [compile/if source] [if [== ΓεnΣym-15 try] [compile/try source] [if [== ΓεnΣym-15 and] [compile/and source] [if [== ΓεnΣym-15 or] [compile/or source] [if [== ΓεnΣym-15 while] [compile/while source] [if [== ΓεnΣym-15 quote] source [throw [list :unknown-special-form "The compiler does not know the current special form, please fix the compiler!" [car source]]]]]]]]]]]]]]]]]] [if [== ΓεnΣym-14 :macro] [compile/macro op source] [if [or [== ΓεnΣym-14 :lambda] [== ΓεnΣym-14 :native-function]] [compile/procedure op source] [if [== ΓεnΣym-14 :pair] [compile/procedure/arg source] [if [or [== ΓεnΣym-14 :int] [== ΓεnΣym-14 :float] [== ΓεnΣym-14 :vec]] [compile/procedure/arg source] [if [== ΓεnΣym-14 :array] [compile/procedure/arg source] [if [== ΓεnΣym-14 :string] [compile/procedure/arg source] [if [== ΓεnΣym-14 :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] [def errors #nil] [while source [do [try [λ* #nil [err] "" [do [set! errors [cons err errors]] [let* [do [def ΓεnΣym-16 [car err]] [if [== ΓεnΣym-16 :unresolved-procedure] [try-again [car source]] [if [== ΓεnΣym-16 :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] [do [for-each display/error errors] [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 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]]]]]]][do [def comment [μ* comment [...body] "Does nothing" #nil]] [def += [μ* += [val inc] "" [cons 'set! [cons val [cons [cons '+ [cons val [cons inc #nil]]] #nil]]]]] [def cdr! [μ* cdr! [l] "[set! l [cdr l]]" [cons 'set! [cons l [cons [cons 'cdr [cons l #nil]] #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]]]]]]]][do [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 case/clauses/multiple [λ* case/clauses/multiple [key-sym cases] "" [if cases [cons [list '== key-sym [car cases]] [case/clauses/multiple key-sym [cdr cases]]] #nil]]] [def case/clauses [λ* case/clauses [key-sym clauses] "" [if clauses [if [== [caar clauses] 'otherwise] [cons 'do [cdar clauses]] [list 'if [if [pair? [caar clauses]] [cons 'or [case/clauses/multiple key-sym [caar clauses]]] [list '== 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 for [μ* for [for-loop ...body] "For loops, [for [name start stop] ...body]" [do [def symbol-name [car for-loop]] [def loop-start [cadr for-loop]] [def loop-stop [caddr for-loop]] [def dir 1] [if [cadddr for-loop] [set! dir [cadddr for-loop]] #nil] [if [symbol? symbol-name] #nil [throw [list :invalid-for "Expected a symbol name within the for loop" symbol-name]]] [if loop-start #nil [throw [list :invalid-for "Expected a start value at the second position" for-loop]]] [if loop-stop #nil [throw [list :invalid-for "Expected a stop value at the third position" for-loop]]] [cons 'let [cons [cons [cons symbol-name [cons loop-start #nil]] #nil] [cons [cons 'while [cons [cons '!= [cons symbol-name [cons loop-stop #nil]]] [append ...body [cons [cons 'set! [cons symbol-name [cons [cons 'add/int [cons dir [cons symbol-name #nil]]] #nil]]] #nil]]]] #nil]]]]]] [def thread/-> [λ* thread/-> [init fun] "" [if fun [cons [caar fun] [cons [thread/-> init [cdr fun]] [append [cdar fun] #nil]]] init]]] [def -> [μ* -> [init ...fun] "Thread init as the first argument through every function in ...fun" [thread/-> init [reverse ...fun]]]] [def thread/->> [λ* thread/->> [init fun] "" [if fun [append [car fun] [cons [thread/->> init [cdr fun]] #nil]] init]]] [def ->> [μ* ->> [init ...fun] "Thread init as the last argument through every function in ...fun" [thread/->> init [reverse ...fun]]]]][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 [l] "Return the last pair of l" [do [while [cdr l] [set! l [cdr l]]] l]]] [def make-list [λ* make-list [number value] "Return a list of NUMBER elements containing VALUE in every car" [do [def l #nil] [while [>= [set! number [+ -1 number]] 0] [set! l [cons value l]]] l]]] [def list/reduce [λ* list/reduce [o l s] "Combine all elements in l using operation o and starting value s" [do [while l [do [set! s [o s [car l]]] [set! l [cdr l]]]] s]]] [def list/ref [λ* list/ref [l i] "Returns the the element of list l at location i" [do [while [and l [> i 0]] [do [set! i [+ -1 i]] [set! l [cdr l]]]] [car l]]]] [def reverse [λ* reverse [l] "Return the list l in reverse order" [do [def ret #nil] [while l [do [set! ret [cons [car l] ret]] [set! l [cdr l]]]] ret]]] [def list/length [λ* list/length [l] "Returns the length of list l" [do [def ret 0] [while l [do [set! l [cdr l]] [set! ret [+ 1 ret]]]] ret]]] [def list/filter [λ* list/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] [while l [do [if [p [car l]] [set! ret [cons [car l] ret]] #nil] [set! l [cdr l]]]] [nreverse ret]]]] [def list/map [λ* list/map [f l] "Runs f over every item in list l and returns the resulting list" [do [def ret #nil] [while l [do [set! ret [cons [f [car l]] ret]] [set! l [cdr l]]]] [nreverse ret]]]] [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 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 [== [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 [== 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 [== key [car l]] [cadr l] [if #t [getf [cdr l] key] #nil]]]]] [def list/sort [λ* list/sort [l] "Terribly slow way to sort a list, though it was simple to write" [if l [do [def top [car l]] [def next #nil] [set! l [cdr l]] [while l [do [if [> [car l] top] [do [set! next [cons top next]] [set! top [car l]]] [set! next [cons [car l] next]]] [set! l [cdr l]]]] [cons top [list/sort next]]] #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]]]]]] [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 +1 [μ* +1 [v] "" [cons '+ [cons 1 [cons v #nil]]]]]][do [def display/error/wrap [λ* display/error/wrap [i text] "" [if [== i 0] [ansi-red text] [if [== i 1] [string text] [if [== i 2] [ansi-yellow [str/write text]] [if [== i 3] [describe/closure text] [if #t text #nil]]]]]]] [def display/error/iter [λ* display/error/iter [error i] "" [if error [cons [display/error/wrap i [car error]] [display/error/iter [cdr error] [+ 1 i]]] [cons "" #nil]]]] [def display/error [λ* display/error [error] "Display ERROR in a nice, human readable way" [display [join [display/error/iter error 0] "\r\n"]]]] [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 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-pink "Symbols:  "] [getf info :symbol] "\n" ansi-reset]]]] [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]]]] [def gensym/counter 0] [def gensym [λ* gensym [] "" [do [set! gensym/counter [+ 1 gensym/counter]] [str->sym ["ΓεnΣym-" gensym/counter]]]]] [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" [and [numeric? a] [>= a 0]]]] [def zero-neg? [λ* zero-neg? [a] "Return #t if a is zero or negative" [and [numeric? a] [<= a 0]]]] [def neg? [λ* neg? [a] "Returns #t if a is negative" [and [numeric? a] [< 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" [== [mod/int [int a] 2] 0]]] [def zero? [λ* zero? [val] "#t if VAL is zero" [== 0 val]]] [def not-zero? [λ* not-zero? [val] "#t if VAL is not zero" [!= 0 val]]] [def list-equal? [λ* list-equal? [a b] "#t if A and B are equal" [if [== [type-of a] [type-of b]] [if [pair? a] [and [list-equal? [car a] [car b]] [list-equal? [cdr a] [cdr b]]] [== 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" [== :int [type-of val]]]] [def float? [λ* float? [val] "#t if VAL is a floating-point number" [== :float [type-of val]]]] [def vec? [λ* vec? [val] "#t if VAL is a vector" [== :vec [type-of val]]]] [def bool? [λ* bool? [val] "#t if VAL is a boolean" [== :bool [type-of val]]]] [def pair? [λ* pair? [val] "#t if VAL is a pair" [== :pair [type-of val]]]] [def arr? [λ* arr? [val] "#t if VAL is an array" [== :array [type-of val]]]] [def string? [λ* string? [val] "#t if VAL is a string" [== :string [type-of val]]]] [def symbol? [λ* symbol? [val] "#t if VAL is a symbol" [== :symbol [type-of val]]]] [def object? [λ* object? [val] "#t if VAL is an object" [== :object [type-of val]]]] [def tree? [λ* tree? [val] "#t if VAL is an object" [== :tree [type-of val]]]] [def macro? [λ* macro? [val] "#t if VAL is an object" [== :macro [type-of val]]]] [def lambda? [λ* lambda? [val] "#t if VAL is a lambda" [or [== :lambda [type-of val]] [== :dynamic [type-of val]]]]] [def native? [λ* native? [val] "#t if VAL is a native function" [== :native-function [type-of val]]]] [def special-form? [λ* special-form? [val] "#t if VAL is a native function" [== :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 [== [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 [== [car l] 'unquote] [if [zero? depth] [cadr l] [list 'unquote [quasiquote-real [cadr l] [+ -1 depth]]]] [if [== [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 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] "" [== 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 [array/new "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]]]] [def split/empty [λ* split/empty [str separator] "" [do [def slen [string/length str]] [def start 0] [def ret #nil] [while [< start slen] [do [set! ret [cons [substr str start [+ 1 start]] ret]] [set! start [+ 1 start]]]] [reverse ret]]]] [def split/string [λ* split/string [str separator start] "" [do [if start #nil [set! start 0]] [def pos-found [index-of str separator start]] [if [>= pos-found 0] [cons [substr str start pos-found] [split/string str separator [+ pos-found [string/length separator]]]] [cons [substr str start [string/length str]] #nil]]]]] [def split [λ* split [str separator] "" [let* [do [def ΓεnΣym-18 [string/length separator]] [if [or [== ΓεnΣym-18 0]] [split/empty str] [split/string str separator 0]]]]]] [def read/single [λ* read/single [text] "" [car [read text]]]] [def string/length?! [λ* string/length?! [chars] "" [λ* #nil [a] "" [== chars [string/length a]]]]] [def contains-any? [λ* contains-any? [str chars] "" [apply or [map [λ* #nil [a] "" [>= [index-of str a] 0]] [split chars ""]]]]] [def contains-all? [λ* contains-all? [str chars] "" [apply and [map [λ* #nil [a] "" [>= [index-of str a] 0]] [split chars ""]]]]]][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? ==] [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? ==] [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 [test/add* 1073741824 '[do [ash 1 30]]] [test/add* -2147483649 '[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 [> 5 1]]] [test/add* #t '[do [not [< 5 1]]]] [test/add* #t '[do [>= 5 5]]] [test/add* #t '[do [<= 5 5]]] [test/add* #t '[do [== #t #t]]] [test/add* #t '[do [not [== #f #t]]]] [test/add* #t '[do [== 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 [neg? -1]]] [test/add* #t '[do [neg? -0.01]]] [test/add* #t '[do [pos? 0]]] [test/add* #t '[do [pos? 0.01]]] [test/add* #t '[do [not [neg? 0]]]] [test/add* #t '[do [not [pos? -0.01]]]] [test/add* #f '[do [pos? "asd"]]] [test/add* #f '[do [neg? "asd"]]] [test/add* #f '[do [pos? #t]]] [test/add* #f '[do [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? [array/new 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 [== "asd" "asd"] [not [== "asd" "bsd"]] [not [== "asd" "asdasd"]]]]] [test/add* #nil '[do [list/ref '[1 2] 3]]] [test/add* 1 '[do [list/ref '[1 2] 0]]] [test/add* 2 '[do [list/ref '[1 2 3 4] 1]]] [test/add* #nil '[do [ref '[1 2] 3]]] [test/add* 1 '[do [ref '[1 2] 0]]] [test/add* 2 '[do [ref '[1 2 3 4] 1]]] [test/add* 20 '[do [reduce + [make-list 10 2] 0]]] [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 [array/length [array/new 1 2 3 4]]]] [test/add* 2 '[do [array/ref [array/new 1 2 3 4] 1]]] [test/add* 3 '[do [array/length [array/allocate 3]]]] [test/add* #t '[do [arr? [array/new 1 2 3]]]] [test/add* #t '[do [arr? [array/allocate 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 [** 2 8]]]] [test/add* 256 '[do [int [pow 2 8]]]] [test/add* 256 '[do [int [pow/int 2 8]]]] [test/add* 1 '[do [int [pow 1 8]]]] [test/add* 1 '[do [int [pow 1.0 8]]]] [test/add* 0.5 '[do [pow 2.0 -1.0]]] [test/add* 0.25 '[do [pow 2.0 -2.0]]] [test/add* 0.125 '[do [pow 2.0 -3.0]]] [test/add* 3 '[do [def ein-test-arr [array/new 1 2 3]] [ein-test-arr 2]]] [test/add* 3 '[do [def ein-test-arr [array/new 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] [== 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 [array/new 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* 4294967295 '[do 4294967295]] [test/add* 4294967295 '[do 4294967295]] [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 [str/write [abs [vec -1 -2 -3]]]]] [test/add* "3.33333" '[do [str/write [+ 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 [str/write [+ [+ 1.1 2.2] [+ 1.1 3] [+ 1 3.2]]]]] [test/add* "20.1" '[do [str/write [+ [+ 1.1 3] [+ 1 3.3] [+ 3.3 4.1 4.3]]]]] [test/add* "15.54" '[do [str/write [add [add [mul 3.2 3.2] [sub [sub [sub 5.5 1.1] 1] 1.1]] [div 9.9 3.3]]]]] [test/add* "0.7" '[do [str/write [% 10 3.1]]]] [test/add* "11.7" '[do [str/write [add [add [+ 1.1 2.2] [+ 1.1 3]] [+ 1 3.3]]]]] [test/add* "11.75" '[do [str/write [+ [float 10] [int "10"] [float "-8.25"]]]]] [test/add* "30.3" '[do [str/write [+ [abs [int "-10"]] [int 8.2] 12.3]]]] [test/add* "[vec 12.0 12.0 12.0]" '[do [str/write [+ [vec 1] 1 10]]]] [test/add* "[vec 3.0 5.0 6.0]" '[do [str/write [+ [vec 1] [vec 1 2] [vec 1 2 3]]]]] [test/add* "[vec 3.0 3.0 3.0]" '[do [str/write [+ 1 [vec 1] 1.0]]]] [test/add* "[vec 3.0 3.0 3.0]" '[do [str/write [+ 1.0 [vec 1] "1"]]]] [test/add* "[vec -1.0 -1.0 -1.0]" '[do [str/write [- [vec 1] [vec 1.0] [vec "1"]]]]] [test/add* "2.7" '[do [str/write [+ [- 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 [str/write [+ 1 [vec 1] 1.0]]]] [test/add* "[vec -1.0 -1.0 -1.0]" '[do [str/write [- 1 [vec 1] 1.0]]]] [test/add* "[vec 8.0 8.0 8.0]" '[do [str/write [* [vec 2] "4"]]]] [test/add* "[vec 1.0 1.0 1.0]" '[do [str/write [mod [vec 9] 2]]]] [test/add* "1.0" '[do [str/write [float [int [+ [vec 1] [vec 0 9 9]]]]]]] [test/add* '[] '[do [cons]]] [test/add* "[]" '[do [str/write [cons]]]] [test/add* '[1] '[do [cons 1]]] [test/add* "[1]" '[do [str/write [cons 1]]]] [test/add* 1 '[do [car [cons 1 2]]]] [test/add* 2 '[do [cdr [cons 1 2]]]] [test/add* "[1 . 2]" '[do [str/write [cons 1 2]]]] [test/add* "[1 2]" '[do [str/write [cons 1 '[2]]]]] [test/add* "[123]" '[do [str/write '[123]]]] [test/add* "[1 2 3]" '[do [str/write '[1 2 3]]]] [test/add* "[1 2 . 3]" '[do [str/write '[1 2 . 3]]]] [test/add* '[1 2 3] '[do [read/single "[1 2 3]"]]] [test/add* '[1 2 . 3] '[do [read/single "[1 2 . 3]"]]] [test/add* "[1 2 . 3]" '[do [str/write [cons 1 [cons 2 3]]]]] [test/add* '[4 3 2 1] '[do [reverse '[1 2 3 4]]]] [test/add* "[1 2.0 3 1 2.0 3]" '[do [str/write [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 [str/write [filter float? '[1 2.0 #t 4]]]]] [test/add* "[2.0]" '[do [str/write [filter float? '[1 2.0 #t 4]]]]] [test/add* '[#t] '[do [filter bool? '[1 2.0 #t 4]]]] [test/add* '[1 3 5] '[do [filter odd? '[1 2 3 4 5 6]]]] [test/add* 3 '[do [count odd? '[1 2 3 4 5 6]]]] [test/add* 3 '[do [count even? '[1 2 3 4 5 6]]]] [test/add* 6 '[do [count int? '[1 2 3 4 5 6]]]] [test/add* 0 '[do [count float? '[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] '[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 [str/write [let [[l '[1.0 #t "a"]]] [append [except-last-pair l] [last-pair l]]]]]] [test/add* "[\"asd\" #t #f]" '[do [str/write [member "asd" '[123 456 "asd" #t #f]]]]] [test/add* "[[vec 4.0 4.0 4.0] 9 16.0]" '[do [str/write [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 [str/write [div [vec 99] [float [cat 1 1.0]]]]]] [test/add* "#[99 2 3 4]" '[do [str/write [let [[cur-arr [array/new 1 2 3 4]]] [array/set! cur-arr 0 99] cur-arr]]]] [test/add* "#[42 42 42 42 42 42]" '[do [str/write [array/fill! [array/allocate 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]]]] [str/write [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 [str/write [floor [vec 1.3 1.3 1.3]]]]] [test/add* "2.0" '[do [str/write [ceil 1.3]]]] [test/add* "[vec 2.0 2.0 2.0]" '[do [str/write [ceil [vec 1.3 1.3 1.3]]]]] [test/add* "1.0" '[do [str/write [round 1.3]]]] [test/add* "2.0" '[do [str/write [round 1.51]]]] [test/add* "3.0" '[do [str/write [sqrt 9]]]] [test/add* "[vec 5.0 5.0 5.0]" '[do [str/write [sqrt [vec 25 25 25]]]]] [test/add* "256.0" '[do [str/write [pow 2.0 8]]]] [test/add* "[vec 4.0 8.0 16.0]" '[do [str/write [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 [str/write :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]] [str/write 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 [array/new 1 2 3]] [testerle 4]]] [test/add* #nil '[do [def testerle [array/new 1 2 3]] [testerle 40000]]] [test/add* "#[1 2 3]" '[do [def testerle [array/new 1 2 3]] [str/write [testerle]]]] [test/add* #nil '[do [def testerle [array/new 1 2 3]] [testerle #t]]] [test/add* #nil '[do [def testerle [array/new 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 [str/write [map float [split "1,2,3" ","]]]]] [test/add* "[\"dies ist\" \"ein\" \"test\"]" '[do [str/write [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 [== 32 32]]] [test/add* #t '[do [== 8 8]]] [test/add* #t '[do [== 9 [char-at "\t" 0]]]] [test/add* #t '[do [and [== 13 13] [== 13 13]]]] [test/add* #t '[do [and [== 10 10] [== 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 [== + +]]] [test/add* #t '[do [== 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 [== :asd :asd]]] [test/add* #t '[do [== :bool [type-of #f]]]] [test/add* #t '[do [== :int [type-of 123]]]] [test/add* #f '[do [== :int [type-of 123.123]]]] [test/add* #t '[do [== :float [type-of 123.123]]]] [test/add* #t '[do [== :vec [type-of [vec 1]]]]] [test/add* #t '[do [== :native-function [type-of +]]]] [test/add* #t '[do [== :lambda [type-of test/add*]]]] [test/add* #t '[do [== :string [type-of "asd"]]]] [test/add* 2 '[do [getf [list :a 1 :b 2 :c 3] :b]]] [test/add* "#nil" '[do [str/write [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 [== [+ 2 2] [2 + 2]]]] [test/add* #t '[do [== 4 [2 + 2]]]] [test/add* #t '[do [== 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* 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 [str/write 'do]]] [test/add* "[123]" '[do [str/write '[123]]]] [test/add* "[123 #t]" '[do [str/write '[123 #t]]]] [test/add* "[123 \'do]" '[do [str/write '[123 'do]]]] [test/add* "[123 \"asd\"]" '[do [str/write '[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* #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 [== #nil #nil]]] [test/add* #t '[do [== #t #t]]] [test/add* #f '[do [== #t #f]]] [test/add* #t '[do [== #f #f]]] [test/add* #f '[do [== '[] #f]]] [test/add* #f '[do [== #f '[]]]] [test/add* #f '[do [== '[] #t]]] [test/add* #f '[do [== #t '[]]]] [test/add* #t '[do [== '[] '[]]]] [test/add* #f '[do [== '[] '[1]]]] [test/add* #f '[do [== '[1] '[1]]]] [test/add* #t '[do [list-equal? '[1] '[1]]]] [test/add* #f '[do [== '[] #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* '[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 [str/write '[123 #nil]]]] [test/add* '[123 #nil] '[do '[123 #nil]]] [test/add* "@[:asd 123]" '[do [str/write [tree/new :asd 123]]]] [test/add* "@[:asd 123]" '[do [str/write [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 [== '+ [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 [str/write '[]]]] [test/add* "[]" '[do [str/write '[]]]] [test/add* "[#nil #nil]" '[do [str/write '[#nil #nil]]]] [test/add* "[and #nil #nil]" '[do [str/write '[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 [[array/new 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 [== [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 [str/write 0.1]]] [test/add* "0.02" '[do [str/write 0.02]]] [test/add* "0.003" '[do [str/write 0.003]]] [test/add* "0.01234" '[do [str/write 0.01234]]] [test/add* "0.1" '[do [str/write [car [read "0.1"]]]]] [test/add* "0.1001" '[do [str/write [car [read "0.1001"]]]]] [test/add* "0.913" '[do [str/write [car [read "0.913"]]]]] [test/add* "0.00012" '[do [str/write [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* '[[array/new 1 2 3]] '[do [quasiquote [[array/new 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? [array/new 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 [!= [gensym] [gensym]]]] [test/add* #f '[do [symbol? 123]]] [test/add* #f '[do [symbol? "asd"]]] [test/add* #f '[do [symbol? [array/new 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 [str/write [cons 'quote 123]]]] [test/add* "[quote . asd]" '[do [str/write [cons 'quote 'asd]]]] [test/add* "[quote . asd]" '[do [str/write [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 [== λ [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]]]] [test/add* 10 '[do [reduce + [array/new 1 2 3 4] 0]]] [test/add* "1,2,3,4" '[do [join [array/new 1 2 3 4] ","]]] [test/add* 2 '[do [count even? [array/new 1 2 3 4]]]] [test/add* 14 '[do [reduce + [map [+x 1] [array/new 1 2 3 4]] 0]]] [test/add* 3 '[do [length [array/new 1 2 3]]]] [test/add* 2 '[do [def arr [array/new 1 2 3]] [array/length! arr 2] [length arr]]] [test/add* 3 '[do [def arr [array/new 1 2 3]] [array/length! arr 2] [reduce + arr 0]]] [test/add* "#[2 4]" '[do [str/write [filter even? [array/new 1 2 3 4]]]]] [test/add* 5 '[do [count [bit-set?! 0] '[4 30 22 23 21 15 7 28 16 25 2 10]]]] [test/add* 7 '[do [count [bit-set?! 1] [array/new 4 30 22 23 21 15 7 28 16 25 2 10]]]] [test/add* 7 '[do [count [bit-clear?! 0] '[4 30 22 23 21 15 7 28 16 25 2 10]]]] [test/add* 5 '[do [count [bit-clear?! 1] [array/new 4 30 22 23 21 15 7 28 16 25 2 10]]]] [test/add* '["123"] '[do [split "123" "\n"]]] [test/add* '["" ""] '[do [split "\n" "\n"]]] [test/add* '["123" "456"] '[do [split "123\n456" "\n"]]] [test/add* '["" "" ""] '[do [split "\n\n" "\n"]]] [test/add* '["1" "2" "3"] '[do [split "1\n2\n3" "\n"]]] [test/add* '["" "" "" ""] '[do [split "\n\n\n" "\n"]]] [test/add* '["1" "2" "3" "4"] '[do [split "1\n2\n3\n4" "\n"]]] [test/add* "" '[do [substr "\n" 1 1]]] [test/add* "@[:a 1 :b 2]" '[do [str/write [tree/zip '[:a :b] '[1 2]]]]] [test/add* "@[:a #nil :b #nil]" '[do [str/write [tree/zip '[:a :b] '[]]]]] [test/add* "@[:a 1 :b #nil]" '[do [str/write [tree/zip '[:a :b] '[1]]]]] [test/add* "@[]" '[do [str/write [tree/zip '[] '[1 2]]]]] [test/add* "123" '[do [str/write [read/single "123;asd"]]]] [test/add* '[123] '[do [read "123"]]] [test/add* '[123] '[do [read "123;asd"]]] [test/add* '[123 234] '[do [read "123;asd\n234"]]] [test/add* '[234] '[do [read ";asd\n;qwe\n234;asd"]]] [test/add* '[2 1 0] '[do [let [[ret #nil]] [for [i 0 3] [set! ret [cons i ret]]] ret]]] [test/add* '[1 2 3] '[do [let [[ret #nil]] [for [i 3 0 -1] [set! ret [cons i ret]]] ret]]] [test/add* '[20 10 0] '[do [let [[ret #nil]] [for [i 0 30 10] [set! ret [cons i ret]]] ret]]] [test/add* "#[0 0 0]" '[do [str/write [-> [array/allocate 3] [array/fill! 0]]]]] [test/add* "#[3 9 0]" '[do [str/write [-> [array/allocate 3] [array/fill! 0] [array/set! 1 9] [array/set! 0 3]]]]] [test/add* "@[:a 1 :b 2]" '[do [str/write [-> [tree/new] [tree/set! :a 1] [tree/set! :b 2]]]]] [test/add* '[3 2 1] '[do [->> '[1] [cons 2] [cons 3]]]] [test/add* '[1] '[do [->> '[1]]]] [test/add* 10 '[do [def arr [array/new 1 2 3]] [array/length! arr 4] [array/set! arr 3 4] [reduce + arr 0]]] [test/add* 10 '[do [reduce + [-> [array/new 1 2 3] [array/length! 4] [array/set! 3 4]] 0]]] [test/add* 10 '[do [sum [array/new 1 2 3 4]]]] [test/add* 10 '[do [sum '[1 2 3 4]]]] [test/add* 0 '[do [popcount 0]]] [test/add* 0 '[do [popcount #nil]]] [test/add* 0 '[do [popcount ""]]] [test/add* 1 '[do [popcount 1]]] [test/add* 1 '[do [popcount 2]]] [test/add* 2 '[do [popcount 3]]] [test/add* 4 '[do [popcount 15]]] [test/add* '[3 2 1] '[do [list/sort '[1 2 3]]]] [test/add* '[9 3 1] '[do [list/sort '[1 3 9]]]] [test/add* '[9 1] '[do [list/sort '[1 9]]]] [test/add* '[9 2 1 1] '[do [list/sort '[1 1 2 9]]]] [test/add* '[3.0 2.0 1.0] '[do [list/sort '[3.0 1.0 2.0]]]] [test/add* '["z" "m" "a"] '[do [list/sort '["m" "a" "z"]]]] [test/add* '["z" "m" "a"] '[do [list/sort '["z" "m" "a"]]]] [test/add* '["z" "m" "a"] '[do [list/sort '["a" "z" "m"]]]] [test/add* '["m" "a" "Z"] '[do [list/sort '["a" "Z" "m"]]]] [test/add* '["zauberer" "mit" "aggressionen"] '[do [list/sort '["aggressionen" "zauberer" "mit"]]]] [test/add* 40 '[do [char-at "([{<>}])" 0]]] [test/add* 91 '[do [char-at "([{<>}])" 1]]] [test/add* 123 '[do [char-at "([{<>}])" 2]]] [test/add* 60 '[do [char-at "([{<>}])" 3]]] [test/add* 62 '[do [char-at "([{<>}])" 4]]] [test/add* 125 '[do [char-at "([{<>}])" 5]]] [test/add* 93 '[do [char-at "([{<>}])" 6]]] [test/add* 41 '[do [char-at "([{<>}])" 7]]] [test/add* #t '[do [< 1442693 12049880844]]] [test/add* 12051323537 '[do [+ 1442693 12049880844]]] [test/add* '[:a 1] '[do [tree/list [tree/dup [tree/new :a 1]]]]] [test/add* '[a 1] '[do [tree/list [tree/dup [tree/new 'a 1]]]]] [test/add* "@[:a 1]" '[do [def t [tree/new :a 1]] [-> [tree/dup [tree/new :a 1]] [tree/++ :a]] [str/write t]]] [test/add* "@[:a 2]" '[do [def t [tree/new :a 1]] [str/write [-> [tree/dup [tree/new :a 1]] [tree/++ :a]]]]] [test/add* #f '[do [> #nil 1.0]]] [test/add* #f '[do [> #nil 1]]] [test/add* #f '[do [> #nil 0]]] [test/add* #f '[do [> #nil -1]]] [test/add* #f '[do [> #nil -1.0]]] [test/add* #f '[do [< #nil 1.0]]] [test/add* #f '[do [< #nil 1]]] [test/add* #f '[do [< #nil 0]]] [test/add* #f '[do [< #nil -1]]] [test/add* #f '[do [< #nil -1.0]]] [test/add* #f '[do [== #nil 1]]] [test/add* #f '[do [== #nil 0]]] [test/add* #f '[do [== #nil -1]]] [test/add* '[1 2 3] '[do [nreverse [list 3 2 1]]]] [test/add* '[1 2 3 4 5 6 7 8 9] '[do [nreverse [list 9 8 7 6 5 4 3 2 1]]]] [test/add* '[1] '[do [nreverse [list 1]]]] [test/add* '[2 1] '[do [nreverse [cons 1 [cons 2 #nil]]]]] [test/add* #nil '[do [nreverse #nil]]] [test/add* :tree '[do [type-of [tree/new #nil]]]] [test/add* '[] '[do [tree/list [tree/new #nil]]]] [test/add* '[] '[do [tree/keys [tree/new #nil]]]] [test/add* '[] '[do [tree/values [tree/new #nil]]]] [test/add* '[123] '[do [tree/values [tree/new :asd 123]]]] [test/add* '[:asd] '[do [tree/keys [tree/new :asd 123]]]] [test/add* '[:asd 123] '[do [tree/list [apply tree/new [tree/list [tree/new :asd 123]]]]]] [test/add* :tree '[do [type-of [tree/new :asd 123]]]] [test/add* '[:asd 123] '[do [tree/list [tree/dup [tree/new :asd 123]]]]] [test/add* '[] '[do [tree/list [tree/dup [tree/new #nil]]]]] [test/add* :type-error '[do [try [\ [err] [car err]] [tree/list [tree/dup #nil]]]]] [test/add* :type-error '[do [try [\ [err] [car err]] [tree/list [tree/dup 123]]]]] [test/add* :type-error '[do [try [\ [err] [car err]] [tree/list [tree/dup '[]]]]]] [test/add* "1.1" '[do [str/write 1.1]]] [test/add* "1.01" '[do [str/write 1.01]]] [test/add* "1.001" '[do [str/write 1.001]]] [test/add* "1.0001" '[do [str/write 1.0001]]] [test/add* "10.1" '[do [str/write 10.1]]] [test/add* "10.01" '[do [str/write 10.01]]] [test/add* "10.001" '[do [str/write 10.001]]] [test/add* "10.0001" '[do [str/write 10.0001]]] [test/add* "100.1" '[do [str/write 100.1]]] [test/add* "100.01" '[do [str/write 100.01]]] [test/add* "100.001" '[do [str/write 100.001]]] [test/add* "100.0001" '[do [str/write 100.0001]]] [test/add* "1000.1" '[do [str/write 1000.1]]] [test/add* "1000.01" '[do [str/write 1000.01]]] [test/add* "1000.001" '[do [str/write 1000.001]]] [test/add* "1000.0001" '[do [str/write 1000.0001]]] [test/add* "10000.1" '[do [str/write 10000.1]]] [test/add* "10000.01" '[do [str/write 10000.01]]] [test/add* "10000.001" '[do [str/write 10000.001]]] [test/add* "10000.0001" '[do [str/write 10000.0001]]] [test/add* "100000.1" '[do [str/write 100000.1]]] [test/add* "100000.01" '[do [str/write 100000.01]]] [test/add* "40004.40004" '[do [str/write [* 4 10001.10001]]]] [test/add* "30003.30003" '[do [str/write [* 3 10001.10001]]]] [test/add* "20002.20002" '[do [str/write [* 2 10001.10001]]]] [test/add* "50004201.04706" '[do [str/write [+ 50004201 0.04706]]]] [test/add* "504201.91003" '[do [str/write [+ 504201 0.91003]]]] [test/add* "-900200.01003" '[do [str/write -900200.01003]]] [test/add* "-900000.00001" '[do [str/write -900000.00001]]] [test/add* "109234.00012" '[do [str/write 109234.00012]]] [test/add* "102005" '[do [str/write 102005]]] [test/add* "-100295" '[do [str/write -100295]]] [test/add* "asd" '[do [string "asd"]]] [test/add* "123" '[do [string 123]]] [test/add* "#t" '[do [string #t]]] [test/add* "" '[do [string #nil]]] [test/add* "[1 2 3]" '[do [string '[1 2 3]]]] [test/add* "[1 2 3]" '[do [string '[1 2 3]]]] [test/add* "@[:a 3]" '[do [string [tree/new :a 3]]]] [test/add* "#[#nil]" '[do [str/write [array/set! [array/new 1] 0 #nil]]]] [test/add* "#[2]" '[do [str/write [array/set! [array/new 1] 0 2]]]] [test/add* "#[#t]" '[do [str/write [array/set! [array/new 1] 0 #t]]]] [test/add* "#[#f]" '[do [str/write [array/set! [array/new 1] 0 #f]]]] [test/add* '[1] '[do [read "#_[\"asd\"] 1"]]] [test/add* '[1] '[do [read "#_[asd] 1"]]] [test/add* '[1] '[do [read "#_[asd [123]] 1"]]] [test/add* '[1 2] '[do [read "1 #_[asd [123]] 2"]]] [test/add* '[1] '[do [read "1 #_[asd [123]]"]]] [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 tree/zip [λ* tree/zip [keys values] "Return a tree where KEYS point to VALUES" [do [def ret [tree/new]] [while keys [do [tree/set! ret [car keys] [car values]] [set! keys [cdr keys]] [set! values [cdr values]]]] ret]]] [def tree/+= [λ* tree/+= [t k v] "Increment value at K in T by V" [tree/set! t k [+ v [int [tree/get t k]]]]]] [def tree/++ [μ* tree/++ [t k] "Increment value at K in T by 1" [cons 'tree/+= [cons t [cons k [cons 1 #nil]]]]]]][optimize-all!]
Ben / Nujel
