application/octet-stream
•
135.32 KB
•
1 line
[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 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/fill! [λ* array/2d/fill! [data v] "" [do [array/fill! [data :data] v] data]]] [def array/2d/ref [λ* array/2d/ref [data x y oob-val] "" [if [or [>= x [data :width]] [>= y [data :height]] [< x 0] [< y 0]] oob-val [array/ref [data :data] [add x [mul y [data :width]]]]]]] [def array/2d/set! [λ* array/2d/set! [data x y val] "" [do [if [or [>= x [data :width]] [>= y [data :height]] [< x 0] [< y 0]] [throw [list :out-of-bounds "Trying to set an array out of bounds" data [current-lambda]]] [array/set! [data :data] [add x [mul y [data :width]]] val]] data]]] [def array/2d/print [λ* array/2d/print [data] "" [do [let* [do [def y 0] [def ΓεnΣym-25 [data :height]] [while [< y ΓεnΣym-25] [do [let* [do [def x 0] [def ΓεnΣym-26 [data :width]] [while [< x ΓεnΣym-26] [do [display [cat [array/2d/ref data x y] " "]] [set! x [add/int 1 x]]]]]] [newline] [set! y [add/int 1 y]]]]]] data]]]][do [def array/+= [λ* array/+= [a i v] "Add V to the value in A at position I and store the result in A returning A" [array/set! a i [+ v [array/ref a i]]]]] [def array/++ [λ* array/++ [a i] "Increment position I in A and return A" [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] [def ΓεnΣym-34 len] [while [< i ΓεnΣym-34] [do [array/set! a i v] [set! i [add/int 1 i]]]]]] a]]] [def array/append [λ* array/append [a b] "Append array A to array B" [do [if [and [array? a] [array? b]] #nil [throw [list :type-error "array/append expects two arrays as its arguments" #nil [current-lambda]]]] [def ret [array/allocate [+ [array/length a] [array/length b]]]] [let* [do [def i 0] [def ΓεnΣym-35 [array/length a]] [while [< i ΓεnΣym-35] [do [array/set! ret i [a i]] [set! i [add/int 1 i]]]]]] [let* [do [def i [array/length a]] [def ΓεnΣym-36 [array/length ret]] [while [< i ΓεnΣym-36] [do [array/set! ret i [b [- i [array/length a]]]] [set! i [add/int 1 i]]]]]] ret]]] [def array/dup [λ* array/dup [a] "Duplicate Array A" [array/append a [array/new #nil]]]] [def array/reduce [λ* array/reduce [arr fun α] "Reduce an array, [reduce] should be preferred" [do [def len [array/length arr]] [let* [do [def i 0] [def ΓεnΣym-37 len] [while [< i ΓεnΣym-37] [do [set! α [fun α [arr i]]] [set! i [add/int 1 i]]]]]] α]]] [def array/map [λ* array/map [arr fun] "Map an array, [map] should be preferred" [do [def len [array/length arr]] [let* [do [def i 0] [def ΓεnΣym-38 len] [while [< i ΓεnΣym-38] [do [array/set! arr i [fun [arr i]]] [set! i [add/int 1 i]]]]]] arr]]] [def array/filter [λ* array/filter [arr pred] "Filter an array, [filter] should be preferred" [do [def ri 0] [def len [array/length arr]] [def ret [array/allocate len]] [let* [do [def ai 0] [def ΓεnΣym-39 len] [while [< ai ΓεnΣym-39] [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]]]] [def array/push [λ* array/push [arr . val] "Append all arguments following ARR to ARR" [do [let* [do [def ΓεnΣym-40 val] [if ΓεnΣym-40 [while ΓεnΣym-40 [do [def v [car ΓεnΣym-40]] [array/length! arr [+ 1 [array/length arr]]] [array/set! arr [- [array/length arr] 1] v] [set! ΓεnΣym-40 [cdr ΓεnΣym-40]]]] #nil]]] arr]]] [def array/swap [λ* array/swap [arr i j] "" [do [def tmp [arr i]] [array/set! arr i [arr j]] [array/set! arr j tmp]]]] [def array/heapify [λ* array/heapify [arr n at] "bubble up the element from index AT to until the max-heap property is satisfied" [do [def top at] [def looping #t] [while looping [do [def l [+ [<< at 1] 1]] [def r [+ [<< at 1] 2]] [if [and [< l n] [> [arr l] [arr top]]] [set! top l] #nil] [if [and [< r n] [> [arr r] [arr top]]] [set! top r] #nil] [if [== top at] [set! looping #f] [do [array/swap arr at top] [set! at top]]]]] arr]]] [def array/make-heap [λ* array/make-heap [arr] "" [do [def l [array/length arr]] [def l2 [/ l 2]] [while [>= l2 0] [do [array/heapify arr l l2] [set! l2 [+ -1 l2]]]] arr]]] [def array/heap-sort [λ* array/heap-sort [arr] "" [do [array/make-heap arr] [def l [array/length arr]] [while [> l 0] [do [set! l [+ -1 l]] [array/swap arr 0 l] [array/heapify arr l 0]]] arr]]] [def array/sort array/heap-sort]][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 l [λ* #nil [a b] "" [if a [cat a glue b] b]] #nil] ""]]]] [def for-each [λ* for-each [l f] "Runs F over every item in collection L and returns the resulting list" [reduce l [λ* #nil [a b] "" [f b]] #nil]]] [def count [λ* count [l p] "Count the number of items in L where P is true" [reduce l [λ* #nil [a b] "" [+ a [if [p b] 1 0]]] 0]]] [def min/λ [λ* min/λ [a b] "" [if [< a b] a b]]] [def min [λ* min l "Returns the minimum value of its arguments, or collection" [reduce [if [cdr l] l [car l]] min/λ #nil]]] [def max/λ [λ* max/λ [a b] "" [if [> a b] a b]]] [def max [λ* max l "Returns the minimum value of its arguments, or collection" [reduce [if [cdr l] l [car l]] max/λ #nil]]] [def delete [λ* delete [l e] "Returns a filtered list l with all elements equal to e omitted" [filter l [λ* #nil [a] "" [not [== a e]]]]]] [def flatten/λ [λ* flatten/λ [a b] "" [if [collection? b] [append [reduce b flatten/λ #nil] a] [if #t [cons b a] #nil]]]] [def flatten [λ* flatten [l] "Flatten a collection of collections into a simple list" [if [collection? l] [nreverse [reduce l flatten/λ #nil]] l]]]][do [def ref [λ* ref [l i] "Return whatver is at position I in L" [let* [do [def ΓεnΣym-49 [type-of l]] [if [or [== ΓεnΣym-49 :nil]] #nil [if [or [== ΓεnΣym-49 :tree]] [tree/ref l i] [if [or [== ΓεnΣym-49 :string]] [char-at l i] [if [or [== ΓεnΣym-49 :array]] [array/ref l i] [if [or [== ΓεnΣym-49 :pair]] [list/ref l i] [throw [list :type-error "You can only use ref with a collection" l [current-lambda]]]]]]]]]]]] [def filter [λ* filter [l p] "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-50 [type-of l]] [if [or [== ΓεnΣym-50 :nil]] #nil [if [or [== ΓεnΣym-50 :pair]] [list/filter l p] [if [or [== ΓεnΣym-50 :array]] [array/filter l p] [throw [list :type-error "You can only use filter with a collection" l [current-lambda]]]]]]]]]] [def reduce [λ* reduce [l f α] "Combine all elements in collection l using operation F and starting value α" [let* [do [def ΓεnΣym-51 [type-of l]] [if [or [== ΓεnΣym-51 :nil]] α [if [or [== ΓεnΣym-51 :pair]] [list/reduce l f α] [if [or [== ΓεnΣym-51 :array]] [array/reduce l f α] [f α l]]]]]]]] [def length [λ* length [α] "Returns the length of collection α" [let* [do [def ΓεnΣym-52 [type-of α]] [if [or [== ΓεnΣym-52 :nil]] 0 [if [or [== ΓεnΣym-52 :array]] [array/length α] [if [or [== ΓεnΣym-52 :pair]] [list/length α] [if [or [== ΓεnΣym-52 :string]] [string/length α] [if [or [== ΓεnΣym-52 :tree]] [tree/size α] [throw [list :type-error "You can only use length with a collection" α [current-lambda]]]]]]]]]]]] [def map [λ* map [l f] "Runs f over every item in collection l and returns the resulting list" [let* [do [def ΓεnΣym-53 [type-of l]] [if [or [== ΓεnΣym-53 :nil]] #nil [if [or [== ΓεnΣym-53 :pair]] [list/map l f] [if [or [== ΓεnΣym-53 :array]] [array/map l f] [throw [list :type-error "You can only use map with a collection" l [current-lambda]]]]]]]]]] [def sort [λ* sort [l] "Sorts the collection L" [let* [do [def ΓεnΣym-54 [type-of l]] [if [== ΓεnΣym-54 :pair] [list/sort l] [if [== ΓεnΣym-54 :array] [array/sort l] [throw [list :type-error "You can only use sort with a collection" l [current-lambda]]]]]]]]] [def member [λ* member [l m] "Returns the first pair/item of collection l whose car is equal to m" [let* [do [def ΓεnΣym-55 [type-of l]] [if [== ΓεnΣym-55 :pair] [list/member l m] [if [== ΓεnΣym-55 :tree] [tree/get l m] [throw [list :type-error "You can only use member with a collection" l [current-lambda]]]]]]]]] [def collection? [λ* collection? [l] "" [let* [do [def ΓεnΣym-56 [type-of l]] [if [or [== ΓεnΣym-56 :pair] [== ΓεnΣym-56 :array]] #t #f]]]]]][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 [l o s] "Combine all elements in l using operation o and starting value s" [do [let* [do [def ΓεnΣym-62 l] [if ΓεnΣym-62 [while ΓεnΣym-62 [do [def e [car ΓεnΣym-62]] [set! s [o s e]] [set! ΓεnΣym-62 [cdr ΓεnΣym-62]]]] #nil]]] 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] [let* [do [def ΓεnΣym-63 l] [if ΓεnΣym-63 [while ΓεnΣym-63 [do [def e [car ΓεnΣym-63]] [set! ret [cons e ret]] [set! ΓεnΣym-63 [cdr ΓεnΣym-63]]]] #nil]]] ret]]] [def list/length [λ* list/length [l] "Returns the length of list l" [do [def ret 0] [let* [do [def ΓεnΣym-64 l] [if ΓεnΣym-64 [while ΓεnΣym-64 [do [def e [car ΓεnΣym-64]] [set! ret [+ 1 ret]] [set! ΓεnΣym-64 [cdr ΓεnΣym-64]]]] #nil]]] ret]]] [def list/filter [λ* list/filter [l p] "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] [let* [do [def ΓεnΣym-65 l] [if ΓεnΣym-65 [while ΓεnΣym-65 [do [def e [car ΓεnΣym-65]] [if [p e] [set! ret [cons e ret]] #nil] [set! ΓεnΣym-65 [cdr ΓεnΣym-65]]]] #nil]]] [nreverse ret]]]] [def list/map [λ* list/map [l f] "Runs f over every item in list l and returns the resulting list" [do [def ret #nil] [let* [do [def ΓεnΣym-66 l] [if ΓεnΣym-66 [while ΓεnΣym-66 [do [def e [car ΓεnΣym-66]] [set! ret [cons [f e] ret]] [set! ΓεnΣym-66 [cdr ΓεnΣym-66]]]] #nil]]] [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" [do [while b [do [set! a [append/iter [reverse a] [car b]]] [set! b [cdr b]]]] a]]] [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 list/member [λ* list/member [l m] "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 [cdr l] m] #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/bubble-sort [λ* list/bubble-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/bubble-sort next]]] #nil]]] [def list/merge-sorted-lists [λ* list/merge-sorted-lists [l1 l2] "" [if [nil? l1] l2 [if [nil? l2] l1 [if #t [if [< [car l1] [car l2]] [cons [car l1] [list/merge-sorted-lists [cdr l1] l2]] [cons [car l2] [list/merge-sorted-lists l1 [cdr l2]]]] #nil]]]]] [def list/split-half-rec [λ* list/split-half-rec [l acc1 acc2] "" [if [nil? l] [cons acc1 acc2] [if [nil? [cdr l]] [cons [cons [car l] acc1] acc2] [if #t [list/split-half-rec [cddr l] [cons [car l] acc1] [cons [cadr l] acc2]] #nil]]]]] [def list/split-half [λ* list/split-half [l] "" [list/split-half-rec l #nil #nil]]] [def list/merge-sort [λ* list/merge-sort [l] "Sorts a list" [if [nil? [cdr l]] l [do [def parts [list/split-half l]] [list/merge-sorted-lists [list/merge-sort [car parts]] [list/merge-sort [cdr parts]]]]]]] [def list/sort list/merge-sort]][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 v] "Decrement value at K in T by V" [cons 'tree/+= [cons t [cons k [cons [cons '- [cons v #nil]] #nil]]]]]] [def tree/++ [μ* tree/++ [t k] "Increment value at K in T by 1" [cons 'tree/+= [cons t [cons k [cons 1 #nil]]]]]] [def tree/-- [μ* tree/-- [t k] "Increment value at K in T by 1" [cons 'tree/-= [cons t [cons k [cons 1 #nil]]]]]]][do [def val->bytecode-op [λ* val->bytecode-op [v] "" [do [def i [val->index v]] [list [int->bytecode-op [logand [>> i 16] 255]] [int->bytecode-op [logand [>> i 8] 255]] [int->bytecode-op [logand i 255]]]]]] [def sym->bytecode-op [λ* sym->bytecode-op [v] "" [do [def i [sym->index v]] [list [int->bytecode-op [logand [>> i 16] 255]] [int->bytecode-op [logand [>> i 8] 255]] [int->bytecode-op [logand i 255]]]]]] [def int-fit-in-byte? [λ* int-fit-in-byte? [a] "" [and [<= a 127] [>= a -128]]]] [def $nop [λ* $nop [] "- | Do nothing" '[#$0]]] [def $ret [λ* $ret [] "a - | Return top of value stack" '[#$1]]] [def $push/int/byte [λ* $push/int/byte [a] "- a | Return top of value stack" [do [if [int-fit-in-byte? a] #nil [throw [list :invalid-bc-op "$push/int/byte can only push a signed 8-bit value" a [current-lambda]]]] [list #$2 [int->bytecode-op a]]]]] [def $push/int [λ* $push/int [a] "- a | Return top of value stack" [if [int-fit-in-byte? a] [$push/int/byte a] [$push/lval a]]]] [def $add/int [λ* $add/int [] "a b - c | Adds the two topmost values and pushes the result" '[#$3]]] [def $debug/print-stack [λ* $debug/print-stack [] "- | Print out the stack for the current closure" '[#$4]]] [def $push/lval [λ* $push/lval [v] "- v | Pushes v onto the stack" [list #$5 [val->bytecode-op v]]]] [def $make-list [λ* $make-list [item-count] "items ... - list | Makes a list of item-count items from the stack and pushes the resulting list" [list #$6 [int->bytecode-op item-count]]]] [def $eval [λ* $eval [a] "form - | Evaluates the form from the top of the stack" '[#$7]]] [def $apply [λ* $apply [arg-count fun] "arguments ... - result | Read arg-count arguments from the stack, apply the to fun and push the result on the stack" [list #$8 [int->bytecode-op arg-count] [val->bytecode-op fun]]]] [def $apply/dynamic [λ* $apply/dynamic [arg-count fun] "" [list #$1A [int->bytecode-op arg-count]]]] [def $call [λ* $call [target] " - | Call a bytecode subroutine" [list #$17 [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] [def $try [λ* $try [target] " - | Try something, jumping to target if an exception occurs" [list #$18 [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] [def $throw [λ* $throw [] " - | Return to the closest exception handler" [list #$19]]] [def $jmp [λ* $jmp [target] "" [list #$9 [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] [def $jt [λ* $jt [target] "" [list #$A [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] [def $jf [λ* $jf [target] "" [list #$B [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] [def $dup [λ* $dup [] "" '[#$C]]] [def $drop [λ* $drop [] "" '[#$D]]] [def $def [λ* $def [v] "" [list #$E [sym->bytecode-op v]]]] [def $set [λ* $set [v] "" [list #$F [sym->bytecode-op v]]]] [def $get [λ* $get [v] "" [list #$10 [sym->bytecode-op v]]]] [def $lambda [λ* $lambda [name args docs body] "" [list #$11 [val->bytecode-op name] [val->bytecode-op args] [val->bytecode-op docs] [val->bytecode-op body]]]] [def $macro [λ* $macro [name args docs body] "" [list #$12 [val->bytecode-op name] [val->bytecode-op args] [val->bytecode-op docs] [val->bytecode-op body]]]] [def $closure/push [λ* $closure/push [] "" '[#$13]]] [def $closure/enter [λ* $closure/enter [] "" '[#$14]]] [def $let [λ* $let [] "" '[#$15]]] [def $closure/pop [λ* $closure/pop [] "" '[#$16]]] [def assemble/build-sym-map [λ* assemble/build-sym-map [code sym-map pos] "" [do [while code [do [let* [do [def ΓεnΣym-70 [type-of [car code]]] [if [== ΓεnΣym-70 :bytecode-op] [tree/set! sym-map :last-op [set! pos [+ 1 pos]]] [if [== ΓεnΣym-70 :symbol] [and [== [car code] :label] [tree/set! sym-map [cadr code] pos]] [if [== ΓεnΣym-70 :pair] [set! pos [assemble/build-sym-map [car code] sym-map pos]] #nil]]]]] [set! code [cdr code]]]] pos]]] [def assemble/relocate-op [λ* assemble/relocate-op [code sym-map pos out] "" [do [def target [sym-map [cadr code]]] [def off [- [+ target [cadddr code]] pos]] [array/set! out [set! pos [+ 1 pos]] [int->bytecode-op [logand [>> off [caddr code]] 255]]] pos]]] [def assemble/emit-relocated-ops [λ* assemble/emit-relocated-ops [code sym-map pos out] "" [do [if [== [car code] :relocate] [set! pos [assemble/relocate-op code sym-map pos out]] [let* [do [def ΓεnΣym-71 code] [if ΓεnΣym-71 [while ΓεnΣym-71 [do [def op [car ΓεnΣym-71]] [let* [do [def ΓεnΣym-72 [type-of op]] [if [== ΓεnΣym-72 :bytecode-op] [array/set! out [set! pos [+ 1 pos]] op] [if [== ΓεnΣym-72 :pair] [set! pos [assemble/emit-relocated-ops op sym-map pos out]] #nil]]]] [set! ΓεnΣym-71 [cdr ΓεnΣym-71]]]] #nil]]]] pos]]] [def assemble/verbose #f] [def assemble* [λ* assemble* [code] "Assemble all arguments into a single :bytecode-array" [do [def sym-map [tree/new #nil]] [and assemble/verbose [println [cat [ansi-blue "Input:\n" [str/write code]]]]] [assemble/build-sym-map code sym-map 0] [and assemble/verbose [println [cat [ansi-yellow "Symbol Map:\n" [str/write sym-map]]]]] [def out [array/allocate [sym-map :last-op]]] [assemble/emit-relocated-ops code sym-map -1 out] [and assemble/verbose [println [cat [ansi-green "Output:\n" [str/write out]]]]] [arr->bytecode-arr out]]]] [def assemble [λ* assemble l "Assemble all arguments into a single :bytecode-array" [assemble* l]]] [def asmrun [μ* asmrun ops "Assemble and evaluate all bytecode arguments" [cons 'bytecode-eval [cons [cons 'assemble [append ops #nil]] #nil]]]]][do [def bytecompile/gen-label/counter 0] [def bytecompile/gen-label [λ* bytecompile/gen-label [prefix] "" [do [set! bytecompile/gen-label/counter [+ 1 bytecompile/gen-label/counter]] [str->sym [cat prefix ":label-" bytecompile/gen-label/counter]]]]] [def bytecompile/literal [λ* bytecompile/literal [source] "" [let* [do [def ΓεnΣym-77 [type-of source]] [if [== ΓεnΣym-77 :symbol] [if [keyword? source] [$push/lval source] [$get source]] [if [== ΓεnΣym-77 :int] [$push/int source] [$push/lval source]]]]]]] [def bytecompile/quote [λ* bytecompile/quote [source] "" [let* [do [def ΓεnΣym-78 [type-of source]] [if [== ΓεnΣym-78 :int] [$push/int source] [$push/lval source]]]]]] [def bytecompile/do/form [λ* bytecompile/do/form [source env] "" [if source [cons [cons [bytecompile* [car source] env] [if [last? source] #nil [cons [$drop] #nil]]] [bytecompile/do/form [cdr source] env]] #nil]]] [def bytecompile/do [λ* bytecompile/do [source env] "" [list [bytecompile/do/form [cdr source] env]]]] [def bytecompile/procedure [λ* bytecompile/procedure [op source env] "" [do [def args [map [cdr source] bytecompile*]] [list args [$apply [length args] op]]]]] [def bytecompile/def [λ* bytecompile/def [source env] "" [do [if [or [not [cadr source]] [not [symbol? [cadr source]]] [not [caddr source]]] [throw [list :syntax-error "[def] needs a symbol name and a value as arguments" #nil env]] #nil] [list [bytecompile* [caddr source] env] [$def [cadr source]]]]]] [def bytecompile/set! [λ* bytecompile/set! [source env] "" [do [if [or [not [cadr source]] [not [symbol? [cadr source]]] [not [caddr source]]] [throw [list :syntax-error "[set!] needs a symbol name and a value as arguments" #nil env]] #nil] [list [bytecompile* [caddr source] env] [$set [cadr source]]]]]] [def bytecompile/if [λ* bytecompile/if [source env] "" [let* [do [def sym-else [bytecompile/gen-label]] [def sym-after [bytecompile/gen-label]] [list [bytecompile* [cadr source] env] [$jf sym-else] [bytecompile* [caddr source] env] [$jmp sym-after] [list :label sym-else] [bytecompile* [cadddr source] env] [list :label sym-after]]]]]] [def bytecompile/while [λ* bytecompile/while [source env] "" [do [def sym-start [bytecompile/gen-label]] [def sym-end [bytecompile/gen-label]] [list [list :label sym-start] [bytecompile* [cadr source] env] [$jf sym-end] [bytecompile* [caddr source] env] [$jmp sym-start] [list :label sym-end]]]]] [def bytecompile/procedure/arg [λ* bytecompile/procedure/arg [source env] "" [if [last? source] [bytecompile* [car source] env] [cons [bytecompile* [car source] env] [bytecompile/procedure/arg [cdr source] env]]]]] [def bytecompile/procedure [λ* bytecompile/procedure [op args env] "" [do [def arg-count [length args]] [if args [list [bytecompile/procedure/arg args] [$apply arg-count op]] [$apply 0 op]]]]] [def bytecompile/procedure/dynamic [λ* bytecompile/procedure/dynamic [op args env] "" [do [def arg-count [length args]] [if args [list [bytecompile/procedure/arg args] [bytecompile* op env] [$apply/dynamic arg-count]] [list [bytecompile* op env] [$apply/dynamic 0]]]]]] [def bytecompile/and/rec [λ* bytecompile/and/rec [source env label-end] "" [list [bytecompile* [car source] env] [if [cdr source] [list [$dup] [$jf label-end] [$drop] [bytecompile/and/rec [cdr source] env label-end]] #nil]]]] [def bytecompile/and [λ* bytecompile/and [source env] "" [do [def label-end [bytecompile/gen-label]] [list [bytecompile/and/rec [cdr source] env label-end] [list :label label-end]]]]] [def bytecompile/or/rec [λ* bytecompile/or/rec [source env label-end] "" [if source [list [bytecompile* [car source] env] [$dup] [$jt label-end] [$drop] [bytecompile/or/rec [cdr source] env label-end]] #nil]]] [def bytecompile/or [λ* bytecompile/or [source env] "" [do [def label-end [bytecompile/gen-label]] [list [bytecompile/or/rec [cdr source] env label-end] [$push/lval #f] [list :label label-end]]]]] [def bytecompile/string [λ* bytecompile/string [source env] "" [bytecompile/procedure cat source env]]] [def bytecompile/array [λ* bytecompile/array [source env] "" [bytecompile/procedure array/ref source env]]] [def bytecompile/tree [λ* bytecompile/tree [source env] "" [bytecompile/procedure tree/ref source env]]] [def bytecompile/λ* [λ* bytecompile/λ* [source env] "" [apply $lambda [cdr source]]]] [def bytecompile/μ* [λ* bytecompile/μ* [source env] "" [apply $macro [cdr source]]]] [def bytecompile/ω* [λ* bytecompile/ω* [source env] "" [list [$let] [bytecompile/do [cdr source] env] [$closure/push] [$closure/pop]]]] [def bytecompile/let* [λ* bytecompile/let* [source env] "" [list [$let] [bytecompile/do [cadr source] env] [$closure/pop]]]] [def bytecompile/try [λ* bytecompile/try [source env] "" [do [def handler-sym [bytecompile/gen-label]] [def end-sym [bytecompile/gen-label]] [list [$try handler-sym] [bytecompile/do [cddr source] env] [$jmp end-sym] [:label handler-sym] [$apply 1 [cadr source]] [:label end-sym]]]]] [def bytecompile* [λ* bytecompile* [source env] "Compile the forms in source" [do [def op [if [resolves? [car source] env] [resolve [car source] env] [car source]]] [let* [do [def ΓεnΣym-79 [type-of op]] [if [== ΓεnΣym-79 :special-form] [let* [do [def ΓεnΣym-80 op] [if [== ΓεnΣym-80 do] [bytecompile/do source env] [if [== ΓεnΣym-80 let*] [bytecompile/let* source env] [if [== ΓεnΣym-80 def] [bytecompile/def source env] [if [== ΓεnΣym-80 set!] [bytecompile/set! source env] [if [== ΓεnΣym-80 if] [bytecompile/if source env] [if [== ΓεnΣym-80 while] [bytecompile/while source env] [if [== ΓεnΣym-80 and] [bytecompile/and source env] [if [== ΓεnΣym-80 or] [bytecompile/or source env] [if [== ΓεnΣym-80 λ*] [bytecompile/λ* source env] [if [== ΓεnΣym-80 μ*] [bytecompile/μ* source env] [if [== ΓεnΣym-80 ω*] [bytecompile/ω* source env] [if [== ΓεnΣym-80 try] [bytecompile/try source env] [if [== ΓεnΣym-80 quote] [bytecompile/quote [cadr source]] [throw [list :unknown-special-form "The compiler does not know the current special form, please fix the compiler!" [car source]]]]]]]]]]]]]]]]]] [if [or [== ΓεnΣym-79 :lambda] [== ΓεnΣym-79 :native-function]] [bytecompile/procedure op [cdr source] env] [if [== ΓεnΣym-79 :pair] [bytecompile/procedure/dynamic op [cdr source] env] [if [== ΓεnΣym-79 :string] [bytecompile/string source env] [if [== ΓεnΣym-79 :array] [bytecompile/array source env] [if [== ΓεnΣym-79 :tree] [bytecompile/tree source env] [bytecompile/literal source]]]]]]]]]]]] [def bytecompile [λ* bytecompile [form environment] "" [list [bytecompile* form environment] [$ret]]]] [def byterun [μ* byterun [form] "" [cons '-> [cons [cons 'compile [cons form #nil]] [cons 'bytecompile [cons 'assemble* [cons 'bytecode-eval #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-85 [type-of op]] [if [== ΓεnΣym-85 :special-form] [let* [do [def ΓεnΣym-86 op] [if [== ΓεnΣym-86 do] [compile/do source] [if [== ΓεnΣym-86 def] [compile/def source] [if [== ΓεnΣym-86 set!] [compile/set! source] [if [== ΓεnΣym-86 let*] [compile/let* source] [if [== ΓεnΣym-86 λ*] [compile/λ* source] [if [== ΓεnΣym-86 μ*] [compile/μ* source] [if [== ΓεnΣym-86 ω*] [compile/ω* source] [if [== ΓεnΣym-86 if] [compile/if source] [if [== ΓεnΣym-86 try] [compile/try source] [if [== ΓεnΣym-86 and] [compile/and source] [if [== ΓεnΣym-86 or] [compile/or source] [if [== ΓεnΣym-86 while] [compile/while source] [if [== ΓεnΣym-86 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-85 :macro] [compile/macro op source] [if [or [== ΓεnΣym-85 :lambda] [== ΓεnΣym-85 :native-function]] [compile/procedure op source] [if [== ΓεnΣym-85 :object] [compile/procedure/arg source] [if [== ΓεnΣym-85 :pair] [compile/procedure/arg source] [if [or [== ΓεnΣym-85 :int] [== ΓεnΣym-85 :float] [== ΓεnΣym-85 :vec]] [compile/procedure/arg source] [if [== ΓεnΣym-85 :array] [compile/procedure/arg source] [if [== ΓεnΣym-85 :string] [compile/procedure/arg source] [if [== ΓεnΣym-85 :tree] [compile/procedure/arg source] [if [last? source] source [compile/procedure/arg 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 load/forms [λ* load/forms [source-raw environment] "Load multiple forms, evaluating the results in environment, so we can make use of macros we just defined" [do [def source #nil] [def source-next source-raw] [def forms-compiled 0] [def try-again [λ* try-again [source] "" [set! source-next [cons source source-next]]]] [while source-next [do [def forms-compiled-last forms-compiled] [set! source source-next] [set! source-next #nil] [def errors #nil] [let* [do [def ΓεnΣym-87 source] [if ΓεnΣym-87 [while ΓεnΣym-87 [do [def form [car ΓεnΣym-87]] [try [λ* #nil [err] "" [do [set! errors [cons err errors]] [let* [do [def ΓεnΣym-88 [car err]] [if [== ΓεnΣym-88 :unresolved-procedure] [try-again [car source]] [if [== ΓεnΣym-88 :runtime-macro] [try-again [car source]] [throw err]]]]]]] [do [def compiled-form [compile form environment #t]] [if compiled-form [do [apply environment [cons 'eval* [cons compiled-form #nil]]] [set! forms-compiled [+ 1 forms-compiled]]] #nil]]] [set! ΓεnΣym-87 [cdr ΓεnΣym-87]]]] #nil]]] [set! source-next [nreverse source-next]] [if [<= forms-compiled forms-compiled-last] [do [for-each errors display/error] [throw [list :you-can-not-advance "The compiler got stuck trying to compile various forms, the final pass did not have a single form that compiled without errors"]]] #nil]]]]]] [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]]] [load/forms source-raw environment] [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 ω [μ* ω body "Defines and returns new object after evaluating body within" [compile [cons 'ω* body]]]] [def defobj ω*] [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 eval-compile [λ* eval-compile [expr closure] "Compile and the immediatly evaluate the result, mostly used by lRun()" [try display/error [eval* [compile expr closure]]]]] [def read-eval-compile [λ* read-eval-compile [expr closure] "Compile and the immediatly evaluate the result, mostly used by lRun()" [try display/error [eval* [compile [read expr] closure]]]]] [def eval-load [λ* eval-load [expr closure] "Compile and the immediatly evaluate the result, mostly used by lRun()" [try display/error [load/forms expr closure]]]] [def read-eval-load [λ* read-eval-load [expr closure] "Compile and the immediatly evaluate the result, mostly used by lRun()" [try display/error [load/forms [read expr] closure]]]] [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 [filter [map [symbol-table] resolve] lambda?] optimize!]]]][do [def disassemble/length [λ* disassemble/length [op] "Return the length in bytes of a bytecode operation and all its arguments" [let* [do [def ΓεnΣym-91 op] [if [or [== ΓεnΣym-91 #$2] [== ΓεnΣym-91 #$6]] 2 [if [or [== ΓεnΣym-91 #$9] [== ΓεnΣym-91 #$A] [== ΓεnΣym-91 #$B] [== ΓεnΣym-91 #$17] [== ΓεnΣym-91 #$18]] 3 [if [or [== ΓεnΣym-91 #$5] [== ΓεnΣym-91 #$E] [== ΓεnΣym-91 #$F] [== ΓεnΣym-91 #$10]] 4 [if [or [== ΓεnΣym-91 #$8]] 5 [if [or [== ΓεnΣym-91 #$11] [== ΓεnΣym-91 #$12]] 13 1]]]]]]]]] [def bytecode/nil-catcher [λ* bytecode/nil-catcher [error] "" [if [== [car error] :argument-mismatch] #nil [throw error]]]] [def bytecode-op->val [λ* bytecode-op->val [a b c] "Turn three bytecode ops representing an encoded value into an actual value" [index->val [logior [<< [bytecode-op->int a] 16] [<< [bytecode-op->int b] 8] [bytecode-op->int c]]]]] [def bytecode-arr->val [λ* bytecode-arr->val [a i] "Read a bytecode encoded value in A at I and return it" [try bytecode/nil-catcher [bytecode-op->val [a i] [a [+ 1 i]] [a [+ 2 i]]]]]] [def bytecode-op->sym [λ* bytecode-op->sym [a b c] "Turn three bytecode ops representing an encoded symbol into an actual symbol" [index->sym [logior [<< [bytecode-op->int a] 16] [<< [bytecode-op->int b] 8] [bytecode-op->int c]]]]] [def bytecode-arr->sym [λ* bytecode-arr->sym [a i] "Read a bytecode encoded symbol in A at I and return it" [try bytecode/nil-catcher [bytecode-op->sym [a i] [a [+ 1 i]] [a [+ 2 i]]]]]] [def bytecode-op->offset [λ* bytecode-op->offset [a b] "Turn two bytecode ops encoding an offset into the integer representation" [do [def t [logior [<< [bytecode-op->int a] 8] [bytecode-op->int b]]] [if [> t 32768] [- [- 65536 t]] t]]]] [def bytecode-arr->offset [λ* bytecode-arr->offset [a i] "Read a bytecode encoded offset in A at I and return it as a signed integer" [bytecode-op->offset [a i] [a [+ 1 i]]]]] [def disassemble/op [λ* disassemble/op [a i] "Disassemble a single bytecode op in A at I and return it as an s-expression, that could be applied to eval" [let* [do [def ΓεnΣym-92 [a i]] [if [== ΓεnΣym-92 #$0] '[$nop] [if [== ΓεnΣym-92 #$1] '[$ret] [if [== ΓεnΣym-92 #$2] [cons '$push/int/byte [cons [bytecode-op->int [a [+ i 1]]] #nil]] [if [== ΓεnΣym-92 #$3] '[$add/int] [if [== ΓεnΣym-92 #$4] '[$debug/print-stack] [if [== ΓεnΣym-92 #$5] [cons '$push/lval [cons [bytecode-arr->val a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$6] [cons '$make-list [cons [bytecode-op->int [a [+ i 1]]] #nil]] [if [== ΓεnΣym-92 #$7] '[$eval] [if [== ΓεnΣym-92 #$8] [cons '$apply [cons [bytecode-op->int [a [+ i 1]]] [cons [bytecode-arr->val a [+ i 2]] #nil]]] [if [== ΓεnΣym-92 #$9] [cons '$jmp* [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$A] [cons '$jt* [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$B] [cons '$jf* [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$C] '[$dup] [if [== ΓεnΣym-92 #$D] '[$drop] [if [== ΓεnΣym-92 #$E] [cons '$def [cons [bytecode-arr->sym a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$F] [cons '$set [cons [bytecode-arr->sym a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$10] [cons '$get [cons [bytecode-arr->sym a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$11] [cons '$lambda [cons [bytecode-arr->val a [+ i 1]] [cons [bytecode-arr->val a [+ i 4]] [cons [bytecode-arr->val a [+ i 7]] [cons [bytecode-arr->val a [+ i 10]] #nil]]]]] [if [== ΓεnΣym-92 #$12] [cons '$macro [cons [bytecode-arr->val a [+ i 1]] [cons [bytecode-arr->val a [+ i 4]] [cons [bytecode-arr->val a [+ i 7]] [cons [bytecode-arr->val a [+ i 10]] #nil]]]]] [if [== ΓεnΣym-92 #$13] '[$closure/push] [if [== ΓεnΣym-92 #$14] '[$closure/enter] [if [== ΓεnΣym-92 #$15] '[$let] [if [== ΓεnΣym-92 #$16] '[$closure/pop] [if [== ΓεnΣym-92 #$17] [cons '$call [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$18] [cons '$try [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-92 #$19] '[$throw] [if [== ΓεnΣym-92 #$1A] '[$apply/dynamic [unquote [bytecode-op->int [a [+ i 1]]]]] :unknown-op]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] [def disassemble/array [λ* disassemble/array [a i] "Disassemble all bytecode operations in the plain array A starting at I, turning it into an assembler S-Expression and return it as a dotted pair, with the car containing the offset and the cdr containing the S-Expression" [do [def ret #nil] [while [< i [array/length a]] [do [set! ret [cons [cons i [disassemble/op a i]] ret]] [set! i [+ i [disassemble/length [a i]]]]]] [nreverse ret]]]] [def disassemble [λ* disassemble [code] "Disassemble the bytecode array CODE, turning it into a list of dotted pairs, with the car containing the offset and the cdr containing assembler S-Expressions," [disassemble/array [bytecode-arr->arr code] 0]]] [def disassemble/raw [λ* disassemble/raw [bc] "Disassemble the bytecode array CODE, turning it into a list of dotted pairs, with the car containing the offset and the cdr containing assembler S-Expressions," [for-each [disassemble bc] [λ* #nil [a] "" [println [cat [ansi-blue [string/pad-start [string [car a]] 6]] " - " [cdr a]]]]]]] [def disassemble/test [λ* disassemble/test [asm] "Verbose way of testing the disassembler" [do [println [ansi-blue "--------- Assembly -----------"]] [def cur-line 0] [for-each asm [λ* #nil [a] "" [println [cat [ansi-yellow [string/pad-start [set! cur-line [+ 1 cur-line]] 6]] " - " a]]]] [println [ansi-yellow "--------- Raw Bytecode -----------"]] [def bc [apply assemble asm]] [println [str/write bc]] [println [ansi-green "--------- Now for the disassembly -----------"]] [for-each [disassemble bc] [λ* #nil [a] "" [println [cat [ansi-blue [string/pad-start [string [car a]] 6]] " - " [cdr a]]]]] [println [ansi-red "--------- Fin -----------\n"]] [try display/error [println [str/write [bytecode-eval bc]]]]]]]][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 new #nil] [let* [do [def ΓεnΣym-95 yield-queue] [if ΓεnΣym-95 [while ΓεnΣym-95 [do [def cur [car ΓεnΣym-95]] [if [[car cur]] [[cdr cur]] [set! new [cons cur new]]] [set! ΓεnΣym-95 [cdr ΓεnΣym-95]]]] #nil]]] [set! yield-queue new]]]] [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 id handler] "Bind handler to be evaluated when event-name fires, overwriting whichever handler has been associated with id before." [tree/set! event id handler]]] [def event-clear [μ* event-clear [event] "Clears all event handlers for event-name" [cons 'set! [cons event [cons [cons 'tree/new [cons #nil #nil]] #nil]]]]] [def event-fire [λ* event-fire [event . val] "Applies ...val to all event handlers associated with event-name" [let* [do [def ΓεnΣym-96 [tree/values event]] [if ΓεnΣym-96 [while ΓεnΣym-96 [do [def h [car ΓεnΣym-96]] [h val] [set! ΓεnΣym-96 [cdr ΓεnΣym-96]]]] #nil]]]]]][do [def let/arg [λ* let/arg [arg] "" [if 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]]]] #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 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]]]]]]][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 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 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]] [if [and [== [car [caar clauses]] 'quote] [last? [cdr [caar clauses]]] [symbol? [cadr [caar clauses]]]] [list '== key-sym [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 [and body [caar 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 stop-var [gensym]] [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]]] [def pred [if [> dir 0] < >]] [cons 'let [cons [cons [cons symbol-name [cons loop-start #nil]] [cons [cons stop-var [cons loop-stop #nil]] #nil]] [cons [cons 'while [cons [cons pred [cons symbol-name [cons stop-var #nil]]] [append body [cons [cons 'set! [cons symbol-name [cons [cons 'add/int [cons dir [cons symbol-name #nil]]] #nil]]] #nil]]]] #nil]]]]]] [def for-in [μ* for-in [for-loop . body] "[for-in [l [list 1 2 3 4]] [println l]]" [do [def symbol-name [gensym]] [cons 'let [cons [cons [cons symbol-name [cons [cadr for-loop] #nil]] #nil] [cons [cons 'when [cons symbol-name [cons [cons 'while [cons symbol-name [cons [cons 'def [cons [car for-loop] [cons [cons 'car [cons symbol-name #nil]] #nil]]] [append body [cons [cons 'cdr! [cons symbol-name #nil]] #nil]]]]] #nil]]] #nil]]]]]] [def thread/-> [λ* thread/-> [init fun] "" [if fun [if [pair? [car fun]] [cons [caar fun] [cons [thread/-> init [cdr fun]] [append [cdar fun] #nil]]] [list [car fun] [thread/-> init [cdr fun]]]] 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]]]] [def once [μ* once forms "Evaluate forms exactly once, even if called multiple times" [let* [do [def lock [gensym "once-"]] [cons 'when-not [cons lock [append forms [cons [cons 'def [cons lock [cons #t #nil]]] #nil]]]]]]]]][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] [>= [float a] 0.0]]]] [def zero-neg? [λ* zero-neg? [a] "Return #t if a is zero or negative" [and [numeric? a] [<= [float a] 0.0]]]] [def neg? [λ* neg? [a] "Returns #t if a is negative" [and [numeric? a] [< [float a] 0.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]] #f]]] [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 array? [λ* array? [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]]]]] [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 bytecode-array? [λ* bytecode-array? [v] "" [== :bytecode-array [type-of v]]]] [def bytecode-op? [λ* bytecode-op? [v] "" [== :bytecode-op [type-of v]]]] [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 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 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]]]]][def hash/adler32 [λ* hash/adler32 [data] "" [do [def a 1] [def b 0] [let* [do [def i 0] [def ΓεnΣym-22 [string/length data]] [while [< i ΓεnΣym-22] [do [set! a [mod/int [add/int a [char-at data i]] 65521]] [set! b [mod/int [add/int a b] 65521]] [set! i [add/int 1 i]]]]]] [logior a [<< b 16]]]]][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 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 arg-list [λ* arg-list [f] "Return the Argument list of f which can be a Native Function or a Lambda" [throw [list :gotta-implement-it]]]] [def gensym/counter 0] [def gensym [λ* gensym [prefix] "" [do [set! gensym/counter [+ 1 gensym/counter]] [str->sym [cat prefix "ΓεnΣym-" gensym/counter]]]]] [def root-closure [current-closure]]][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 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 [split [apply cat args] ""] [λ* #nil [a] "" [do [set! count [logand [+ 1 count] 7]] [cat [ansi-fg [if [zero? count] 7 [+ count 8]]] a]]]] ""] ansi-fg-reset]]]]] [def ansi-rainbow-bg [λ* ansi-rainbow-bg args "Wrap ARGS in the colors of the rainbow!" [do [def count 0] [def colored-list [map [split [apply cat args] ""] [λ* #nil [a] "" [do [set! count [logand [+ 1 count] 7]] [cat [ansi-fg [logxor count 7]] [ansi-bg count] a]]]]] [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] [def ΓεnΣym-5 width] [while [< i ΓεnΣym-5] [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] [def ΓεnΣym-6 100000] [while [< i ΓεnΣym-6] [do [reprint-line [string i]] [set! i [add/int 1 i]]]]]] [print " Done!\r\n"]]]]][do [def fmt/format-arg/default [tree/new :debug #f :base #f :precision #nil :width #nil :padding-char " "]] [def fmt/find-first-non-digit-from-r [λ* fmt/find-first-non-digit-from-r [s i] "" [if [< i 0] #f [do [def char [char-at s i]] [if [and [>= char 48] [<= char 57]] [fmt/find-first-non-digit-from-r s [- i 1]] i]]]]] [def fmt/parse-spec [λ* fmt/parse-spec [opts spec] "" [if [zero? [string/length spec]] opts [let* [do [def ΓεnΣym-13 [char-at spec [- [string/length spec] 1]]] [if [or [== ΓεnΣym-13 48] [== ΓεnΣym-13 49] [== ΓεnΣym-13 50] [== ΓεnΣym-13 51] [== ΓεnΣym-13 52] [== ΓεnΣym-13 53] [== ΓεnΣym-13 54] [== ΓεnΣym-13 55] [== ΓεnΣym-13 56] [== ΓεnΣym-13 57]] [do [def next-non-digit [fmt/find-first-non-digit-from-r spec [- [string/length spec] 1]]] [if next-non-digit [fmt/parse-spec [tree/set! opts :precision [read/single [substr spec [+ next-non-digit 1] [string/length spec]]]] [substr spec 0 next-non-digit]] [tree/set! [if [== 48 [char-at spec 0]] [tree/set! opts :padding-char "0"] opts] :width [read/single spec]]]] [if [== ΓεnΣym-13 63] [fmt/parse-spec [tree/set! opts :debug #t] [substr spec 0 [- [string/length spec] 1]]] [if [== ΓεnΣym-13 88] [fmt/parse-spec [tree/set! opts :base :HEXADECIMAL] [substr spec 0 [- [string/length spec] 1]]] [if [== ΓεnΣym-13 120] [fmt/parse-spec [tree/set! opts :base :hexadecimal] [substr spec 0 [- [string/length spec] 1]]] [if [== ΓεnΣym-13 100] [fmt/parse-spec [tree/set! opts :base :decimal] [substr spec 0 [- [string/length spec] 1]]] [if [== ΓεnΣym-13 111] [fmt/parse-spec [tree/set! opts :base :octal] [substr spec 0 [- [string/length spec] 1]]] [if [== ΓεnΣym-13 98] [fmt/parse-spec [tree/set! opts :base :binary] [substr spec 0 [- [string/length spec] 1]]] [throw [list :format-error "Unknown form-spec option" spec [current-closure]]]]]]]]]]]]]]] [def fmt/debug [λ* fmt/debug [opts] "" [if [opts :debug] [tree/set! opts :argument [list str/write [opts :argument]]] opts]]] [def fmt/number-format [λ* fmt/number-format [opts] "" [let* [do [def ΓεnΣym-14 [opts :base]] [if [== ΓεnΣym-14 :binary] [tree/set! opts :argument [list int->string/binary [opts :argument]]] [if [== ΓεnΣym-14 :octal] [tree/set! opts :argument [list int->string/octal [opts :argument]]] [if [== ΓεnΣym-14 :decimal] [tree/set! opts :argument [list int->string/decimal [opts :argument]]] [if [== ΓεnΣym-14 :hexadecimal] [tree/set! opts :argument [list int->string/hex [opts :argument]]] [if [== ΓεnΣym-14 :HEXADECIMAL] [tree/set! opts :argument [list int->string/HEX [opts :argument]]] opts]]]]]]]]] [def fmt/number-format-prefixex [tree/new :binary "#b" :octal "#o" :decimal "#d" :hexadecimal "#x" :HEXADECIMAL "#x"]] [def fmt/number-format-prefix [λ* fmt/number-format-prefix [opts] "" [if [or [not [opts :debug]] [not [opts :base]]] opts [tree/set! [if [member '[:binary :octal :decimal :hexadecimal :HEXADECIMAL] [opts :base]] [tree/set! opts :argument [list cat [fmt/number-format-prefixex [opts :base]] [opts :argument]]] opts] :debug #f]]]] [def fmt/add-padding [λ* fmt/add-padding [opts] "" [if [opts :width] [tree/set! opts :argument [list string/pad-start [opts :argument] [if [and [opts :debug] [opts :base]] [- [opts :width] 2] [opts :width]] [opts :padding-char]]] opts]]] [def fmt/output [λ* fmt/output [opts] "" [opts :argument]]] [def fmt/format-arg [λ* fmt/format-arg [spec argument] "" [fmt/output [fmt/debug [fmt/number-format-prefix [fmt/add-padding [fmt/number-format [tree/set! [fmt/parse-spec [tree/dup fmt/format-arg/default] spec] :argument argument]]]]]]]] [def fmt/valid-argument? [λ* fmt/valid-argument? [argument] "" [or [int? argument] [symbol? argument]]]] [def fmt/expr/count 0] [def fmt/expr [λ* fmt/expr [expr arguments-used] "" [do [if [string? expr] #nil [throw [list :format-error "fmt needs a string literal as a first argument, since it is implemented as a macro" expr [current-lambda]]]] [def split-expr [split expr ":"]] [def argument [car split-expr]] [def format-spec [or [cadr split-expr] ""]] [if [== "" argument] [do [array/set! arguments-used [set! fmt/expr/count [+ -1 fmt/expr/count]] #t] [fmt/format-arg format-spec [str->sym [string fmt/expr/count]]]] [let* [do [def read-vals [read argument]] [if [cdr read-vals] [throw [list :format-error "Format argument specifier contains more than a single atom" argument [current-lambda]]] #nil] [if [fmt/valid-argument? [car read-vals]] #nil [throw [list :format-error "Format argument specifier should be either an integer or a symbol" argument [current-lambda]]]] [if [int? [car read-vals]] [do [if [or [< [car read-vals] 0] [>= [car read-vals] [array/length arguments-used]]] [throw [list :format-error "fmt numbered argument is out of bounds" argument [current-lambda]]] #nil] [array/set! arguments-used [car read-vals] #t]] #nil] [fmt/format-arg format-spec [str->sym [string [car read-vals]]]]]]]]]] [def fmt/args/map-fun/count 0] [def fmt/args/map-fun [λ* fmt/args/map-fun [arg] "" [do [def s [str->sym [string fmt/args/map-fun/count]]] [set! fmt/args/map-fun/count [+ 1 fmt/args/map-fun/count]] [list 'def s arg]]]] [def fmt [μ* fmt [format-string . args] "Return a formatted string" [do [if [string? format-string] #nil [throw [list :type-error "fmt needs a string literal as a first argument, since it is implemented as a macro" format-string [current-lambda]]]] [def cuts #nil] [let* [do [def i 0] [def ΓεnΣym-15 [string/length format-string]] [while [< i ΓεnΣym-15] [do [let* [do [def ΓεnΣym-16 [char-at format-string i]] [if [== ΓεnΣym-16 123] [do [if [int? [car cuts]] [throw [list :format-error "fmt placeholders can\'t be nested" format-string [current-lambda]]] #nil] [set! cuts [cons i cuts]]] [if [== ΓεnΣym-16 125] [do [if [int? [car cuts]] #nil [throw [list :format-error "fmt expects all brackets to be closed" format-string [current-lambda]]]] [set! cuts [cons [cons [car cuts] i] [cdr cuts]]]] #nil]]]] [set! i [add/int 1 i]]]]]] [if [int? [car cuts]] [throw [list :format-error "fmt placeholders can\'t be nested" format-string [current-lambda]]] #nil] [def expr-list #nil] [def last-pos [string/length format-string]] [def arguments-used [array/fill! [array/allocate [length args]] #f]] [set! fmt/expr/count [array/length arguments-used]] [let* [do [def ΓεnΣym-17 cuts] [if ΓεnΣym-17 [while ΓεnΣym-17 [do [def c [car ΓεnΣym-17]] [def lit [substr format-string [+ [cdr c] 1] last-pos]] [if [== "" lit] #nil [set! expr-list [cons lit expr-list]]] [def expr [fmt/expr [substr format-string [+ 1 [car c]] [cdr c]] arguments-used]] [set! expr-list [cons expr expr-list]] [set! last-pos [car c]] [set! ΓεnΣym-17 [cdr ΓεnΣym-17]]]] #nil]]] [if [> last-pos 0] [do [def lit [substr format-string 0 last-pos]] [set! expr-list [cons lit expr-list]]] #nil] [let* [do [def i 0] [def ΓεnΣym-18 [array/length arguments-used]] [while [< i ΓεnΣym-18] [do [if [array/ref arguments-used i] #nil [throw [list :format-error "fmt expects all arguments to be used" [list format-string [list/ref args i]] [current-lambda]]]] [set! i [add/int 1 i]]]]]] [def expr [if [cdr expr-list] [cons 'cat expr-list] [if [string? [car expr-list]] [car expr-list] [cons 'string expr-list]]]] [set! fmt/args/map-fun/count 0] [if args [cons 'let* [append [map args fmt/args/map-fun] [cons expr #nil]]] expr]]]] [def pfmt [μ* pfmt [format-string . args] "Print a formatted string" [cons 'print [cons [cons 'fmt [cons format-string [append args #nil]]] #nil]]]] [def efmt [μ* efmt [format-string . args] "Print a formatted string" [cons 'error [cons [cons 'fmt [cons format-string [append args #nil]]] #nil]]]]][do [def println [λ* println [str] "Print STR on a single line" [print [cat str "\r\n"]]]] [def display [λ* display [value] "Display VALUE" [print value]]] [def newline [λ* newline [] "Print a single line feed character" [display "\r\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/hex [λ* int->string/hex [α] "Turn α into a its **hexadecimal** string representation" [lowercase [int->string/HEX α]]]] [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 " "]] [if [string? text] #nil [set! text [string text]]] [if [string? char] #nil [throw [list :type-error "string/pad-start needs char as a string, so that one can pad with multiple characters" char [current-lambda]]]] [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 " "]] [if [string? text] #nil [set! text [string text]]] [if [string? char] #nil [throw [list :type-error "string/pad-start needs char as a string, so that one can pad with multiple characters" char [current-lambda]]]] [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-20 [string/length separator]] [if [or [== ΓεnΣym-20 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 [split chars ""] [λ* #nil [a] "" [>= [index-of str a] 0]]]]]] [def contains-all? [λ* contains-all? [str chars] "" [apply and [map [split chars ""] [λ* #nil [a] "" [>= [index-of str a] 0]]]]]]][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-bytecode [λ* test-bytecode [result rawexpr i] "Tests that RAWEXPR evaluates to RESULT when run through the bytecode interpreter" [try [λ* #nil [err] "" [test-failure result [list :exception-caught err] rawexpr i]] [do [def expr [bytecode-eval [assemble* [bytecompile [compile rawexpr]]]]] [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-default [λ* test-default [result rawexpr i] "Tests that RAWEXPR evaluates to RESULT" [try [λ* #nil [err] "" [test-failure result [list :exception-caught 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-real [λ* test-run-real [test] "" [do [set! nujel-start [time/milliseconds]] [set! success-count 0] [set! error-count 0] [def i [- test-count 1]] [let* [do [def ΓεnΣym-2 test-list] [if ΓεnΣym-2 [while ΓεnΣym-2 [do [def cur-test [car ΓεnΣym-2]] [test [car cur-test] [cdr cur-test] [set! i [+ -1 i]]] [set! ΓεnΣym-2 [cdr ΓεnΣym-2]]]] #nil]]] [display-results] error-count]]] [def test-run [λ* test-run [output-passes hide-errors run-bytecode] "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-bytecode [λ* test-run-bytecode [output-passes hide-errors run-bytecode] "Run through all automated Tests" [do [set! print-errors [not [bool hide-errors]]] [set! print-passes [bool output-passes]] [test-run-real test-bytecode]]]] [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 [not [< 3 2]]]] [test/add* #t '[do [zero? 0]]] [test/add* #t '[do [> 3.1 2.1]]] [test/add* #t '[do [> 3 2]]] [test/add* #f '[do [>= 4 "3"]]] [test/add* #t '[do [>= 3 3]]] [test/add* #t '[do [<= 3 3]]] [test/add* #t '[do [not [>= "2" 3]]]] [test/add* #t '[do [and [not [< 3 2]] [zero? 0] [> 3.1 2.1] [> 3 2] [not [>= 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 [== "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 [nil? #nil]]] [test/add* #f '[do [nil? "NotNil"]]] [test/add* #t '[do [not [nil? "NotNil"]]]] [test/add* #t '[do [vec? [vec 1]]]] [test/add* #t '[do [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 [array? [array/new 1 2 3]]]] [test/add* #t '[do [array? [array/allocate 3]]]] [test/add* #f '[do [array? '[1 2 3]]]] [test/add* #f '[do [array? [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* 0 '[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* #nil '[do [max]]] [test/add* #nil '[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 9 25]]] [test/add* 25 '[do [max '[1 4 9 25]]]] [test/add* 25 '[do [max [array/new 1 4 9 25]]]] [test/add* 25 '[do [max 25 4 9 1]]] [test/add* 25 '[do [max '[25 4 9 1]]]] [test/add* 25 '[do [max [array/new 25 4 9 1]]]] [test/add* 1 '[do [min 1 4 9 25]]] [test/add* 1 '[do [min '[1 4 9 25]]]] [test/add* 1 '[do [min [array/new 1 4 9 25]]]] [test/add* 1 '[do [min 25 4 9 1]]] [test/add* 1 '[do [min '[25 4 9 1]]]] [test/add* 1 '[do [min [array/new 25 4 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* 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/single "[+ 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 '[1 2.0 #t 4] int?]]] [test/add* "[2.0]" '[do [str/write [filter '[1 2.0 #t 4] float?]]]] [test/add* "[2.0]" '[do [str/write [filter '[1 2.0 #t 4] float?]]]] [test/add* '[#t] '[do [filter '[1 2.0 #t 4] bool?]]] [test/add* '[1 3 5] '[do [filter '[1 2 3 4 5 6] odd?]]] [test/add* 3 '[do [count '[1 2 3 4 5 6] odd?]]] [test/add* 3 '[do [count '[1 2 3 4 5 6] even?]]] [test/add* 6 '[do [count '[1 2 3 4 5 6] int?]]] [test/add* 0 '[do [count '[1 2 3 4 5 6] float?]]] [test/add* '[2 4 6] '[do [filter '[1 2 3 4 5 6] even?]]] [test/add* '["vier"] '[do [filter '[1 2 3 "vier" 5 6] string?]]] [test/add* '[1 2 3 5 6] '[do [filter '[1 2 3 "vier" 5 6] int?]]] [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 '[123 456 "asd" #t #f] "asd"]]]] [test/add* "[[vec 4.0 4.0 4.0] 9 16.0]" '[do [str/write [map [cons [vec 2] '[3 4.0]] [λ [a] [* a a]]]]]] [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* "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 [let* [def eins [ω [defun say [] "Zwei"]]] [def zwei [eins [ω]]] [zwei [say]]]]] [test/add* "asd" '[do ["a" "s" "d"]]] [test/add* "a" '[do ["a"]]] [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* #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 [split "1,2,3" ","] float]]]] [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* 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 [== 4 [+ 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 2.1]]]] [test/add* -1 '[do [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.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* #nil '[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 '[1 2 3] [λ [v] [+ 1 v]]]]] [test/add* '[2 4 6] '[do [map '[1 2 3] [λ [v] [* 2 v]]]]] [test/add* '["1" "2" "3"] '[do [map '[1 2 3] str/write]]] [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* "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.0 -10.0 5.0]]] [test/add* 6 '[do [let* [def sum 0] [for-each '[1 2 3] [λ [a] [set! sum [+ sum a]]]] 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* :syntax-error '[do [try car [bytecompile '[def #nil #nil]]]]] [test/add* :syntax-error '[do [try car [bytecompile '[def]]]]] [test/add* :syntax-error '[do [try car [bytecompile '[set! #nil #nil]]]]] [test/add* :syntax-error '[do [try car [bytecompile '[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 '[1 2 3] [+x 3]]]] [test/add* 4 '[do [def α 3] [++ α] α]] [test/add* 2.0 '[do [cbrt 8]]] [test/add* 3.0 '[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] #f] [3 #t]]]] [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] add/int 0]]] [test/add* "1,2,3,4" '[do [join [array/new 1 2 3 4] ","]]] [test/add* 2 '[do [count [array/new 1 2 3 4] even?]]] [test/add* 14 '[do [reduce [map [array/new 1 2 3 4] [+x 1]] + 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 [array/new 1 2 3 4] even?]]]] [test/add* 5 '[do [count '[4 30 22 23 21 15 7 28 16 25 2 10] [bit-set?! 0]]]] [test/add* 7 '[do [count [array/new 4 30 22 23 21 15 7 28 16 25 2 10] [bit-set?! 1]]]] [test/add* 7 '[do [count '[4 30 22 23 21 15 7 28 16 25 2 10] [bit-clear?! 0]]]] [test/add* 5 '[do [count [array/new 4 30 22 23 21 15 7 28 16 25 2 10] [bit-clear?! 1]]]] [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* 2 '[do [-> 2]]] [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 [-> [array/new 1 2 3] [array/length! 4] [array/set! 3 4] [reduce add 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* "#[]" '[do [str/write [sort [array/new #nil]]]]] [test/add* "#[1]" '[do [str/write [sort [array/new 1]]]]] [test/add* "#[1 2 3]" '[do [str/write [sort [array/new 3 2 1]]]]] [test/add* "#[1 2 3 9]" '[do [str/write [sort [array/new 3 9 2 1]]]]] [test/add* '[1 2 3] '[do [list/bubble-sort '[2 1 3]]]] [test/add* '[1 2 3] '[do [list/bubble-sort '[2 1 3]]]] [test/add* '[1] '[do [list/bubble-sort '[1]]]] [test/add* '[] '[do [list/bubble-sort '[]]]] [test/add* '[1 2 3] '[do [sort '[1 2 3]]]] [test/add* '[1 3 9] '[do [sort '[1 3 9]]]] [test/add* '[1 9] '[do [sort '[1 9]]]] [test/add* '[1 1 2 9] '[do [sort '[1 1 2 9]]]] [test/add* '[1.0 2.0 3.0] '[do [sort '[3.0 1.0 2.0]]]] [test/add* '["a" "m" "z"] '[do [sort '["m" "a" "z"]]]] [test/add* '["a" "m" "z"] '[do [sort '["z" "m" "a"]]]] [test/add* '["a" "m" "z"] '[do [sort '["a" "z" "m"]]]] [test/add* '["Z" "a" "m" "z"] '[do [sort '["a" "Z" "m" "z"]]]] [test/add* '["aggressionen" "mit" "zauberer"] '[do [sort '["zauberer" "aggressionen" "mit"]]]] [test/add* '[1 2 3] '[do [list/merge-sort '[1 2 3]]]] [test/add* '[1 2 3] '[do [list/merge-sort '[3 2 1]]]] [test/add* '[1] '[do [list/merge-sort '[1]]]] [test/add* '[] '[do [list/merge-sort '[]]]] [test/add* '[-2 3 4 5 9 333 1000] '[do [list/merge-sort '[9 3 5 1000 333 4 -2]]]] [test/add* '[1.0 2.0 3.0] '[do [list/merge-sort '[3.0 1.0 2.0]]]] [test/add* '["a" "m" "z"] '[do [list/merge-sort '["m" "a" "z"]]]] [test/add* '["a" "m" "z"] '[do [list/merge-sort '["z" "m" "a"]]]] [test/add* '["a" "m" "z"] '[do [list/merge-sort '["a" "z" "m"]]]] [test/add* '["Z" "a" "m"] '[do [list/merge-sort '["a" "Z" "m"]]]] [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* #nil '[do [tree/list [tree/new #nil]]]] [test/add* #nil '[do [tree/keys [tree/new #nil]]]] [test/add* #nil '[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* #nil '[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]]"]]] [test/add* "asd" '[do [cat "a" #nil "s" "" "d"]]] [test/add* '[1 2 3] '[do [append '[1] '[2] '[3]]]] [test/add* '[1 2 . 3] '[do [append '[1] '[2] 3]]] [test/add* #t '[do [case 'asd [[asd] #f] [['asd] #t]]]] [test/add* #t '[do [case 'asd [[asd] #f] ['asd #t]]]] [test/add* #t '[do [case 'quote [['quote] #t] [otherwise #f]]]] [test/add* #t '[do [case 'quote ['quote #t] [otherwise #f]]]] [test/add* #t '[do [case 'otherwise [['otherwise] #t] [otherwise #f]]]] [test/add* #t '[do [case 'otherwise ['otherwise #t] [otherwise #f]]]] [test/add* #f '[do [== 0 'asd]]] [test/add* #f '[do [== 0 :asd]]] [test/add* #f '[do [== 0 "asd"]]] [test/add* #f '[do [== 0 #f]]] [test/add* #f '[do [== 0 #t]]] [test/add* #f '[do [== 0 0.1]]] [test/add* #f '[do [== 0 [array/new 0]]]] [test/add* #f '[do [== 0 [tree/new :asd 0]]]] [test/add* #f '[do [== 0.0 'asd]]] [test/add* #f '[do [== 0.0 :asd]]] [test/add* #f '[do [== 0.0 "asd"]]] [test/add* #f '[do [== 0.0 #f]]] [test/add* #f '[do [== 0.0 #t]]] [test/add* #f '[do [== 0.0 0.1]]] [test/add* #f '[do [== 0.0 [array/new 0]]]] [test/add* #f '[do [== 0.0 [tree/new :asd 0]]]] [test/add* '[1 2 3] '[do [[\ a a] 1 2 3]]] [test/add* 1 '[do [[\ [a . b] a] 1 2 3]]] [test/add* '[2 3] '[do [[\ [a . b] b] 1 2 3]]] [test/add* '[3] '[do [[\ [a b . c] c] 1 2 3]]] [test/add* 2 '[do [[\ [a b . c] b] 1 2 3]]] [test/add* 1 '[do [[\ [a b . c] a] 1 2 3]]] [test/add* #nil '[do [[\ [a b c . d] d] 1 2 3]]] [test/add* 3 '[do [[\ [a b c . d] c] 1 2 3]]] [test/add* 2 '[do [[\ [a b c . d] b] 1 2 3]]] [test/add* 1 '[do [[\ [a b c . d] a] 1 2 3]]] [test/add* 122 '[do [-> [tree/new :asd 123] [tree/-- :asd] [tree/get :asd]]]] [test/add* 124 '[do [-> [tree/new :asd 123] [tree/++ :asd] [tree/get :asd]]]] [test/add* 10 '[do [def m 5] [for [i 0 m] [++ m] [when [> m 50] [set! i 100]]] m]] [test/add* "#[1 2 3 4]" '[do [str/write [array/append [array/new 1 2] [array/new 3 4]]]]] [test/add* "#[1 2 3]" '[do [str/write [array/append [array/new 1 2] [array/new 3]]]]] [test/add* "#[1 2]" '[do [str/write [array/append [array/new 1 2] [array/new #nil]]]]] [test/add* :type-error '[do [try car [array/append [array/new 1] '[2]]]]] [test/add* :type-error '[do [try car [array/append '[1] #nil]]]] [test/add* :type-error '[do [try car [array/append [array/new 1]]]]] [test/add* :type-error '[do [try car [array/append '[1]]]]] [test/add* :type-error '[do [try car [array/append]]]] [test/add* "#[1 2 3]" '[do [str/write [let [[o [array/new 2 2 3]]] [array/set! o 0 1] [array/set! [array/dup o] 0 3] o]]]] [test/add* #t '[do [do [for [i 0 10] [set! i 20] [when [> i 30] [throw [list :error]]]] #t]]] [test/add* #f '[do [== [array/new 1] [array/new 1]]]] [test/add* #f '[do [== [array/new 1] [array/new 2]]]] [test/add* #t '[do [let [[a [array/new 1]]] [== a a]]]] [test/add* #f '[do [== [tree/new :a 1] [array/new :a 1]]]] [test/add* #f '[do [== [tree/new :a 1] [array/new :b 1]]]] [test/add* #t '[do [let [[a [tree/new :a 1]]] [== a a]]]] [test/add* #t '[do [-> [array/2d/allocate 4 4] [array/2d/set! 1 1 #t] [array/2d/ref 1 1]]]] [test/add* #t '[do [-> [array/2d/allocate 3 3] [array/2d/fill! #t] [array/2d/ref 1 1]]]] [test/add* "00620062" '[do [string/pad-start [int->string/HEX [hash/adler32 "a"]] 8 "0"]]] [test/add* "0F9D02BC" '[do [string/pad-start [int->string/HEX [hash/adler32 "asdQWE123"]] 8 "0"]]] [test/add* "796B110D" '[do [string/pad-start [int->string/HEX [hash/adler32 "DiesIstEinTestDerNujelAdler32Implementierung"]] 8 "0"]]] [test/add* '[2 3 4] '[do [-> '[1 2 3 4] [delete 1]]]] [test/add* "#[2 3 4]" '[do [str/write [-> [array/new 1 2 3 4] [delete 1]]]]] [test/add* "#$0" '[do [str/write [int->bytecode-op 0]]]] [test/add* "#$9" '[do [str/write [int->bytecode-op 9]]]] [test/add* "#$F" '[do [str/write [int->bytecode-op 15]]]] [test/add* "#$10" '[do [str/write [int->bytecode-op 16]]]] [test/add* "#$FF" '[do [str/write [int->bytecode-op 255]]]] [test/add* :invalid-bc-op '[do [try car [int->bytecode-op -129]]]] [test/add* :invalid-bc-op '[do [try car [int->bytecode-op 256]]]] [test/add* "#$0" '[do [str/write #$0]]] [test/add* "#$9" '[do [str/write #$9]]] [test/add* "#$F" '[do [str/write #$F]]] [test/add* "#$10" '[do [str/write #$10]]] [test/add* "#$FF" '[do [str/write #$FF]]] [test/add* :invalid-literal '[do [try car [read/single "#$1FF"]]]] [test/add* 0 '[do [bytecode-op->int #$0]]] [test/add* 9 '[do [bytecode-op->int #$9]]] [test/add* 15 '[do [bytecode-op->int #$F]]] [test/add* 16 '[do [bytecode-op->int #$10]]] [test/add* 255 '[do [bytecode-op->int #$FF]]] [test/add* :argument-mismatch '[do [try car [bytecode-op->int]]]] [test/add* :argument-mismatch '[do [try car [bytecode-op->int 12]]]] [test/add* :bytecode-op '[do [type-of #$10]]] [test/add* :bytecode-op '[do [type-of [int->bytecode-op 255]]]] [test/add* "#[#$0 #$9 #$F #$10 #$FF]" '[do [str/write [arr->bytecode-arr [array/new #$0 #$9 #$F #$10 #$FF]]]]] [test/add* :bytecode-array '[do [type-of [arr->bytecode-arr [array/new #$0 #$9 #$F #$10 #$FF]]]]] [test/add* #$0 '[do [array/ref [bytecode-arr->arr [arr->bytecode-arr [array/new #$0 #$9 #$F #$10 #$FF]]] 0]]] [test/add* 0 '[do [bytecode-eval [arr->bytecode-arr [array/new #$2 #$0 #$1]]]]] [test/add* 127 '[do [bytecode-eval [arr->bytecode-arr [array/new #$2 #$7F #$1]]]]] [test/add* -1 '[do [bytecode-eval [arr->bytecode-arr [array/new #$2 #$FF #$1]]]]] [test/add* -128 '[do [bytecode-eval [arr->bytecode-arr [array/new #$2 #$80 #$1]]]]] [test/add* 1 '[do [bytecode-eval [arr->bytecode-arr [array/new #$1]] 1 2 3 4]]] [test/add* 3 '[do [bytecode-eval [arr->bytecode-arr [array/new #$3 #$1]] 1 2]]] [test/add* 5 '[do [bytecode-eval [assemble [$push/int 3] [$push/int 2] [$add/int] [$ret]]]]] [test/add* 3 '[do [bytecode-eval [assemble [$push/int 3] [$ret]]]]] [test/add* 0 '[do [bytecode-eval [assemble [$push/int 0] [$ret]]]]] [test/add* -3 '[do [bytecode-eval [assemble [$push/int -3] [$ret]]]]] [test/add* -128 '[do [bytecode-eval [assemble [$push/int -128] [$nop] [$ret]]]]] [test/add* 127 '[do [bytecode-eval [assemble [$push/int 127] [$ret]]]]] [test/add* #t '[do [int? [val->index "asd"]]]] [test/add* "asd" '[do [index->val [val->index "asd"]]]] [test/add* '[123 asd] '[do [index->val [val->index '[123 asd]]]]] [test/add* '[123 asd] '[do [asmrun [$push/lval '[123 asd]] [$ret]]]] [test/add* 'test '[do [asmrun [$push/lval 'test] [$ret]]]] [test/add* 2 '[do [[asmrun [$push/lval [\ [a] [+ 1 a]]] [$ret]] 1]]] [test/add* '[test list] '[do [let [[code [assemble [$push/lval [list 'test 'list]] [$ret]]]] [bytecode-eval code]]]] [test/add* '[test list] '[do [let [[code [assemble [$push/lval [list 'test 'list]] [$ret]]]] [garbage-collect] [bytecode-eval code]]]] [test/add* '[1 2 3] '[do [asmrun [$push/int 1] [$push/int 2] [$push/int 3] [$make-list 3] [$ret]]]] [test/add* '[1] '[do [asmrun [$push/int 1] [$make-list 1] [$ret]]]] [test/add* '[] '[do [asmrun [$make-list 0] [$ret]]]] [test/add* 3 '[do [asmrun [$push/lval '[+ 1 2]] [$eval] [$ret]]]] [test/add* 5 '[do [asmrun [$push/int 2] [$push/int 3] [$apply 2 add/int] [$ret]]]] [test/add* 4 '[do [asmrun [$push/int 2] [$dup] [$apply 2 add/int] [$ret]]]] [test/add* 26 '[do [asmrun [$nop] [$push/int 26] [$jmp :asd] [$push/int 99] [:label :asd] [$ret]]]] [test/add* 26 '[do [asmrun [$nop] [$push/int 26] [$push/lval #t] [$jt :asd] [$push/int 99] [:label :asd] [$ret]]]] [test/add* 99 '[do [asmrun [$nop] [$push/int 26] [$push/lval #f] [$jt :asd] [$push/int 99] [:label :asd] [$ret]]]] [test/add* "#[1 2 3]" '[do [str/write [array/push [array/new 1 2 3]]]]] [test/add* "#[1 2 3 \"4\"]" '[do [str/write [array/push [array/new 1 2 3] "4"]]]] [test/add* "#[1 2 3 4 #f]" '[do [str/write [array/push [array/new 1 2 3] 4 #f]]]] [test/add* "#[1 2 3 #nil 5]" '[do [str/write [array/push [array/new 1 2 3] #nil 5]]]] [test/add* '[1 2 3 4 5] '[do [flatten [array/new 1 2 3 4 5]]]] [test/add* '[1 2 3 4 5] '[do [flatten '[1 2 3 4 5]]]] [test/add* '[1 2 3 4 5] '[do [flatten '[[1 2] [3] [[[4] 5]]]]]] [test/add* '[1 2 3 4 5] '[do [flatten [list '[1 2] [array/new 3] [array/new '[[4] 5]]]]]] [test/add* #t '[do [int? [sym->index 'asd]]]] [test/add* 'asd '[do [index->sym [sym->index 'asd]]]] [test/add* 5 '[do [[asmrun [$lambda 'test-add '[a b] "Add a and b together" '[+ a b]] [$ret]] 2 3]]] [test/add* 13 '[do [byterun '[+ 6 7]]]] [test/add* 15 '[do [byterun '[+ 3 [+ 6 [- 7 1]]]]]] [test/add* 55 '[do [+ 1 [+ 2 [+ 3 [+ 4 [+ 5 [+ 6 [+ 7 [+ 8 [+ 9 10]]]]]]]]]]] [test/add* 55 '[do [byterun '[+ 1 [+ 2 [+ 3 [+ 4 [+ 5 [+ 6 [+ 7 [+ 8 [+ 9 10]]]]]]]]]]]] [test/add* "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz" '[do [cat "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z"]]] [test/add* "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz" '[do [byterun '[cat "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z"]]]] [test/add* 6 '[do [- 7 1]]] [test/add* 6 '[do [byterun '[- 7 1]]]] [test/add* 1 '[do [byterun '[if #t 1 2]]]] [test/add* 2 '[do [byterun '[if #f 1 2]]]] [test/add* 1000 '[do [byterun '[do 1000]]]] [test/add* π '[do [byterun '[do π]]]] [test/add* π '[do [asmrun [$get 'π] [$ret]]]] [test/add* 2 '[do [asmrun [$push/int 1] [$def 'tmp] [$let] [$push/int 2] [$def 'tmp] [$get 'tmp] [$ret]]]] [test/add* 1 '[do [asmrun [$push/int 1] [$def 'tmp] [$let] [$push/int 2] [$def 'tmp] [$closure/pop] [$get 'tmp] [$ret]]]] [test/add* 3 '[do [[asmrun [$push/int 1] [$def 'tmp] [$let] [$push/int 3] [$def 'tmp] [$lambda two '[] "" '[do tmp]] [$closure/pop] [$ret]]]]] [test/add* 128 '[do [eval-compile '[+123 5] [current-closure]]]] [test/add* 5 '[do [def a 4] [for [i 0 10] [once [++ a]]] a]] [test/add* :asd '[do [try [\ [a] [car a]] [asmrun [$push/lval '[:asd "Test"]] [$throw]]]]] [test/add* :asd '[do [car [asmrun [$jmp :start] [:label :handle] [$ret] [:label :start] [$try :handle] [$let] [$push/lval '[:asd "Test"]] [$throw]]]]] [test/add* "Test" '[do [cadr [asmrun [$jmp :start] [:label :handle] [$ret] [:label :start] [$try :handle] [$let] [$push/lval '[:asd "Test"]] [$throw]]]]] [test/add* '[:asd "Test"] '[do [try [\ [a] :shouldnt-have-caught-that] [asmrun [$jmp :start] [:label :handle] [$ret] [:label :start] [$try :handle] [$let] [$push/lval '[:asd "Test"]] [$throw]]]]] [test/add* '[:asd "Test"] '[do [list :asd "Test"]]] [test/add* :asd '[do [car [asmrun [$nop] [$nop] [$try :handle] [$let] [$push/lval '[:asd "Test"]] [$throw] [$nop] [$push/lval :error] [:label :handle] [$ret]]]]] [test/add* 3 '[do [asmrun [$jmp :start] [:label :ret] [$push/int 3] [$ret] [:label :start] [$push/int 2] [$jmp :ret] [$ret]]]] [test/add* 5 '[do [asmrun [$jmp :start] [:label :func] [$push/int 2] [$add/int] [$ret] [:label :start] [$push/int 3] [$call :func] [$ret]]]] [test/add* 5 '[do [asmrun [$jmp :start] [:label :func] [$push/int 2] [$add/int] [$ret] [:label :start] [$push/int 3] [$jmp :func]]]] [test/add* 10 '[do [let [[t 0]] [for-in [l [list 1 2 3 4]] [+= t l]] t]]] [test/add* 1 '[do [let [[t 0]] [for-in [l [list 1]] [+= t l]] t]]] [test/add* 0 '[do [let [[t 0]] [for-in [l [list]] [+= t l]] t]]] [test/add* #t '[do [keyword? :asd]]] [test/add* #t '[do [keyword? [str->sym ":asd"]]]] [test/add* #f '[do [keyword? 'asd]]] [test/add* #f '[do [keyword? [str->sym "asd"]]]] [test/add* #f '[do [keyword? 123]]] [test/add* #t '[do [symbol? [apply gensym]]]] [test/add* 1 '[do [apply car '[[1 . 2]]]]] [test/add* 1 '[do [apply car '[[1 2]]]]] [test/add* 2 '[do [apply cdr '[[1 . 2]]]]] [test/add* '[2] '[do [apply cdr '[[1 2]]]]] [test/add* 1 '[do [byterun '[car [cons 1 2]]]]] [test/add* '[1 . 2] '[do [asmrun [$push/int 1] [$push/int 2] [$apply 2 cons] [$ret]]]] [test/add* 1 '[do [asmrun [$push/int 1] [$push/int 2] [$apply 2 cons] [$apply 1 car] [$ret]]]] [test/add* 1 '[do [bytecode-eval [apply assemble [list [$push/int 1] [$push/int 2] [$apply 2 cons] [$apply 1 car] [$ret]]]]]] [test/add* 37 '[do [asmrun [$push/int 12] [$push/int 25] [$push/lval +] [$apply/dynamic 2] [$ret]]]] [test/add* 22 '[do [[resolve [str->sym "+"]] 10 12]]] [test/add* 22 '[do [byterun '[[resolve [str->sym "+"]] 10 12]]]] [test/add* 22 '[do [byterun '[[[tree/new :asd + :qwe -] :asd] 10 12]]]] [test/add* 1 '[do [byterun '[car '[1 2]]]]] [test/add* 1 '[do [length '[1]]]] [test/add* 2 '[do [length '[1 #nil]]]] [test/add* 3 '[do [length '[1 #nil 2]]]] [test/add* 3 '[do [length '[1 1 2]]]] [test/add* 4 '[do [length '[1 1 2 #nil]]]] [test/add* 4 '[do [length '[1 #nil 2 #nil]]]] [test/add* 4 '[do [length '[#nil #nil 2 #nil]]]] [test/add* 4 '[do [length '[#nil #nil #nil #nil]]]] [test/add* 5 '[do [length '[#nil #nil #nil #nil 5]]]] [test/add* #nil '[do [tree/values]]] [test/add* #nil '[do [tree/keys #nil]]] [test/add* #nil '[do [tree/has? #nil]]] [test/add* #nil '[do [tree/has?]]] [test/add* 5 '[do [eval [read/single "[+ 2 3]"]]]] [test/add* 5 '[do [eval [read/single "[+ 2 ; 5\n 3]"]]]] [test/add* 5 '[do [eval [read/single "[+ 2 #! 5\n 3]"]]]] [test/add* '[1 3] '[do [read/single "[1 #| 2 |# 3]"]]] [test/add* 5 '[do [eval [read/single "[+ 2 #| 5 |# 3]"]]]] [test/add* #t '[do [do [event-fire [tree/new #nil]] #t]]] [test/add* #t '[do [let [[ret #f]] [event-fire [tree/new :asd [λ [] [set! ret #t]]]] ret]]] [test/add* #t '[do [let [[ret #t]] [for-in [l #nil] [set! ret #f]] ret]]] [test/add* #f '[do [let [[ret #t]] [for-in [l '[]] [set! ret #f]] ret]]] [test/add* "asd" '[do [fmt "asd"]]] [test/add* "asd" '[do [compile '[fmt "asd"]]]] [test/add* "123" '[do [eval [compile '[fmt "{}" 123]]]]] [test/add* "asd qwe" '[do [eval [compile '[fmt "asd {}" "qwe"]]]]] [test/add* "asd 123" '[do [eval [compile '[fmt "asd {}" 123]]]]] [test/add* "asd 123 qwe" '[do [eval [compile '[fmt "asd {} qwe" 123]]]]] [test/add* "asd a qwe a" '[do [eval [compile '[fmt "asd {0} qwe {0}" "a"]]]]] [test/add* "asd a qwe b" '[do [eval [compile '[fmt "asd {0} qwe {1}" "a" "b"]]]]] [test/add* "asd a qwe b" '[do [eval [compile '[fmt "asd {} qwe {}" "a" "b"]]]]] [test/add* "asd a qwe b" '[do [eval [compile '[fmt "asd {0} qwe {}" "a" "b"]]]]] [test/add* :format-error '[do [try car [compile '[fmt "asd {} qwe {1}" "a" "b"]]]]] [test/add* "1 2 2" '[do [eval [compile '[fmt "{} {1} {}" 1 2]]]]] [test/add* :format-error '[do [try car [compile '[fmt "{0} {0} {}" 1 2 3]]]]] [test/add* "1 1 1" '[do [eval [compile '[fmt "{0} {0} {}" 1]]]]] [test/add* "asd qwe" '[do [eval [compile '[fmt "asd {0}" "qwe"]]]]] [test/add* :format-error '[do [try car [eval [compile '[fmt "asd {1}" "qwe"]]]]]] [test/add* "Hello, World!" '[do [eval [compile '[let [[w "World"]] [fmt "Hello, {w}!"]]]]]] [test/add* :type-error '[do [try car [compile '[fmt]]]]] [test/add* 1 '[do [string/length [eval [compile '[fmt "{:}" "\n"]]]]]] [test/add* 4 '[do [string/length [eval [compile '[fmt "{:?}" "\n"]]]]]] [test/add* "ff" '[do [eval [compile '[fmt "{:x}" 255]]]]] [test/add* "#xff" '[do [eval [compile '[fmt "{:x?}" 255]]]]] [test/add* "#xFF" '[do [eval [compile '[fmt "{:X?}" 255]]]]] [test/add* "1F" '[do [eval [compile '[fmt "{:X}" 31]]]]] [test/add* "#d31" '[do [eval [compile '[fmt "{:d?}" 31]]]]] [test/add* "31" '[do [eval [compile '[fmt "{:d}" 31]]]]] [test/add* "37" '[do [eval [compile '[fmt "{:o}" 31]]]]] [test/add* "#o37" '[do [eval [compile '[fmt "{:o?}" 31]]]]] [test/add* "#b10011" '[do [eval [compile '[fmt "{:b?}" 19]]]]] [test/add* "10011" '[do [eval [compile '[fmt "{:b}" 19]]]]] [test/add* " 10011" '[do [eval [compile '[fmt "{:8b}" 19]]]]] [test/add* "00010011" '[do [eval [compile '[fmt "{:08b}" 19]]]]] [test/add* "#b010011" '[do [eval [compile '[fmt "{:08b?}" 19]]]]] [test/add* "#b11" '[do [eval [compile '[fmt "{:04b?}" 19]]]]] [test/add* " 13" '[do [eval [compile '[fmt "{:4x}" 19]]]]] [test/add* "0013" '[do [eval [compile '[fmt "{:04x}" 19]]]]] [test/add* "#x0013" '[do [eval [compile '[fmt "{:06x?}" 19]]]]] [test/add* "#x 13" '[do [eval [compile '[fmt "{:6x?}" 19]]]]] [test/add* " asd" '[do [eval [compile '[fmt "{:6}" "asd"]]]]] [test/add* "000asd" '[do [eval [compile '[fmt "{:06}" "asd"]]]]] [test/add* :format-error '[do [try car [compile '[fmt "abc {{}}" "def"]]]]] [test/add* :format-error '[do [try car [compile '[fmt "abc {" "def}"]]]]] [test/add* :format-error '[do [try car [compile '[fmt "" "abc"]]]]] [test/add* :type-error '[do [try car [string/pad-start 123 4 48]]]] [test/add* :type-error '[do [try car [string/pad-start "123" 4 48]]]] [test/add* :type-error '[do [try car [string/pad-end 123 4 48]]]] [test/add* " 123" '[do [string/pad-start 123 4]]] [test/add* "0123" '[do [string/pad-start 123 4 "0"]]] [test/add* " 123" '[do [string/pad-start "123" 4]]] [test/add* "123 " '[do [string/pad-end 123 4]]] [test/add* "1230" '[do [string/pad-end 123 4 "0"]]] [test/add* "123 " '[do [string/pad-end "123" 4]]] [test/add* :type-error '[do [try car [str->sym 4]]]] [test/add* "4" '[do [sym->str [str->sym "4"]]]] [test/add* #t '[do [== [str->sym "3"] [str->sym "3"]]]] [test/add* #f '[do [== [str->sym "3"] [str->sym "2"]]]] [test/add* :type-error '[do [try car [sym->str 4]]]] [test/add* :type-error '[do [try car [sym->str "asd"]]]] [test/add* "asd" '[do [sym->str 'asd]]] [test/add* :type-error '[do [try car [char-at]]]] [test/add* :bounds-error '[do [try car [char-at "" -1]]]] [test/add* :bounds-error '[do [try car [char-at "" 1]]]] [test/add* :bounds-error '[do [try car [char-at "" :asd]]]] [test/add* #t '[do [case 3 [otherwise #t] [2 #f]]]] [def oneTwoThreeTest [+ 123 5]] [def +123 [μ* +123 [v] "" [cons '+ [cons 123 [cons v #nil]]]]]][optimize-all!]
