Ben/Nujel - bootstrap/stdlib.no

Ben (X13/Arch) BC optimization 4838447 3 years ago 790 Commits
Raw
application/octet-stream • 194.00 KB • 1553 lines
#{##[bit-nand l #@[documentation: "Returns the Nand of its arguments" source: ["Returns the Nand of its arguments" [bit-not [apply bit-and l]]]] #{##[bit-not apply bit-and l]
0E000E010E020E030402040101
} bit-and-not [x y] #@[documentation: "Bitwise and with complement" source: ["Bitwise and with complement" [bit-and x [bit-not y]]]] #{##[bit-and x bit-not y]
0E000E010E020E030401040201
} bit-test? [α i] #@[documentation: "Test bit at position i" source: ["Test bit at position i" [typecheck/only α :int] [typecheck/only i :int] [not [zero? [bit-and α [bit-shift-left 1 i]]]]]] #{##[type-of α :int throw list :type-error "Expected a value of type :int" current-lambda i bit-and bit-shift-left]
0E000E0104011A02200B0007240900150E030E041A051A060E010E0704000404
04010D0E000E0804011A02200B0007240900150E030E041A051A060E080E0704
00040404010D0E090E010E0A02010E08040204022A0B00071C0900041B01
} bit-set? bit-shift-right [α i] #@[documentation: "Bitwise shift right" source: ["Bitwise shift right" [bit-shift-left α [- i]]]] #{##[bit-shift-left α - i]
0E000E010E020E030401040201
} bit-set [x i] #@[documentation: "Set bit at i" source: ["Set bit at i" [bit-or x [bit-shift-left 1 i]]]] #{##[bit-or x bit-shift-left i]
0E000E010E0202010E030402040201
} bit-flip [x i] #@[documentation: "Flip bit at i" source: ["Flip bit at i" [bit-xor x [bit-shift-left 1 i]]]] #{##[bit-xor x bit-shift-left i]
0E000E010E0202010E030402040201
} bit-clear [x i] #@[documentation: "Clear bit at i" source: ["Clear bit at i" [bit-and x [bit-not [bit-shift-left 1 i]]]]] #{##[bit-and x bit-not bit-shift-left i]
0E000E010E020E0302010E0404020401040201
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D0E081A0C070D1A0D1A0E1A0F1A10171A0D070D1A111A121A13
1A14171A11070D1A151A161A171A18171A15070D1A191A1A1A1B1A1C171A1907
01
}#{##[array/+= [a i v] #@[documentation: "Add V to the value in A at position I and store the result in A returning A" source: ["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]]]]] #{##[array/set! a i v array/ref]
0E000E010E020E030E040E010E02040225040301
} array/++ [a i] #@[documentation: "Increment position I in A and return A" source: ["Increment position I in A and return A" [array/+= a i 1]]] #{##[array/+= a i]
0E000E010E020201040301
} array/fill! [a v] #@[documentation: "Fills array a with value v" source: ["Fills array a with value v" [def len [array/length a]] [dotimes [i len] [array/set! a i v]] [return a]]] #{##[array/length a len i array/set! v]
0E000E0104011A02070D1502001A03070D240900170D0E040E010E030E050403
0D02010E03031A03080E030E021E0AFFE70D24160D0E010101
} array/append [a b] #@[documentation: "Append array A to array B" source: ["Append array A to array B" [when-not [and [array? a] [array? b]] [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]]]] [dotimes [i [array/length a]] [array/set! ret i [array/ref a i]]] [let [[i [array/length a]] [rl [array/length ret]]] [while [< i rl] [array/set! ret i [array/ref b [- i [array/length a]]]] [set! i [add/int i 1]]]] [return ret]]] #{##[array? a b throw list :type-error "array/append expects two arrays as its arguments" current-lambda array/allocate array/length ret i array/set! array/ref rl]
0E000E0104010C0B000A0D0E000E0204010B0007240900140E030E041A051A06
240E070400040404010D0E080E090E0104010E090E0204012504011A0A070D15
02001A0B070D2409001D0D0E0C0E0A0E0B0E0D0E010E0B040204030D02010E0B
031A0B080E0B0E090E0104011E0AFFDD0D24160D150E090E0104011A0B070D0E
090E0A04011A0E070D240900240D0E0C0E0A0E0B0E0D0E020E0B0E090E010401
26040204030D0E0B0201031A0B080E0B0E0E1E0AFFDA160D0E0A0101
} array/dup [a] #@[documentation: "Duplicate Array A" source: ["Duplicate Array A" [def ret [array/allocate [array/length a]]] [dotimes [i [array/length a]] [array/set! ret i [array/ref a i]]] [return ret]]] #{##[array/allocate array/length a ret i array/set! array/ref]
0E000E010E02040104011A03070D1502001A04070D2409001D0D0E050E030E04
0E060E020E04040204030D02010E04031A04080E040E010E0204011E0AFFDD0D
24160D0E030101
} array/reduce [arr fun α] #@[documentation: "Reduce an array, [reduce] should be preferred" source: ["Reduce an array, [reduce] should be preferred" [def len [array/length arr]] [dotimes [i len] [set! α [fun α [array/ref arr i]]]] [return α]]] #{##[array/length arr len i fun α array/ref]
0E000E0104011A02070D1502001A03070D2409001E0D0E040E050E060E010E03
040204021A05080D02010E03031A03080E030E021E0AFFE00D24160D0E050101
} array/map [arr fun] #@[documentation: "Map an array, [map] should be preferred" source: ["Map an array, [map] should be preferred" [def len [array/length arr]] [dotimes [i len] [array/set! arr i [fun [array/ref arr i]]]] [return arr]]] #{##[array/length arr len i array/set! fun array/ref]
0E000E0104011A02070D1502001A03070D240900210D0E040E010E030E050E06
0E010E030402040104030D02010E03031A03080E030E021E0AFFDD0D24160D0E
010101
} array/filter [arr pred] #@[documentation: "Filter an array, [filter] should be preferred" source: ["Filter an array, [filter] should be preferred" [def ri 0] [def len [array/length arr]] [def ret [array/allocate len]] [dotimes [ai len] [when [pred [array/ref arr ai]] [array/set! ret ri [array/ref arr ai]] [inc! ri]]] [array/length! ret ri]]] #{##[ri array/length arr len array/allocate ret ai pred array/ref array/set! array/length!]
02001A00070D0E010E0204011A03070D0E040E0304011A05070D1502001A0607
0D240900390D0E070E080E020E06040204010B001F0E090E050E000E080E020E
06040204030D0E000201251A0008090004240D02010E06031A06080E060E031E
0AFFC50D24160D0E0A0E050E00040201
} array/equal? [a b] #@[source: [[if [or [not [array? a]] [not [array? b]] [not= [array/length a] [array/length b]]] [return #f] [let [[ret #t]] [dotimes [i [array/length a]] [when-not [equal? [array/ref a i] [array/ref b i]] [set! ret #f] [set! i [array/length a]]]] [return ret]]]]] #{##[array? a b not= array/length #f ret i equal? array/ref]
0E000E0104010B00071C0900041B0C0A002E0D0E000E0204010B00071C090004
1B0C0A001B0D0E030E040E0104010E040E02040104020C0A00060D1A050B0008
1C0109005B151B1A06070D1502001A07070D240900360D0E080E090E010E0704
020E090E020E07040204020B0007240900111C1A06080D0E040E0104011A0708
0D02010E07031A07080E070E040E0104011E0AFFC40D24160D0E06011601
} array/push [arr val] #@[documentation: "Append VAL to ARR" source: ["Append VAL to ARR" [-> arr [array/length! [+ 1 [array/length arr]]] [array/set! [- [array/length arr] 1] val]]]] #{##[array/set! array/length! arr array/length val]
0E000E010E0202010E030E0204012504020E030E0204010201260E04040301
} array/swap [arr i j] #@[documentation: "Swap values at I and J in ARR" source: ["Swap values at I and J in ARR" [def tmp [array/ref arr i]] [-> arr [array/set! i [array/ref arr j]] [array/set! j tmp]]]] #{##[array/ref arr i tmp array/set! j]
0E000E010E0204021A03070D0E040E040E010E020E000E010E05040204030E05
0E03040301
} array/heapify [arr n at] #@[documentation: "bubble up the element from index AT to until the max-heap property is satisfied" source: ["bubble up the element from index AT to until the max-heap property is satisfied" [def top at] [def looping #t] [while looping [def l [+ [bit-shift-left at 1] 1]] [def r [+ [bit-shift-left at 1] 2]] [when [and [< l n] [> [array/ref arr l] [array/ref arr top]]] [set! top l]] [when [and [< r n] [> [array/ref arr r] [array/ref arr top]]] [set! top r]] [if [= top at] [set! looping #f] [do [array/swap arr at top] [set! at top]]]] [return arr]]] #{##[at top looping bit-shift-left l r n array/ref arr array/swap]
0E001A01070D1B1A02070D240900910D0E030E00020104020201251A04070D0E
030E00020104020202251A05070D0E040E061E0C0B00150D0E070E080E040402
0E070E080E010402220B000B0E041A0108090004240D0E050E061E0C0B00150D
0E070E080E0504020E070E080E010402220B000B0E051A0108090004240D0E01
0E00200B000A1C1A02080900130E090E080E000E0104030D0E011A00080E020A
FF700D0E080101
} array/make-heap [arr] #@[source: [[def l [array/length arr]] [def l2 [/ l 2]] [while [>= l2 0] [array/heapify arr l l2] [dec! l2]] [return arr]]] #{##[array/length arr l l2 array/heapify]
0E000E0104011A02070D0E020202281A03070D240900170D0E040E010E020E03
04030D0E030201261A03080E030200210AFFE70D0E010101
} array/heap-sort [arr] #@[source: [[array/make-heap arr] [def l [array/length arr]] [while [> l 0] [dec! l] [array/swap arr 0 l] [array/heapify arr l 0]] [return arr]]] #{##[array/make-heap arr array/length l array/swap array/heapify]
0E000E0104010D0E020E0104011A03070D240900220D0E030201261A03080D0E
040E0102000E0304030D0E050E010E03020004030E030200220AFFDC0D0E0101
01
} array/sort array/cut [arr start end] #@[documentation: "Return a newly allocated array with the values of ARR from START to END" source: ["Return a newly allocated array with the values of ARR from START to END" [set! start [max 0 start]] [set! end [min [array/length arr] end]] [def ret [array/allocate [max 0 [- end start]]]] [def i start] [while [< i end] [array/set! ret [- i start] [array/ref arr i]] [set! i [add/int i 1]]] [return ret]]] #{##[max start min array/length arr end array/allocate ret i array/set! array/ref]
0E0002000E0104021A01080D0E020E030E0404010E0504021A05080D0E060E00
02000E050E0126040204011A07070D0E011A08070D240900200D0E090E070E08
0E01260E0A0E040E08040204030D0E080201031A08080E080E051E0AFFDE0D0E
070101
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B171A28070D1A2C1A2D1A2E1A2F171A2C070D1A301A31
1A321A33171A30070D1A341A351A361A37171A34070D0E341A38070D1A391A3A
1A3B1A3C171A390701
}#{##[sum [c] #@[documentation: "Return the sum of every value in collection C" source: ["Return the sum of every value in collection C" [reduce c + 0]]] #{##[reduce c +]
0E000E010E020200040301
} every? [l p] #@[documentation: "Returns #t if P is true for every entry of collection L" source: ["Returns #t if P is true for every entry of collection L" [reduce l [fn [a b] [and a [p b]]] #t]]] #{##[reduce l anonymous [a b] #@[source: [[and a [p b]]]] #{##[a p b]
0E000C0B000A0D0E010E02040101
}]
0E000E011A021A031A041A05171B040301
} join [l glue] #@[documentation: "Join every element of α together into a string with GLUE inbetween" source: ["Join every element of α together into a string with GLUE inbetween" [when-not glue [set! glue ""]] [if-not l "" [reduce l [fn [a b] [if a [cat a glue b] b]] #nil]]]] #{##[glue "" l reduce anonymous [a b] #@[source: [[if a [cat a glue b] b]]] #{##[a cat glue b]
0E000B00100E010E000E020E0304030900050E0301
}]
0E000B0007240900081A011A00080D0E020B00160E030E021A041A051A061A07
172404030900051A0101
} for-each [l f] #@[documentation: "Runs F over every item in collection L" source: ["Runs F over every item in collection L" [reduce l [fn [a b] [f b]] #nil]]] #{##[reduce l anonymous [a b] #@[source: [[f b]]] #{##[f b]
0E000E01040101
}]
0E000E011A021A031A041A051724040301
} count [l p] #@[documentation: "Count the number of items in L where P is true" source: ["Count the number of items in L where P is true" [if p [reduce l [fn [a b] [+ a [if [p b] 1 0]]] 0] [reduce l [fn [a b] [+ a 1]] 0]]]] #{##[p reduce l anonymous [a b] #@[source: [[+ a [if [p b] 1 0]]]] #{##[a p b]
0E000E010E0204010B0008020109000502002501
} [a b] #@[source: [[+ a 1]]] #{##[a]
0E0002012501
}]
0E000B00170E010E021A031A041A051A0617020004030900140E010E021A031A
071A081A09170200040301
} min l #@[documentation: "Returns the minimum value of its arguments" source: ["Returns the minimum value of its arguments" [reduce l [fn [a b] [if [< a b] a b]]]]] #{##[reduce l anonymous [a b] #@[source: [[if [< a b] a b]]] #{##[a b]
0E000E011E0B00080E000900050E0101
}]
0E000E011A021A031A041A0517040201
} max #@[documentation: "Returns the maximum value of its arguments" source: ["Returns the maximum value of its arguments" [reduce l [fn [a b] [if [> a b] a b]]]]] #{##[reduce l anonymous [a b] #@[source: [[if [> a b] a b]]] #{##[a b]
0E000E01220B00080E000900050E0101
}]
0E000E011A021A031A041A0517040201
} delete [l e] #@[documentation: "Returns a filtered list l with all elements equal to e omitted" source: ["Returns a filtered list l with all elements equal to e omitted" [filter l [fn [a] [not [= a e]]]]]] #{##[filter l anonymous [a] #@[source: [[not [= a e]]]] #{##[a e]
0E000E01200B00071C0900041B01
}]
0E000E011A021A031A041A0517040201
} remove [l p] #@[documentation: "Returns a filtered list l with all elements where P equal true removed" source: ["Returns a filtered list l with all elements where P equal true removed" [filter l [fn [a] [not [p a]]]]]] #{##[filter l anonymous [a] #@[source: [[not [p a]]]] #{##[p a]
0E000E0104010B00071C0900041B01
}]
0E000E011A021A031A041A0517040201
} flatten/λ [a b] #@[source: [[cond [[collection? b] [append [reduce b flatten/λ #nil] a]] [#t [cons b a]]]]] #{##[collection? b append reduce flatten/λ a]
0E000E0104010B00150E020E030E010E042404030E0504020900101B0B000B0E
010E05140900042401
} flatten [l] #@[documentation: "Flatten a collection of collections into a simple list" source: ["Flatten a collection of collections into a simple list" [if-not [collection? l] l [nreverse [reduce l flatten/λ #nil]]]]] #{##[collection? l nreverse reduce flatten/λ]
0E000E0104010B00130E020E030E010E0424040304010900050E0101
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A151A191A1A171A18070D1A1B1A1C1A
1D1A1E171A1B070D1A1F1A201A211A22171A1F070D1A231A241A251A26171A23
070D1A271A281A291A2A171A270701
}#{##[ref [l i] #@[documentation: "Return whatver is at position I in L" source: ["Return whatver is at position I in L" [case [type-of l] [:nil #nil] [:tree [tree/ref l i]] [:string [char-at l i]] [:array [array/ref l i]] [:pair [list/ref l i]] [otherwise [throw [list :type-error "You can only ref a collection" l [current-lambda]]]]]]] #{##[type-of l ΓεnΣym-1 :nil :tree tree/ref i :string char-at :array array/ref :pair list/ref throw list :type-error "You can only ref a collection" current-lambda]
150E000E0104011A02070D0E021A03200B0007240900610E021A04200B000E0E
050E010E06040209004E0E021A07200B000E0E080E010E06040209003B0E021A
09200B000E0E0A0E010E0604020900280E021A0B200B000E0E0C0E010E060402
0900150E0D0E0E1A0F1A100E010E110400040404011601
} filter [l p] #@[documentation: "Runs predicate p over every item in collection l and returns a list consiting solely of items where p is true" source: ["Runs predicate p over every item in collection l and returns a list consiting solely of items where p is true" [case [type-of l] [:nil #nil] [:tree [tree/filter l p]] [:pair [list/filter l p]] [:array [array/filter l p]] [otherwise [throw [list :type-error "You can only filter collections" l [current-lambda]]]]]]] #{##[type-of l ΓεnΣym-2 :nil :tree tree/filter p :pair list/filter :array array/filter throw list :type-error "You can only filter collections" current-lambda]
150E000E0104011A02070D0E021A03200B00072409004E0E021A04200B000E0E
050E010E06040209003B0E021A07200B000E0E080E010E0604020900280E021A
09200B000E0E0A0E010E0604020900150E0B0E0C1A0D1A0E0E010E0F04000404
04011601
} reduce [l f α] #@[documentation: "Combine all elements in collection l using operation F and starting value α" source: ["Combine all elements in collection l using operation F and starting value α" [case [type-of l] [:nil α] [:tree [tree/reduce l f α]] [:pair [list/reduce l f α]] [:array [array/reduce l f α]] [otherwise [throw [list :type-error "You can only reduce collections" l [current-lambda]]]]]]] #{##[type-of l ΓεnΣym-3 :nil α :tree tree/reduce f :pair list/reduce :array array/reduce throw list :type-error "You can only reduce collections" current-lambda]
150E000E0104011A02070D0E021A03200B00080E040900540E021A05200B0010
0E060E010E070E04040309003F0E021A08200B00100E090E010E070E04040309
002A0E021A0A200B00100E0B0E010E070E0404030900150E0C0E0D1A0E1A0F0E
010E100400040404011601
} length [α] #@[documentation: "Returns the length of collection α" source: ["Returns the length of collection α" [case [type-of α] [:nil 0] [:array [array/length α]] [:pair [list/length α]] [:string [string/length α]] [:tree [tree/size α]] [otherwise [throw [list :type-error "You can only use length with a collection" α [current-lambda]]]]]]] #{##[type-of α ΓεnΣym-4 :nil :array array/length :pair list/length :string string/length :tree tree/size throw list :type-error "You can only use length with a collection" current-lambda]
150E000E0104011A02070D0E021A03200B000802000900590E021A04200B000C
0E050E0104010900480E021A06200B000C0E070E0104010900370E021A08200B
000C0E090E0104010900260E021A0A200B000C0E0B0E0104010900150E0C0E0D
1A0E1A0F0E010E100400040404011601
} map [l f] #@[documentation: "Runs f over every item in collection l and returns the resulting list" source: ["Runs f over every item in collection l and returns the resulting list" [case [type-of l] [:nil #nil] [:pair [list/map l f]] [:array [array/map l f]] [otherwise [throw [list :type-error "You can only use map with a collection" l [current-lambda]]]]]]] #{##[type-of l ΓεnΣym-5 :nil :pair list/map f :array array/map throw list :type-error "You can only use map with a collection" current-lambda]
150E000E0104011A02070D0E021A03200B00072409003B0E021A04200B000E0E
050E010E0604020900280E021A07200B000E0E080E010E0604020900150E090E
0A1A0B1A0C0E010E0D0400040404011601
} sort [l] #@[documentation: "Sorts the collection L" source: ["Sorts the collection L" [case [type-of l] [:nil #nil] [:pair [list/sort l]] [:array [array/sort l]] [otherwise [throw [list :type-error "You can only use sort with a collection" l [current-lambda]]]]]]] #{##[type-of l ΓεnΣym-6 :nil :pair list/sort :array array/sort throw list :type-error "You can only use sort with a collection" current-lambda]
150E000E0104011A02070D0E021A03200B0007240900370E021A04200B000C0E
050E0104010900260E021A06200B000C0E070E0104010900150E080E091A0A1A
0B0E010E0C0400040404011601
} member [l m] #@[documentation: "Returns the first pair/item of collection l whose car is equal to m" source: ["Returns the first pair/item of collection l whose car is equal to m" [case [type-of l] [:pair [list/member l m]] [otherwise [throw [list :type-error "You can only use member with a collection" l [current-lambda]]]]]]] #{##[type-of l ΓεnΣym-7 :pair list/member m throw list :type-error "You can only use member with a collection" current-lambda]
150E000E0104011A02070D0E021A03200B000E0E040E010E0504020900150E06
0E071A081A090E010E0A0400040404011601
} cut [l start end] #@[documentation: "Return a subcollection of L from START to END" source: ["Return a subcollection of L from START to END" [case [type-of l] [:array [array/cut l start end]] [:pair [list/cut l start end]] [:string [string/cut l start end]] [otherwise [throw [list :type-error "You can only use member with a collection" l [current-lambda]]]]]]] #{##[type-of l ΓεnΣym-8 :array array/cut start end :pair list/cut :string string/cut throw list :type-error "You can only use member with a collection" current-lambda]
150E000E0104011A02070D0E021A03200B00100E040E010E050E06040309003F
0E021A07200B00100E080E010E050E06040309002A0E021A09200B00100E0A0E
010E050E0604030900150E0B0E0C1A0D1A0E0E010E0F0400040404011601
} collection? [l] #@[source: [[case [type-of l] [[:pair :array :tree] #t] [otherwise #f]]]] #{##[type-of l ΓεnΣym-9 :pair :array :tree #f]
150E000E0104011A02070D0E021A03200C0A001A0D0E021A04200C0A00100D0E
021A05200C0A00060D1A060B00071B0900041C1601
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A200701
}#{##[cons! [v l] #@[documentation: "Cons V onto L and set! the value for L" source: ["Cons V onto L and set! the value for L" [quasiquote [set! [unquote l] [cons [unquote v] [unquote l]]]]]] #{##[set! l cons v]
1A000E011A020E030E01241414142414141401
} array->list [arr] #@[source: [[def i [- [array/length arr] 1]] [def ret #nil] [while [>= i 0] [set! ret [cons [array/ref arr i] ret]] [dec! i]] [return ret]]] #{##[array/length arr i ret array/ref]
0E000E0104010201261A02070D241A03070D2409001B0D0E040E010E0204020E
03141A03080D0E020201261A02080E020200210AFFE30D0E030101
} except-last-pair/iter [list rest] #@[documentation: "Iterator for except-last-pair" source: ["Iterator for except-last-pair" [if [nil? [cdr list]] [reverse rest] [except-last-pair/iter [cdr list] [cons [car list] rest]]]]] #{##[nil? list reverse rest except-last-pair/iter]
0E000E011204010B000C0E020E0304010900100E040E01120E01110E03140402
01
} except-last-pair [list] #@[documentation: "Return a copy of LIST without the last pair" source: ["Return a copy of LIST without the last pair" [except-last-pair/iter list #nil]]] #{##[except-last-pair/iter list]
0E000E0124040201
} last-pair [list] #@[documentation: "Return the last pair of LIST" source: ["Return the last pair of LIST" [while [cdr list] [cdr! list]] list]] #{##[list]
2409000A0D0E00121A00080E00120AFFF60D0E0001
} make-list [number value] #@[documentation: "Return a list of NUMBER elements containing VALUE in every car" source: ["Return a list of NUMBER elements containing VALUE in every car" [def list #nil] [while [>= [dec! number] 0] [set! list [cons value list]]] list]] #{##[list value number]
241A00070D2409000C0D0E010E00141A00080E020201261A02080200210AFFEC
0D0E0001
} range [end start step] #@[documentation: "Return a list containing values from START (inclusive) to END (exclusive) by STEP" source: ["Return a list containing values from START (inclusive) to END (exclusive) by STEP" [when-not end [throw [list :arity-error "[range] needs at least a specific end"]]] [when-not start [set! start 0]] [when-not step [set! step 1]] [def pred [if [pos? step] < >]] [def ret #nil] [while [pred start end] [set! ret [cons start ret]] [set! start [+ start step]]] [nreverse ret]]] #{##[end throw list :arity-error "[range] needs at least a specific end" start step 0.0 < > pred ret nreverse]
0E000B00072409000F0E010E021A031A04040204010D0E050B00072409000802
001A05080D0E060B00072409000802011A06080D0E061A07210B00080E080900
050E091A0A070D241A0B070D240900150D0E050E0B141A0B080D0E050E06251A
05080E0A0E050E0004020AFFE60D0E0C0E0B040101
} list/reduce [l o s] #@[documentation: "Combine all elements in l using operation o and starting value s" source: ["Combine all elements in l using operation o and starting value s" [doseq [e l] [set! s [o s e]]] s]] #{##[l ΓεnΣym-1 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" e o s]
150E001A01070D240900630D1A020E030E010401200B0007240900150E040E05
1A061A070E000E080400040404010D0E030E0104011A02200B0007240900150E
040E051A061A090E010E080400040404010D0E01111A0A070D0E0B0E0C0E0A04
021A0C080D0E01121A01080E010AFF9E160D0E0C01
} list/ref [l i] #@[documentation: "Returns the the element of list l at location i" source: ["Returns the the element of list l at location i" [while [and l [> i 0]] [dec! i] [cdr! l]] [car l]]] #{##[i l]
240900130D0E000201261A00080D0E01121A01080E010C0B00090D0E00020022
0AFFE40D0E011101
} reverse [l] #@[documentation: "Return the list l in reverse order" source: ["Return the list l in reverse order" [def ret] [doseq [e l] [set! ret [cons e ret]]] ret]] #{##[ret l ΓεnΣym-2 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" e]
241A00070D150E011A02070D240900600D1A030E040E020401200B0007240900
150E050E061A071A080E010E090400040404010D0E040E0204011A03200B0007
240900150E050E061A071A0A0E020E090400040404010D0E02111A0B070D0E0B
0E00141A00080D0E02121A02080E020AFFA1160D0E0001
} list/length [l] #@[documentation: "Returns the length of list l" source: ["Returns the length of list l" [def ret 0] [doseq [e l] [inc! ret]] ret]] #{##[ret l ΓεnΣym-3 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" e]
02001A00070D150E011A02070D240900600D1A030E040E020401200B00072409
00150E050E061A071A080E010E090400040404010D0E040E0204011A03200B00
07240900150E050E061A071A0A0E020E090400040404010D0E02111A0B070D0E
000201251A00080D0E02121A02080E020AFFA1160D0E0001
} list/filter [l p] #@[documentation: "Runs predicate p over every item in list l and returns a list consiting solely of items where p is true" source: ["Runs predicate p over every item in list l and returns a list consiting solely of items where p is true" [def ret #nil] [doseq [e l] [when [p e] [set! ret [cons e ret]]]] [nreverse ret]]] #{##[ret l ΓεnΣym-4 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" e p nreverse]
241A00070D150E011A02070D2409006D0D1A030E040E020401200B0007240900
150E050E061A071A080E010E090400040404010D0E040E0204011A03200B0007
240900150E050E061A071A0A0E020E090400040404010D0E02111A0B070D0E0C
0E0B04010B000E0E0B0E00141A0008090004240D0E02121A02080E020AFF9416
0D0E0D0E00040101
} list/map [l f] #@[documentation: "Runs f over every item in list l and returns the resulting list" source: ["Runs f over every item in list l and returns the resulting list" [def ret #nil] [doseq [e l] [set! ret [cons [f e] ret]]] [nreverse ret]]] #{##[ret l ΓεnΣym-5 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" e f nreverse]
241A00070D150E011A02070D240900640D1A030E040E020401200B0007240900
150E050E061A071A080E010E090400040404010D0E040E0204011A03200B0007
240900150E050E061A071A0A0E020E090400040404010D0E02111A0B070D0E0C
0E0B04010E00141A00080D0E02121A02080E020AFF9D160D0E0D0E00040101
} append [a b] #@[documentation: "Appends two lists A and B together" source: ["Appends two lists A and B together" [def ret b] [set! a [reverse a]] [doseq [t a] [set! ret [cons t ret]]] ret]] #{##[b ret reverse a ΓεnΣym-6 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" t]
0E001A01070D0E020E0304011A03080D150E031A04070D240900600D1A050E06
0E040401200B0007240900150E070E081A091A0A0E030E0B0400040404010D0E
060E0404011A05200B0007240900150E070E081A091A0C0E040E0B0400040404
010D0E04111A0D070D0E0D0E01141A01080D0E04121A04080E040AFFA1160D0E
0101
} sublist [l start end ret] #@[documentation: "Returns a new list containing all elements of l from start to end" source: ["Returns a new list containing all elements of l from start to end" [cond [[nil? l] [reverse ret]] [[neg? end] [sublist l start [+ [length l] end]]] [[zero? end] [reverse ret]] [[> start 0] [sublist [cdr l] [+ -1 start] [+ -1 end] #nil]] [[> end 0] [sublist [cdr l] 0 [+ -1 end] [cons [car l] ret]]]]]] #{##[nil? l reverse ret end 0.0 sublist start length]
0E000E0104010B000C0E020E03040109006B0E041A051E0B00170E060E010E07
0E080E0104010E0425040309004F0E042A0B000C0E020E0304010900400E0702
00220B00180E060E011202FF0E072502FF0E04252404040900230E040200220B
001A0E060E0112020002FF0E04250E01110E031404040900042401
} list-head [l k] #@[documentation: "Returns the first k elements of list l" source: ["Returns the first k elements of list l" [sublist l 0 k]]] #{##[sublist l k]
0E000E0102000E02040301
} list-tail [l k] #@[documentation: "Returns the sublist of l obtained by omitting the first l elements" source: ["Returns the sublist of l obtained by omitting the first l elements" [sublist l k [length l]]]] #{##[sublist l k length]
0E000E010E020E030E010401040301
} list/member [l m] #@[documentation: "Returns the first pair of list l whose car is equal to m" source: ["Returns the first pair of list l whose car is equal to m" [cond [[nil? l] #f] [[= [car l] m] l] [#t [list/member [cdr l] m]]]]] #{##[nil? l m list/member]
0E000E0104010B00071C0900220E01110E02200B00080E010900141B0B000F0E
030E01120E0204020900042401
} getf [l key] #@[documentation: "Return the value in LIST following KEY" source: ["Return the value in LIST following KEY" [cond [[nil? l] #nil] [[= key [car l]] [cadr l]] [#t [getf [cdr l] key]]]]] #{##[nil? l key getf]
0E000E0104010B0007240900240E020E0111200B000A0E0112110900141B0B00
0F0E030E01120E0204020900042401
} list/sort/bubble [l] #@[documentation: "Terribly slow way to sort a list, though it was simple to write" source: ["Terribly slow way to sort a list, though it was simple to write" [if-not l #nil [do [def top [car l]] [def next #nil] [cdr! l] [while l [if [<= [car l] top] [do [set! next [cons top next]] [set! top [car l]]] [set! next [cons [car l] next]]] [cdr! l]] [cons top [list/sort/bubble next]]]]]] #{##[l top next list/sort/bubble]
0E000B00580E00111A01070D241A02070D0E00121A00080D2409002F0D0E0011
0E011F0B00150E010E02141A02080D0E00111A010809000C0E00110E02141A02
080D0E00121A00080E000AFFD20D0E010E030E020401140900042401
} list/merge-sorted-lists [l1 l2] #@[source: [[cond [[nil? l1] l2] [[nil? l2] l1] [#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? l1 l2 list/merge-sorted-lists]
0E000E0104010B00080E020900400E000E0204010B00080E010900321B0B002D
0E01110E02111E0B00130E01110E030E01120E020402140900100E02110E030E
010E02120402140900042401
} list/split-half-rec [l acc1 acc2] #@[source: [[cond [[nil? l] [cons acc1 acc2]] [[nil? [cdr l]] [cons [cons [car l] acc1] acc2]] [#t [list/split-half-rec [cddr l] [cons [car l] acc1] [cons [cadr l] acc2]]]]]] #{##[nil? l acc1 acc2 list/split-half-rec]
0E000E0104010B000B0E020E03140900360E000E011204010B000F0E01110E02
140E03140900201B0B001B0E040E0112120E01110E02140E0112110E03140403
0900042401
} list/split-half [l] #@[source: [[list/split-half-rec l #nil #nil]]] #{##[list/split-half-rec l]
0E000E012424040301
} list/sort/merge [l] #@[documentation: "Sorts a list" source: ["Sorts a list" [if [nil? [cdr l]] l [do [def parts [list/split-half l]] [list/merge-sorted-lists [list/sort/merge [car parts]] [list/sort/merge [cdr parts]]]]]]] #{##[nil? l list/split-half parts list/merge-sorted-lists list/sort/merge]
0E000E011204010B00080E0109001F0E020E0104011A03070D0E040E050E0311
04010E050E03120401040201
} list/sort list? [a] #@[documentation: "Return #t is A is a proper list" source: ["Return #t is A is a proper list" [when-not a [return #f]] [while a [when-not [pair? a] [return #f]] [cdr! a]] [return #t]]] #{##[a :pair type-of]
0E000B0007240900051C010D2409001D0D1A010E020E000401200B0007240900
051C010D0E00121A00080E000AFFE40D1B0101
} list/equal? [a b] #@[documentation: "#t if A and B are equal" source: ["#t if A and B are equal" [if [pair? a] [and [list/equal? [car a] [car b]] [list/equal? [cdr a] [cdr b]]] [equal? a b]]]] #{##[:pair type-of a list/equal? b equal?]
1A000E010E020401200B001F0E030E02110E041104020C0B000E0D0E030E0212
0E0412040209000B0E050E020E04040201
} list/take [l count] #@[documentation: "Take the first COUNT elements from list L" source: ["Take the first COUNT elements from list L" [if [<= count 0] #nil [cons [car l] [list/take [cdr l] [- count 1]]]]]] #{##[count l list/take]
0E0002001F0B0007240900130E01110E020E01120E0002012604021401
} list/drop [l count] #@[documentation: "Drop the final COUNT elements from list L" source: ["Drop the final COUNT elements from list L" [if [<= count 0] l [list/drop [cdr l] [- count 1]]]]] #{##[count l list/drop]
0E0002001F0B00080E0109000F0E020E01120E00020126040201
} list/cut [l start end] #@[documentation: "Return a subsequence of L from START to END" source: ["Return a subsequence of L from START to END" [list/take [list/drop l [max 0 start]] [- end [max 0 start]]]]] #{##[list/take list/drop l max start end]
0E000E010E020E0302000E04040204020E050E0302000E04040226040201
} list/replace [l search-for replace-with] #@[documentation: "Return a new list where every occurence of SEARCH-FOR is replaced with REPLACE-WITH\nUses [equal?] so we can search/replace lists/trees and other complex data structures" source: ["Return a new list where every occurence of SEARCH-FOR is replaced with REPLACE-WITH" "" "Uses [equal?] so we can search/replace lists/trees and other complex data structures" [cond [[not l] #nil] [[equal? l search-for] replace-with] [[equal? [car l] search-for] [cons replace-with [list/replace [cdr l] search-for replace-with]]] [#t [cons [if [pair? [car l]] [list/replace [car l] search-for replace-with] [car l]] [list/replace [cdr l] search-for replace-with]]]]]] #{##[l equal? search-for replace-with list/replace :pair type-of]
0E000B00071C0900041B0B0007240900620E010E000E0204020B00080E030900
520E010E00110E0204020B00140E030E040E00120E020E030403140900351B0B
00301A050E060E00110401200B00110E040E00110E020E0304030900060E0011
0E040E00120E020E030403140900042401
}]
1A001A011A021A03181A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B171A28070D1A2C1A2D1A2E1A2F171A2C070D1A301A31
1A321A33171A30070D1A341A351A361A37171A34070D1A381A391A3A1A3B171A
38070D1A3C1A3D1A3E1A3F171A3C070D1A401A411A421A43171A40070D1A441A
451A461A47171A44070D1A481A491A4A1A4B171A48070D1A4C1A4D1A4E1A4F17
1A4C070D1A501A511A521A53171A50070D1A541A551A561A57171A54070D1A58
1A591A5A1A5B171A58070D1A5C1A5D1A5E1A5F171A5C070D0E5C1A60070D1A61
1A621A631A64171A61070D1A651A661A671A68171A65070D1A691A6A1A6B1A6C
171A69070D1A6D1A6E1A6F1A70171A6D070D1A711A721A731A74171A71070D1A
751A761A771A78171A750701
}#{##[tree/zip [keys values] #@[documentation: "Return a tree where KEYS point to VALUES" source: ["Return a tree where KEYS point to VALUES" [def ret [tree/new #nil]] [doseq [key keys] [tree/set! ret key [car values]] [cdr! values]] ret]] #{##[tree/new ret keys ΓεnΣym-1 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" key tree/set! values]
0E002404011A01070D150E021A03070D2409006A0D1A040E050E030401200B00
07240900150E060E071A081A090E020E0A0400040404010D0E050E0304011A04
200B0007240900150E060E071A081A0B0E030E0A0400040404010D0E03111A0C
070D0E0D0E010E0C0E0E1104030D0E0E121A0E080D0E03121A03080E030AFF97
160D0E0101
} tree/+= [t k v] #@[documentation: "Increment value at K in T by V" source: ["Increment value at K in T by V" [tree/set! t k [+ v [int [or [tree/ref t k] 0]]]]]] #{##[tree/set! t k v int tree/ref #f]
0E000E010E020E030E040E050E010E0204020C0A000D0D02000C0A00060D1A06
040125040301
} tree/-= [t k v] #@[documentation: "Decrement value at K in T by V" source: ["Decrement value at K in T by V" [quasiquote [tree/+= [unquote t] [unquote k] [- [unquote v]]]]]] #{##[tree/+= t k - v]
1A000E010E021A030E04241414241414141401
} tree/++ [t k] #@[documentation: "Increment value at K in T by 1" source: ["Increment value at K in T by 1" [quasiquote [tree/+= [unquote t] [unquote k] 1]]]] #{##[tree/+= t k]
1A000E010E020201241414141401
} tree/-- [t k] #@[documentation: "Increment value at K in T by 1" source: ["Increment value at K in T by 1" [quasiquote [tree/-= [unquote t] [unquote k] 1]]]] #{##[tree/-= t k]
1A000E010E020201241414141401
} tree/equal? [a b] #@[documentation: "Compares two trees for equality" source: ["Compares two trees for equality" [if [and [tree? a] [tree? b]] [and [= [tree/key* a] [tree/key* b]] [equal? [tree/value* a] [tree/value* b]] [tree/equal? [tree/left* a] [tree/left* b]] [tree/equal? [tree/right* a] [tree/right* b]]] [equal? a b]]]] #{##[tree? a b tree/key* equal? tree/value* tree/equal? tree/left* tree/right*]
0E000E0104010C0B000A0D0E000E0204010B00520E030E0104010E030E020401
200C0B003E0D0E040E050E0104010E050E02040104020C0B00290D0E060E070E
0104010E070E02040104020C0B00140D0E060E080E0104010E080E0204010402
09000B0E040E010E02040201
} tree/reduce [l o s] #@[documentation: "Combine all elements in l using operation o and starting value s" source: ["Combine all elements in l using operation o and starting value s" [list/reduce [tree/values l] o s]]] #{##[list/reduce tree/values l o s]
0E000E010E0204010E030E04040301
} tree/filter [l f] #@[documentation: "Return a new tree with all elements from L where F retunrs true" source: ["Return a new tree with all elements from L where F retunrs true" [def ret [tree/new #nil]] [doseq [e [tree/keys l]] [def t [tree/ref l e]] [when [f t] [tree/set! ret e t]]] ret]] #{##[tree/new ret tree/keys l ΓεnΣym-2 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" e tree/ref t f tree/set!]
0E002404011A01070D150E020E0304011A04070D2409007F0D1A050E060E0404
01200B0007240900190E070E081A091A0A0E020E0304010E0B0400040404010D
0E060E0404011A05200B0007240900150E070E081A091A0C0E040E0B04000404
04010D0E04111A0D070D0E0E0E030E0D04021A0F070D0E100E0F04010B00100E
110E010E0D0E0F0403090004240D0E04121A04080E040AFF82160D0E0101
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B181A08070D1A0C1A0D1A0E1A0F181A0C070D1A101A111A121A13181A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C0701
}#{##[$nop [] #@[documentation: "[] -> []\nDo nothing" source: ["[] -> []" "Do nothing" :inline '[#$0]] inline: #t] #{##[[#$0]]
1A0001
} $ret [] #@[documentation: "[a] -> []\nReturn top of value stack" source: ["[a] -> []" "Return top of value stack" :inline '[#$1]] inline: #t] #{##[[#$1]]
1A0001
} $add/int [] #@[documentation: "[a b] -> [result]\nAdds the two topmost values and pushes the result" source: ["[a b] -> [result]" "Adds the two topmost values and pushes the result" :inline '[#$3]] inline: #t] #{##[[#$3]]
1A0001
} $get [] #@[documentation: "[s] -> [a]\nResolve symbol S and put whatever is bound to it in the current context on the stack" source: ["[s] -> [a]" "Resolve symbol S and put whatever is bound to it in the current context on the stack" :inline '[#$5]] inline: #t] #{##[[#$5]]
1A0001
} $def [] #@[documentation: "[s v] -> [v]\nDefine S to resolve to V in the current environment" source: ["[s v] -> [v]" "Define S to resolve to V in the current environment" :inline '[#$7]] inline: #t] #{##[[#$7]]
1A0001
} $set [] #@[documentation: "[s v] -> [v]\nSet S to resolve to V in the current environment" source: ["[s v] -> [v]" "Set S to resolve to V in the current environment" :inline '[#$8]] inline: #t] #{##[[#$8]]
1A0001
} $dup [] #@[documentation: "[a] -> [a a]\nDuplicates the value that is on the top of the stack" source: ["[a] -> [a a]" "Duplicates the value that is on the top of the stack" :inline '[#$C]] inline: #t] #{##[[#$C]]
1A0001
} $drop [] #@[documentation: "[a] -> []\nDrop whatever is on top of the stack" source: ["[a] -> []" "Drop whatever is on top of the stack" :inline '[#$D]] inline: #t] #{##[[#$D]]
1A0001
} $closure/push [] #@[documentation: "[] -> [closure]\nPush the current closure as a λ on the stack" source: ["[] -> [closure]" "Push the current closure as a λ on the stack" :inline '[#$13]] inline: #t] #{##[[#$13]]
1A0001
} $let [] #@[documentation: "[] -> []\nCreate a new let closure and switch to it" source: ["[] -> []" "Create a new let closure and switch to it" :inline '[#$15]] inline: #t] #{##[[#$15]]
1A0001
} $closure/pop [] #@[documentation: "[] -> []\nLeave the current closure and return to the parent one" source: ["[] -> []" "Leave the current closure and return to the parent one" :inline '[#$16]] inline: #t] #{##[[#$16]]
1A0001
} $< [] #@[documentation: "[a b] -> [bool]\nCompare A and B and push the result on the stack" source: ["[a b] -> [bool]" "Compare A and B and push the result on the stack" :inline '[#$1E]] inline: #t] #{##[[#$1E]]
1A0001
} $<= [] #@[documentation: "[a b] -> [bool]\nCompare A and B and push the result on the stack" source: ["[a b] -> [bool]" "Compare A and B and push the result on the stack" :inline '[#$1F]] inline: #t] #{##[[#$1F]]
1A0001
} $= [] #@[documentation: "[a b] -> [bool]\nCompare A and B and push the result on the stack" source: ["[a b] -> [bool]" "Compare A and B and push the result on the stack" :inline '[#$20]] inline: #t] #{##[[#$20]]
1A0001
} $>= [] #@[documentation: "[a b] -> [bool]\nCompare A and B and push the result on the stack" source: ["[a b] -> [bool]" "Compare A and B and push the result on the stack" :inline '[#$21]] inline: #t] #{##[[#$21]]
1A0001
} $> [] #@[documentation: "[a b] -> [bool]\nCompare A and B and push the result on the stack" source: ["[a b] -> [bool]" "Compare A and B and push the result on the stack" :inline '[#$22]] inline: #t] #{##[[#$22]]
1A0001
} $push/nil [] #@[documentation: "[] -> [nil]\nPush a #nil on the stack" source: ["[] -> [nil]" "Push a #nil on the stack" :inline '[#$24]] inline: #t] #{##[[#$24]]
1A0001
} $car [] #@[documentation: "[l] -> [car]\nReplace L with its car" source: ["[l] -> [car]" "Replace L with its car" :inline '[#$11]] inline: #t] #{##[[#$11]]
1A0001
} $cdr [] #@[documentation: "[l] -> [cdr]\nReplace L with its cdr" source: ["[l] -> [cdr]" "Replace L with its cdr" :inline '[#$12]] inline: #t] #{##[[#$12]]
1A0001
} $cons [] #@[documentation: "[car cdr] -> [pair]\nCons CAR and CDR together and put it on the stack" source: ["[car cdr] -> [pair]" "Cons CAR and CDR together and put it on the stack" :inline '[#$14]] inline: #t] #{##[[#$14]]
1A0001
} $fn/dynamic [] #@[documentation: "[name args docs body] -> [λ]\nCreate a new λ" source: ["[name args docs body] -> [λ]" "Create a new λ" :inline '[#$17]] inline: #t] #{##[[#$17]]
1A0001
} $macro/dynamic [] #@[documentation: "[name args docs body] -> [μ]\nCreate a new μ" source: ["[name args docs body] -> [μ]" "Create a new μ" :inline '[#$18]] inline: #t] #{##[[#$18]]
1A0001
} $add [] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$25]] inline: #t] #{##[[#$25]]
1A0001
} $sub [] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$26]] inline: #t] #{##[[#$26]]
1A0001
} $mul [] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$27]] inline: #t] #{##[[#$27]]
1A0001
} $div [] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$28]] inline: #t] #{##[[#$28]]
1A0001
} $rem [] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$29]] inline: #t] #{##[[#$29]]
1A0001
} $push/true [] #@[documentation: "[] -> [#t]" source: ["[] -> [#t]" '[#$1B]]] #{##[[#$1B]]
1A0001
} $push/false [] #@[documentation: "[] -> [#f]" source: ["[] -> [#f]" '[#$1C]]] #{##[[#$1C]]
1A0001
} $zero? [] #@[documentation: "[a] -> [result]" source: ["[a] -> [result]" :inline '[#$2A]] inline: #t] #{##[[#$2A]]
1A0001
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B171A28070D1A2C1A2D1A2E1A2F171A2C070D1A301A31
1A321A33171A30070D1A341A351A361A37171A34070D1A381A391A3A1A3B171A
38070D1A3C1A3D1A3E1A3F171A3C070D1A401A411A421A43171A40070D1A441A
451A461A47171A44070D1A481A491A4A1A4B171A48070D1A4C1A4D1A4E1A4F17
1A4C070D1A501A511A521A53171A50070D1A541A551A561A57171A54070D1A58
1A591A5A1A5B171A58070D1A5C1A5D1A5E1A5F171A5C070D1A601A611A621A63
171A60070D1A641A651A661A67171A64070D1A681A691A6A1A6B171A68070D1A
6C1A6D1A6E1A6F171A6C070D1A701A711A721A73171A70070D1A741A751A761A
77171A740701
}#{##[int-fit-in-byte? [a] #@[source: [[and [<= a 127] [>= a -128]]]] #{##[a]
0E00027F1F0C0B00090D0E0002802101
} $push/int [a] #@[documentation: "[] -> [a]\nPush A on the stack as an :int" source: ["[] -> [a]" "Push A on the stack as an :int" [if [int-fit-in-byte? a] [$push/int/byte a] [$push/val a]]]] #{##[int-fit-in-byte? a $push/int/byte $push/val]
0E000E0104010B000C0E020E0104010900090E030E01040101
} $push/int/byte [a] #@[documentation: "[] -> [a]\nPush A on the stack as an :int that fits within a byte" source: ["[] -> [a]" "Push A on the stack as an :int that fits within a byte" [when-not [int-fit-in-byte? a] [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]]]] #{##[int-fit-in-byte? a throw list :invalid-bc-op "$push/int/byte can only push a signed 8-bit value" current-lambda #$2 int->bytecode-op]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
0E031A070E080E010401040201
} $apply/optimize? [fun arg-count] #@[source: [[case fun [[+ - * / rem] [= arg-count 2]] [[zero? car cdr add/int cons < <= = >= >] #t]]]] #{##[fun ΓεnΣym-1 + - * / rem #f arg-count zero? car cdr add/int cons < <= = >= >]
150E001A01070D0E010E02200C0A002E0D0E010E03200C0A00240D0E010E0420
0C0A001A0D0E010E05200C0A00100D0E010E06200C0A00060D1A070B000B0E08
0202200900710E010E09200C0A00600D0E010E0A200C0A00560D0E010E0B200C
0A004C0D0E010E0C200C0A00420D0E010E0D200C0A00380D0E010E0E200C0A00
2E0D0E010E0F200C0A00240D0E010E10200C0A001A0D0E010E11200C0A00100D
0E010E12200C0A00060D1A070B00071B090004241601
} $apply [arg-count fun] #@[documentation: "arguments -> [result]\nRead arg-count arguments from the stack, apply the to fun and push the result on the stack" source: ["arguments -> [result]" "Read arg-count arguments from the stack, apply the to fun and push the result on the stack" [case arg-count [1 [case fun [car [$car]] [cdr [$cdr]] [zero? [$zero?]] [otherwise [exception :arity-error "Wrong number of arguments for that function" fun]]]] [2 [case fun [add/int [$add/int]] [+ [$add]] [- [$sub]] [* [$mul]] [/ [$div]] [rem [$rem]] [cons [$cons]] [< [$<]] [<= [$<=]] [= [$=]] [>= [$>=]] [> [$>]] [otherwise [exception :arity-error "Wrong number of arguments for that function" fun]]]] [otherwise [exception :arity-error "Wrong number of arguments for that function" fun]]]]] #{##[arg-count ΓεnΣym-2 fun ΓεnΣym-3 car [#$11] cdr [#$12] zero? [#$2A] throw list :arity-error "Wrong number of arguments for that function" current-lambda ΓεnΣym-4 add/int [#$3] + [#$25] - [#$26] * [#$27] / [#$28] rem [#$29] cons [#$14] < [#$1E] <= [#$1F] = [#$20] >= [#$21] > [#$22]]
150E001A01070D0E010201200B0047150E021A03070D0E030E04200B00081A05
09002F0E030E06200B00081A070900220E030E08200B00081A090900150E0A0E
0B1A0C1A0D0E020E0E040004040401160900D60E010202200B00BC150E021A0F
070D0E0F0E10200B00081A110900A40E0F0E12200B00081A130900970E0F0E14
200B00081A1509008A0E0F0E16200B00081A1709007D0E0F0E18200B00081A19
0900700E0F0E1A200B00081A1B0900630E0F0E1C200B00081A1D0900560E0F0E
1E200B00081A1F0900490E0F0E20200B00081A2109003C0E0F0E22200B00081A
2309002F0E0F0E24200B00081A250900220E0F0E26200B00081A270900150E0A
0E0B1A0C1A0D0E020E0E040004040401160900150E0A0E0B1A0C1A0D0E020E0E
0400040404011601
} $apply/dynamic [arg-count fun] #@[source: [[when [> arg-count 255] [exception :arity-error "Functions can only take up to 255 arguments directly, you can use [apply] instead though" arg-count]] [list #$4 [int->bytecode-op arg-count]]]] #{##[arg-count 255 throw list :arity-error "Functions can only take up to 255 arguments directly, you can use [apply] instead though" current-lambda #$4 int->bytecode-op]
0E001A01220B00180E020E031A041A050E000E06040004040401090004240D0E
031A070E080E000401040201
} $try [target] #@[documentation: "[] -> []\nTry something, jumping to target if an exception occurs" source: ["[] -> []" "Try something, jumping to target if an exception occurs" [list #$19 [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] #{##[list #$19 :relocate target int->bytecode-op]
0E001A010E001A020E03020802000E040200040104050E001A020E0302000201
0E04020004010405040301
} $jmp [target] #@[source: [[list #$9 [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] #{##[list #$9 :relocate target int->bytecode-op]
0E001A010E001A020E03020802000E040200040104050E001A020E0302000201
0E04020004010405040301
} $push/val [v] #@[documentation: "[] -> [v]\nPushes v onto the stack" source: ["[] -> [v]" "Pushes v onto the stack" [when [nil? v] [throw [list :invalid-bc-op "Can't push #nil as a normal lVal" v [current-lambda]]]] [list #$1A [list :literal v]]]] #{##[nil? v throw list :invalid-bc-op "Can't push #nil as a normal lVal" current-lambda #$1A :literal]
0E000E0104010B00180E020E031A041A050E010E06040004040401090004240D
0E031A070E031A080E010402040201
} $push/val/ext $get/val [v] #@[documentation: "[] -> [v]\nResolve V and get the associated value on the stack" source: ["[] -> [v]" "Resolve V and get the associated value on the stack" [when-not [symbol? v] [throw [list :invalid-bc-op "Can only get symbol" v [current-lambda]]]] [list #$E [list :literal v]]]] #{##[symbol? v throw list :invalid-bc-op "Can only get symbol" current-lambda #$E :literal]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
0E031A070E031A080E010402040201
} $jt [target] #@[source: [[list #$A [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] #{##[list #$A :relocate target int->bytecode-op]
0E001A010E001A020E03020802000E040200040104050E001A020E0302000201
0E04020004010405040301
} $jf [target] #@[source: [[list #$B [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] #{##[list #$B :relocate target int->bytecode-op]
0E001A010E001A020E03020802000E040200040104050E001A020E0302000201
0E04020004010405040301
} $fn [name args docs body] #@[source: [[list #$25 [val->bytecode-op name] [val->bytecode-op args] [val->bytecode-op docs] [val->bytecode-op body]]]] #{##[list #$25 val->bytecode-op name args docs body]
0E001A010E020E0304010E020E0404010E020E0504010E020E060401040501
} $macro* [name args docs body] #@[source: [[list #$26 [val->bytecode-op name] [val->bytecode-op args] [val->bytecode-op docs] [val->bytecode-op body]]]] #{##[list #$26 val->bytecode-op name args docs body]
0E001A010E020E0304010E020E0404010E020E0504010E020E060401040501
} assemble/build-sym-map [code sym-map pos] #@[source: [[while code [case [type-of [car code]] [:bytecode-op [tree/set! sym-map :last-op [inc! pos]]] [:keyword [case [car code] [:label [tree/set! sym-map [cadr code] pos] [cdr! code]] [:literal [cdr! code]]]] [:pair [set! pos [assemble/build-sym-map [car code] sym-map pos]]]] [cdr! code]] [return pos]]] #{##[type-of code ΓεnΣym-5 :bytecode-op tree/set! sym-map :last-op pos :keyword ΓεnΣym-6 :label :literal :pair assemble/build-sym-map]
240900910D150E000E011104011A02070D0E021A03200B00160E040E051A060E
070201251A070804030900610E021A08200B003F150E01111A09070D0E091A0A
200B00190E040E050E0112110E0704030D0E01121A01080900150E091A0B200B
000C0E01121A0108090004241609001D0E021A0C200B00140E0D0E01110E050E
0704031A070809000424160D0E01121A01080E010AFF700D0E070101
} assemble/relocate-op [code sym-map pos out] #@[source: [[def target [tree/ref sym-map [cadr code]]] [def off [- [+ target [cadddr code]] pos]] [array/set! out [inc! pos] [int->bytecode-op [bit-and [bit-shift-right off [caddr code]] 255]]] [return pos]]] #{##[tree/ref sym-map code target cadddr pos off array/set! out int->bytecode-op bit-and bit-shift-right caddr 255]
0E000E010E02121104021A03070D0E030E040E020401250E05261A06070D0E07
0E080E050201251A05080E090E0A0E0B0E060E0C0E02040104021A0D04020401
04030D0E050101
} assemble/emit-relocated-ops [code sym-map pos out] #@[source: [[if [= [car code] :relocate] [set! pos [assemble/relocate-op code sym-map pos out]] [doseq [op code] [case [type-of op] [:bytecode-op [array/set! out [inc! pos] op]] [:pair [set! pos [assemble/emit-relocated-ops op sym-map pos out]]]]]] [return pos]]] #{##[code :relocate assemble/relocate-op sym-map pos out ΓεnΣym-7 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" op ΓεnΣym-8 :bytecode-op array/set! assemble/emit-relocated-ops]
0E00111A01200B00150E020E000E030E040E0504041A04080900AB150E001A06
070D2409009A0D1A070E080E060401200B0007240900150E090E0A1A0B1A0C0E
000E0D0400040404010D0E080E0604011A07200B0007240900150E090E0A1A0B
1A0E0E060E0D0400040404010D0E06111A0F070D150E080E0F04011A10070D0E
101A11200B00160E120E050E040201251A04080E0F040309001E0E101A07200B
00150E130E0F0E030E040E0504041A040809000424160D0E06121A06080E060A
FF67160D0E040101
} literal-index->bytecode-op [i] #@[source: [[if [< i 256] [int->bytecode-op i] [list [int->bytecode-op [bit-and [bit-shift-right i 8] 255]] [int->bytecode-op [bit-and i 255]]]]]] #{##[i 256 int->bytecode-op list bit-and bit-shift-right 255]
0E001A011E0B000C0E020E0004010900250E030E020E040E050E00020804021A
06040204010E020E040E001A0604020401040201
} *max-literal-arr* assemble/add-literal [lit lit-arr] #@[source: [[when [>= [array/length lit-arr] 65535] [exception :out-of-bounds "Can only store up to 255 literals per bytecode-arr" code]] [when [not= [type-of lit] :pair] [dotimes [i [array/length lit-arr]] [when [equal? [array/ref lit-arr i] lit] [return [literal-index->bytecode-op i]]]]] [array/length! lit-arr [+ 1 [array/length lit-arr]]] [array/set! lit-arr [- [array/length lit-arr] 1] lit] [literal-index->bytecode-op [- [array/length lit-arr] 1]]]] #{##[array/length lit-arr 65535 throw list :out-of-bounds "Can only store up to 255 literals per bytecode-arr" code current-lambda not= type-of lit :pair i equal? array/ref literal-index->bytecode-op array/length! array/set!]
0E000E0104011A02210B00180E030E041A051A060E070E080400040404010900
04240D0E090E0A0E0B04011A0C04020B00461502001A0D070D240900290D0E0E
0E0F0E010E0D04020E0B04020B000D0E100E0D040101090004240D02010E0D03
1A0D080E0D0E000E0104011E0AFFD10D2416090004240D0E110E0102010E000E
0104012504020D0E120E010E000E0104010201260E0B04030D0E100E000E0104
01020126040101
} assemble/build-lit-arr [code lit-arr] #@[source: [[when-not code [return #nil]] [cond [[pair? [car code]] [cons [assemble/build-lit-arr [car code] lit-arr] [assemble/build-lit-arr [cdr code] lit-arr]]] [[and [= [car code] #$1A] [= [car [cadr code]] :literal]] [cdr! code] [def index-op [assemble/add-literal [cadar code] lit-arr]] [cons [if [pair? index-op] #$6 #$1A] [cons index-op [assemble/build-lit-arr [cdr code] lit-arr]]]] [[and [= [car code] #$E] [= [car [cadr code]] :literal]] [cdr! code] [def index-op [assemble/add-literal [cadar code] lit-arr]] [cons [if [pair? index-op] #$F #$E] [cons index-op [assemble/build-lit-arr [cdr code] lit-arr]]]] [[= :literal [car code]] [cdr! code] [cons [assemble/add-literal [car code] lit-arr] [assemble/build-lit-arr [cdr code] lit-arr]]] [otherwise [cons [car code] [assemble/build-lit-arr [cdr code] lit-arr]]]]]] #{##[code :pair type-of assemble/build-lit-arr lit-arr #$1A :literal assemble/add-literal cadar index-op #$6 #$E #$F otherwise]
0E000B00072409000524010D1A010E020E00110401200B00190E030E00110E04
04020E030E00120E040402140900DF0E00111A05200C0B000C0D0E001211111A
06200B003D0E00121A00080D0E070E080E0004010E0404021A09070D1A010E02
0E090401200B00081A0A0900051A050E090E030E00120E040402141409008F0E
00111A0B200C0B000C0D0E001211111A06200B003D0E00121A00080D0E070E08
0E0004010E0404021A09070D1A010E020E090401200B00081A0C0900051A0B0E
090E030E00120E040402141409003F1A060E0011200B00200E00121A00080D0E
070E00110E0404020E030E00120E040402140900190E0D0B00130E00110E030E
00120E040402140900042401
} assemble/flatten [code ret] #@[source: [[when-not code [return ret]] [when-not [pair? code] [return ret]] [set! ret [assemble/flatten [cdr code] ret]] [if [and [pair? [car code]] [not [keyword? [caar code]]]] [assemble/flatten [car code] ret] [cons [car code] ret]]]] #{##[code ret :pair type-of assemble/flatten keyword?]
0E000B0007240900060E01010D1A020E030E000401200B0007240900060E0101
0D0E040E00120E0104021A01080D1A020E030E00110401200C0B00140D0E050E
00111104010B00071C0900041B0B000F0E040E00110E0104020900090E00110E
011401
} assemble* [code] #@[documentation: "Assemble all arguments into a single :bytecode-array" source: ["Assemble all arguments into a single :bytecode-array" [def sym-map [tree/new #nil]] [def lit-arr [array/new #nil]] [def tmp [-> [assemble/flatten code] [assemble/build-lit-arr lit-arr]]] [assemble/build-sym-map tmp sym-map 0] [def out [array/allocate [tree/ref sym-map :last-op]]] [assemble/emit-relocated-ops tmp sym-map -1 out] [arr->bytecode-arr out lit-arr]]] #{##[tree/new sym-map array/new lit-arr assemble/build-lit-arr assemble/flatten code tmp assemble/build-sym-map array/allocate tree/ref :last-op out assemble/emit-relocated-ops arr->bytecode-arr]
0E002404011A01070D0E022404011A03070D0E040E050E0604010E0304021A07
070D0E080E070E01020004030D0E090E0A0E011A0B040204011A0C070D0E0D0E
070E0102FF0E0C04040D0E0E0E0C0E03040201
} assemble l #@[documentation: "Assemble all arguments into a single :bytecode-array" source: ["Assemble all arguments into a single :bytecode-array" [assemble* l]]] #{##[assemble* l]
0E000E01040101
} asmrun ops #@[documentation: "Assemble and evaluate all bytecode arguments" source: ["Assemble and evaluate all bytecode arguments" [quasiquote [apply [current-closure] [assemble [unquote-splicing ops]]]]]] #{##[apply current-closure assemble append ops]
1A001A0124141A020E030E04240402142414141401
} asmdebug #@[documentation: "Assemble and evaluate all bytecode arguments" source: ["Assemble and evaluate all bytecode arguments" [def bc [apply assemble ops]] [disassemble bc] [def v [apply [current-closure] bc #t]] [pfmtln "Result: {:?}{}" v [type-of v]]]] #{##[apply assemble ops bc disassemble current-closure v println fmt-arg-0 type-of fmt-arg-1 cat "Result: " string/write]
0E000E010E0204021A03070D0E040E0304010D0E000E0504000E031B04031A06
070D0E07150E061A08070D0E090E0604011A0A070D0E0B1A0C0E0D0E0804010E
0A040316040101
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D0E201A24070D1A251A261A
271A28171A25070D1A291A2A1A2B1A2C171A29070D1A2D1A2E1A2F1A30171A2D
070D1A311A321A331A34171A31070D1A351A361A371A38171A35070D1A391A3A
1A3B1A3C171A39070D1A3D1A3E1A3F1A40171A3D070D1A411A421A431A44171A
41070D1A451A461A471A48171A45070D02001A49070D1A4A1A4B1A4C1A4D171A
4A070D1A4E1A4F1A501A51171A4E070D1A521A531A541A55171A52070D1A561A
571A581A59171A56070D1A5A1A5B1A5C1A5D171A5A070D1A5E1A5F1A601A6118
1A5E070D1A621A5F1A631A64171A620701
}#{##[bytecompile/gen-label/counter bytecompile/gen-label [prefix] #@[source: [[inc! bytecompile/gen-label/counter] [string->symbol [cat prefix "label-" bytecompile/gen-label/counter]]]] #{##[bytecompile/gen-label/counter string->symbol cat prefix "label-"]
0E000201251A00080D0E010E020E031A040E000403040101
} bytecompile/literal [source] #@[source: [[case [type-of source] [:int [$push/int source]] [:nil [$push/nil]] [:bool [if source [$push/true] [$push/false]]] [:symbol [list [$get/val source]]] [[:native-function :lambda] [bytecompile/literal [closure/name source]]] [otherwise [$push/val source]]]]] #{##[type-of source ΓεnΣym-1 :int $push/int :nil [#$24] :bool $push/true $push/false :symbol list $get/val :native-function :lambda #f bytecompile/literal closure/name $push/val]
150E000E0104011A02070D0E021A03200B000C0E040E01040109006C0E021A05
200B00081A0609005F0E021A07200B00160E010B000A0E0804000900070E0904
000900440E021A0A200B00100E0B0E0C0E010401040109002F0E021A0D200C0A
00100D0E021A0E200C0A00060D1A0F0B00100E100E110E01040104010900090E
120E0104011601
} bytecompile/quote [source] #@[source: [[case [type-of source] [:nil [$push/nil]] [:int [$push/int source]] [otherwise [$push/val source]]]]] #{##[type-of source ΓεnΣym-2 :nil [#$24] :int $push/int $push/val]
150E000E0104011A02070D0E021A03200B00081A0409001A0E021A05200B000C
0E060E0104010900090E070E0104011601
} bytecompile/do/form [source env] #@[source: [[when source [cons [cons [bytecompile* [car source] env] [if [last? source] #nil [cons [$drop] #nil]]] [bytecompile/do/form [cdr source] env]]]]] #{##[source bytecompile* env nil? [#$D] bytecompile/do/form]
0E000B002C0E010E00110E0204020E030E001204010B0007240900071A042414
140E050E00120E020402140900042401
} bytecompile/do [source env] #@[source: [[list [bytecompile/do/form [cdr source] env]]]] #{##[list bytecompile/do/form source env]
0E000E010E02120E030402040101
} bytecompile/def [source env] #@[source: [[when [or [not [symbol? [cadr source]]] [not [cddr source]]] [throw [list :type-error "[def] needs a symbol name and a value as arguments" #nil env]]] [list [bytecompile* [caddr source] env] [$push/val [cadr source]] [$def]]]] #{##[symbol? source #f throw list :type-error "[def] needs a symbol name and a value as arguments" env bytecompile* caddr $push/val [#$7]]
0E000E01121104010B00071C0900041B0C0A00170D0E0112120B00071C090004
1B0C0A00060D1A020B00150E030E041A051A06240E0704040401090004240D0E
040E080E090E0104010E0704020E0A0E01121104011A0B040301
} bytecompile/set! [source env] #@[source: [[when [or [not [symbol? [cadr source]]] [not [cddr source]]] [throw [list :type-error "[set!] needs a symbol name and a value as arguments" #nil env]]] [list [bytecompile* [caddr source] env] [$push/val [cadr source]] [$set]]]] #{##[symbol? source #f throw list :type-error "[set!] needs a symbol name and a value as arguments" env bytecompile* caddr $push/val [#$8]]
0E000E01121104010B00071C0900041B0C0A00170D0E0112120B00071C090004
1B0C0A00060D1A020B00150E030E041A051A06240E0704040401090004240D0E
040E080E090E0104010E0704020E0A0E01121104011A0B040301
} bytecompile/if [source env] #@[source: [[let [[sym-else [bytecompile/gen-label]] [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]]]]] #{##[bytecompile/gen-label sym-else sym-after list bytecompile* source env $jf caddr $jmp :label cadddr]
150E0004001A01070D0E0004001A02070D0E030E040E0512110E0604020E070E
0104010E040E080E0504010E0604020E090E0204010E031A0A0E0104020E040E
0B0E0504010E0604020E031A0A0E02040204071601
} bytecompile/while [source env] #@[source: [[def sym-start [bytecompile/gen-label]] [def sym-end [bytecompile/gen-label]] [list [$push/nil] [$jmp sym-end] [list :label sym-start] [$drop] [bytecompile/do/form [cddr source] env] [list :label sym-end] [bytecompile* [cadr source] env] [$jt sym-start]]]] #{##[bytecompile/gen-label sym-start sym-end list [#$24] $jmp :label [#$D] bytecompile/do/form source env bytecompile* $jt]
0E0004001A01070D0E0004001A02070D0E031A040E050E0204010E031A060E01
04021A070E080E0912120E0A04020E031A060E0204020E0B0E0912110E0A0402
0E0C0E010401040801
} bytecompile/procedure/arg [source env] #@[source: [[if [last? source] [bytecompile* [car source] env] [cons [bytecompile* [car source] env] [bytecompile/procedure/arg [cdr source] env]]]]] #{##[nil? source bytecompile* env bytecompile/procedure/arg]
0E000E011204010B000F0E020E01110E0304020900160E020E01110E0304020E
040E01120E0304021401
} bytecompile/procedure/inline? [op] #@[source: [[meta op :inline]]] #{##[meta op :inline]
0E000E011A02040201
} bytecompile/procedure/inline [op args env] #@[source: [[def arg-count [length args]] [when [> arg-count 1] [throw [list :compiler-error "For now only monadic functions can be inlined" op [current-lambda]]]] [def form [macroexpand/do [meta op :source] env]] [def arg-name [car [closure/arguments op]]] [if args [bytecompile* [list/replace form arg-name [car args]] env] [bytecompile* form env]]]] #{##[length args arg-count throw list :compiler-error "For now only monadic functions can be inlined" op current-lambda macroexpand/do meta :source env form closure/arguments arg-name bytecompile* list/replace]
0E000E0104011A02070D0E020201220B00180E030E041A051A060E070E080400
04040401090004240D0E090E0A0E071A0B04020E0C04021A0D070D0E0E0E0704
01111A0F070D0E010B00170E100E110E0D0E0F0E011104030E0C040209000B0E
100E0D0E0C040201
} bytecompile/procedure [op args env op-raw] #@[source: [[if [bytecompile/procedure/inline? op] [bytecompile/procedure/inline op args env] [bytecompile/procedure/default op args env op-raw]]]] #{##[bytecompile/procedure/inline? op bytecompile/procedure/inline args env bytecompile/procedure/default op-raw]
0E000E0104010B00100E020E010E030E04040309000F0E050E010E030E040E06
040401
} bytecompile/procedure/default [op args env op-raw] #@[source: [[when [and [not [procedure? op]] [not [symbol? op]] [not [pair? op]]] [exception :type-error "Can't apply to that" op]] [def arg-count [length args]] [if [$apply/optimize? op arg-count] [list [when args [bytecompile/procedure/arg args]] [$apply arg-count op]] [list [bytecompile* op-raw env] [when args [bytecompile/procedure/arg args]] [$apply/dynamic arg-count]]]]] #{##[procedure? op symbol? :pair type-of throw list :type-error "Can't apply to that" current-lambda length args arg-count $apply/optimize? bytecompile/procedure/arg $apply bytecompile* op-raw env $apply/dynamic]
0E000E0104010B00071C0900041B0C0B00280D0E020E0104010B00071C090004
1B0C0B00150D1A030E040E010401200B00071C0900041B0B00180E050E061A07
1A080E010E09040004040401090004240D0E0A0E0B04011A0C070D0E0D0E010E
0C04020B00210E060E0B0B000C0E0E0E0B0401090004240E0F0E0C0E01040204
020900240E060E100E110E1204020E0B0B000C0E0E0E0B0401090004240E130E
0C0401040301
} bytecompile/and/rec [source env label-end] #@[source: [[list [bytecompile* [car source] env] [when [cdr source] [list [$dup] [$jf label-end] [$drop] [bytecompile/and/rec [cdr source] env label-end]]]]]] #{##[list bytecompile* source env [#$C] $jf label-end [#$D] bytecompile/and/rec]
0E000E010E02110E0304020E02120B001F0E001A040E050E0604011A070E080E
02120E030E060403040409000424040201
} bytecompile/and [source env] #@[source: [[def label-end [bytecompile/gen-label]] [list [bytecompile/and/rec [cdr source] env label-end] [list :label label-end]]]] #{##[bytecompile/gen-label label-end list bytecompile/and/rec source env :label]
0E0004001A01070D0E020E030E04120E050E0104030E021A060E010402040201
} bytecompile/or/rec [source env label-end] #@[source: [[when source [list [bytecompile* [car source] env] [$dup] [$jt label-end] [$drop] [bytecompile/or/rec [cdr source] env label-end]]]]] #{##[source list bytecompile* env [#$C] $jt label-end [#$D] bytecompile/or/rec]
0E000B00280E010E020E00110E0304021A040E050E0604011A070E080E00120E
030E06040304050900042401
} bytecompile/or [source env] #@[source: [[def label-end [bytecompile/gen-label]] [list [bytecompile/or/rec [cdr source] env label-end] [$push/val #f] [list :label label-end]]]] #{##[bytecompile/gen-label label-end list bytecompile/or/rec source env $push/val :label]
0E0004001A01070D0E020E030E04120E050E0104030E061C04010E021A070E01
0402040301
} bytecompile/fn* [source env] #@[source: [[def arg-count [length [cdr source]]] [when [not= arg-count 5] [exception :arity-error "[fn*] needs exactly 4 arguments" source]] [cdr! source] [list [bytecompile* [car source] env] [bytecompile* [cadr source] env] [bytecompile* [caddr source] env] [bytecompile* [cadddr source] env] [$fn/dynamic]]]] #{##[length source arg-count not= throw list :arity-error "[fn*] needs exactly 4 arguments" current-lambda bytecompile* env caddr cadddr [#$17]]
0E000E011204011A02070D0E030E02020504020B00180E040E051A061A070E01
0E08040004040401090004240D0E01121A01080D0E050E090E01110E0A04020E
090E0112110E0A04020E090E0B0E0104010E0A04020E090E0C0E0104010E0A04
021A0D040501
} bytecompile/macro* [source env] #@[source: [[def arg-count [length [cdr source]]] [when [not= arg-count 5] [exception :arity-error "[macro*] needs exactly 4 arguments" source]] [cdr! source] [list [bytecompile* [car source] env] [bytecompile* [cadr source] env] [bytecompile* [caddr source] env] [bytecompile* [cadddr source] env] [$macro/dynamic]]]] #{##[length source arg-count not= throw list :arity-error "[macro*] needs exactly 4 arguments" current-lambda bytecompile* env caddr cadddr [#$18]]
0E000E011204011A02070D0E030E02020504020B00180E040E051A061A070E01
0E08040004040401090004240D0E01121A01080D0E050E090E01110E0A04020E
090E0112110E0A04020E090E0B0E0104010E0A04020E090E0C0E0104010E0A04
021A0D040501
} bytecompile/environment* [source env] #@[source: [[list [$let] [bytecompile/do/form [cdr source] env] [$drop] [$closure/push] [$closure/pop]]]] #{##[list [#$15] bytecompile/do/form source env [#$D] [#$13] [#$16]]
0E001A010E020E03120E0404021A051A061A07040501
} bytecompile/let* [source env] #@[source: [[list [$let] [bytecompile/do [cadr source] env] [$closure/pop]]]] #{##[list [#$15] bytecompile/do source env [#$16]]
0E001A010E020E0312110E0404021A05040301
} bytecompile/return [source env] #@[source: [[list [bytecompile* [cadr source] env] [$ret]]]] #{##[list bytecompile* source env [#$1]]
0E000E010E0212110E0304021A04040201
} bytecompile/try [source env] #@[source: [[def end-sym [bytecompile/gen-label]] [list [bytecompile* [cadr source] env] [$try end-sym] [bytecompile/do/form [cddr source] env] [$closure/pop] [list :label end-sym]]]] #{##[bytecompile/gen-label end-sym list bytecompile* source env $try bytecompile/do/form [#$16] :label]
0E0004001A01070D0E020E030E0412110E0504020E060E0104010E070E041212
0E0504021A080E021A090E010402040501
} bytecompile* [source env] #@[documentation: "Compile the forms in source" source: ["Compile the forms in source" [def op [if [resolves? [car source] env] [resolve [car source] env] [car source]]] [case [type-of op] [[:lambda :native-function :pair :symbol] [case op [do [bytecompile/do source env]] [let* [bytecompile/let* source env]] [def [bytecompile/def source env]] [set! [bytecompile/set! source env]] [if [bytecompile/if source env]] [while [bytecompile/while source env]] [and [bytecompile/and source env]] [or [bytecompile/or source env]] [fn* [bytecompile/fn* source env]] [macro* [bytecompile/macro* source env]] [environment* [bytecompile/environment* source env]] [try [bytecompile/try source env]] [return [bytecompile/return source env]] '[bytecompile/quote [cadr source]] [otherwise [bytecompile/procedure op [cdr source] env [car source]]]]] [otherwise [if [pair? source] [exception :type-error "Can't evaluate that" source] [bytecompile/literal source]]]]]] #{##[resolves? source env resolve op type-of ΓεnΣym-3 :lambda :native-function :pair :symbol #f ΓεnΣym-4 do bytecompile/do let* bytecompile/let* def bytecompile/def set! bytecompile/set! if bytecompile/if while bytecompile/while and bytecompile/and or bytecompile/or fn* bytecompile/fn* macro* bytecompile/macro* environment* bytecompile/environment* try bytecompile/try return bytecompile/return quote bytecompile/quote bytecompile/procedure throw list :type-error "Can't evaluate that" current-lambda bytecompile/literal]
0E000E01110E0204020B000F0E030E01110E0204020900060E01111A04070D15
0E050E0404011A06070D0E061A07200C0A00240D0E061A08200C0A001A0D0E06
1A09200C0A00100D0E061A0A200C0A00060D1A0B0B0126150E041A0C070D0E0C
0E0D200B000E0E0E0E010E0204020901080E0C0E0F200B000E0E100E010E0204
020900F50E0C0E11200B000E0E120E010E0204020900E20E0C0E13200B000E0E
140E010E0204020900CF0E0C0E15200B000E0E160E010E0204020900BC0E0C0E
17200B000E0E180E010E0204020900A90E0C0E19200B000E0E1A0E010E020402
0900960E0C0E1B200B000E0E1C0E010E0204020900830E0C0E1D200B000E0E1E
0E010E0204020900700E0C0E1F200B000E0E200E010E02040209005D0E0C0E21
200B000E0E220E010E02040209004A0E0C0E23200B000E0E240E010E02040209
00370E0C0E25200B000E0E260E010E0204020900240E0C0E27200B000E0E280E
01121104010900110E290E040E01120E020E011104041609002A1A090E050E01
0401200B00180E2A0E2B1A2C1A2D0E010E2E0400040404010900090E2F0E0104
011601
} bytecompile [form environment] #@[source: [[list [bytecompile* form environment] [$ret]]]] #{##[list bytecompile* form environment [#$1]]
0E000E010E020E0304021A04040201
}]
02001A00070D1A011A021A031A04171A01070D1A051A061A071A08171A05070D
1A091A0A1A0B1A0C171A09070D1A0D1A0E1A0F1A10171A0D070D1A111A121A13
1A14171A11070D1A151A161A171A18171A15070D1A191A1A1A1B1A1C171A1907
0D1A1D1A1E1A1F1A20171A1D070D1A211A221A231A24171A21070D1A251A261A
271A28171A25070D1A291A2A1A2B1A2C171A29070D1A2D1A2E1A2F1A30171A2D
070D1A311A321A331A34171A31070D1A351A361A371A38171A35070D1A391A3A
1A3B1A3C171A39070D1A3D1A3E1A3F1A40171A3D070D1A411A421A431A44171A
41070D1A451A461A471A48171A45070D1A491A4A1A4B1A4C171A49070D1A4D1A
4E1A4F1A50171A4D070D1A511A521A531A54171A51070D1A551A561A571A5817
1A55070D1A591A5A1A5B1A5C171A59070D1A5D1A5E1A5F1A60171A5D070D1A61
1A621A631A64171A61070D1A651A661A671A68171A650701
}#{##[disassemble/length [op] #@[documentation: "Return the length in bytes of a bytecode operation and all its arguments" source: ["Return the length in bytes of a bytecode operation and all its arguments" [case op [[#$0 #$1 #$3 #$5 #$7 #$8 #$C #$D #$11 #$12 #$13 #$14 #$15 #$16 #$17 #$18 #$19 #$1B #$1C #$1E #$1F #$20 #$21 #$22 #$24 #$25 #$26 #$27 #$28 #$29 #$2A] 1] [[#$2 #$4 #$E #$1A] 2] [[#$6 #$9 #$A #$B #$F] 3] [otherwise [throw [list :unknown-op "This op needs its length specified for disassembly to work" op [current-lambda]]]]]]] #{##[op ΓεnΣym-1 #$0 #$1 #$3 #$5 #$7 #$8 #$C #$D #$11 #$12 #$13 #$14 #$15 #$16 #$17 #$18 #$19 #$1B #$1C #$1E #$1F #$20 #$21 #$22 #$24 #$25 #$26 #$27 #$28 #$29 #$2A #f #$2 #$4 #$E #$1A #$6 #$9 #$A #$B #$F throw list :unknown-op "This op needs its length specified for disassembly to work" current-lambda]
150E001A01070D0E011A02200C0A01320D0E011A03200C0A01280D0E011A0420
0C0A011E0D0E011A05200C0A01140D0E011A06200C0A010A0D0E011A07200C0A
01000D0E011A08200C0A00F60D0E011A09200C0A00EC0D0E011A0A200C0A00E2
0D0E011A0B200C0A00D80D0E011A0C200C0A00CE0D0E011A0D200C0A00C40D0E
011A0E200C0A00BA0D0E011A0F200C0A00B00D0E011A10200C0A00A60D0E011A
11200C0A009C0D0E011A12200C0A00920D0E011A13200C0A00880D0E011A1420
0C0A007E0D0E011A15200C0A00740D0E011A16200C0A006A0D0E011A17200C0A
00600D0E011A18200C0A00560D0E011A19200C0A004C0D0E011A1A200C0A0042
0D0E011A1B200C0A00380D0E011A1C200C0A002E0D0E011A1D200C0A00240D0E
011A1E200C0A001A0D0E011A1F200C0A00100D0E011A20200C0A00060D1A210B
000802010900830E011A22200C0A00240D0E011A23200C0A001A0D0E011A2420
0C0A00100D0E011A25200C0A00060D1A210B000802020900510E011A26200C0A
002E0D0E011A27200C0A00240D0E011A28200C0A001A0D0E011A29200C0A0010
0D0E011A2A200C0A00060D1A210B000802030900150E2B0E2C1A2D1A2E0E000E
2F0400040404011601
} bytecode/nil-catcher [error] #@[source: [[if [= [car error] :type-error] #nil [throw error]]]] #{##[error :type-error throw]
0E00111A01200B0007240900090E020E00040101
} bytecode-arr->val [a i] #@[documentation: "Read a bytecode encoded value in A at I and return it" source: ["Read a bytecode encoded value in A at I and return it" [try bytecode/nil-catcher [bytecode-op->val [ref a i] [ref a [+ 1 i]] [ref a [+ 2 i]]]]]] #{##[bytecode/nil-catcher bytecode-op->val ref a i]
0E001900260E010E020E030E0404020E020E0302010E042504020E020E030202
0E0425040204031601
} bytecode-arr->sym [a i] #@[documentation: "Read a bytecode encoded symbol in A at I and return it" source: ["Read a bytecode encoded symbol in A at I and return it" [try bytecode/nil-catcher [bytecode-op->sym [ref a i] [ref a [+ 1 i]] [ref a [+ 2 i]]]]]] #{##[bytecode/nil-catcher bytecode-op->sym ref a i]
0E001900260E010E020E030E0404020E020E0302010E042504020E020E030202
0E0425040204031601
} bytecode-op->offset [a b] #@[documentation: "Turn two bytecode ops encoding an offset into the integer representation" source: ["Turn two bytecode ops encoding an offset into the integer representation" [def t [bit-or [bit-shift-left [bytecode-op->int a] 8] [bytecode-op->int b]]] [if-not [> t 32768] t [- [- 65536 t]]]]] #{##[bit-or bit-shift-left bytecode-op->int a b t 32768 - 65536]
0E000E010E020E030401020804020E020E04040104021A05070D0E051A06220B
000F0E071A080E052604010900050E0501
} bytecode-arr->offset [a i] #@[documentation: "Read a bytecode encoded offset in A at I and return it as a signed integer" source: ["Read a bytecode encoded offset in A at I and return it as a signed integer" [bytecode-op->offset [ref a i] [ref a [+ 1 i]]]]] #{##[bytecode-op->offset ref a i]
0E000E010E020E0304020E010E0202010E03250402040201
} disassemble/maybe-quote [v] #@[documentation: "Quotes symbols but just passes through every other value" source: ["Quotes symbols but just passes through every other value" [if [symbol? v] [list 'quote v] v]]] #{##[symbol? v list quote]
0E000E0104010B000E0E021A030E0104020900050E0101
} disassemble/op [a i literals] #@[documentation: "Disassemble a single bytecode op in A at I and return it as an s-expression, that could be applied to eval" source: ["Disassemble a single bytecode op in A at I and return it as an s-expression, that could be applied to eval" [case [ref a i] [#$0 '[$nop]] [#$1 '[$ret]] [#$2 [quasiquote [$push/int/byte [unquote [bytecode-op->int [ref a [+ i 1]]]]]]] [#$3 '[$add/int]] [#$4 [quasiquote [$apply/dynamic [unquote [bytecode-op->int [ref a [+ i 1]]]]]]] [#$5 '[$get]] [#$6 [quasiquote [$push/val/ext [unquote [ref literals [bit-or [bytecode-op->int [ref a [+ i 1]]] [bit-shift-left [bytecode-op->int [ref a [+ i 2]]] 8]]]]]]] [#$7 [quasiquote [$def]]] [#$8 [quasiquote [$set]]] [#$9 [quasiquote [$jmp* [unquote [bytecode-arr->offset a [+ i 1]]]]]] [#$A [quasiquote [$jt* [unquote [bytecode-arr->offset a [+ i 1]]]]]] [#$B [quasiquote [$jf* [unquote [bytecode-arr->offset a [+ i 1]]]]]] [#$C '[$dup]] [#$D '[$drop]] [#$E [quasiquote [$get/val [unquote [disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]]] [#$F [quasiquote [$get/val/ext [unquote [ref literals [bit-or [bytecode-op->int [ref a [+ i 1]]] [bit-shift-left [bytecode-op->int [ref a [+ i 2]]] 8]]]]]]] [#$11 '[$car]] [#$12 '[$cdr]] [#$13 '[$closure/push]] [#$14 '[$cons]] [#$15 '[$let]] [#$16 '[$closure/pop]] [#$17 '[$fn/dynamic]] [#$18 '[$macro/dynamic]] [#$19 [quasiquote [$try [unquote [bytecode-arr->offset a [+ i 1]]]]]] [#$1A [quasiquote [$push/val [unquote [disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]]] [#$1E '[$<]] [#$1F '[$<=]] [#$20 '[$=]] [#$21 '[$>=]] [#$22 '[$>]] [#$24 '[$push/nil]] [#$25 '[$add]] [#$26 '[$sub]] [#$27 '[$mul]] [#$28 '[$div]] [#$29 '[$rem]] [#$2A '[$zero?]] [otherwise :unknown-op]]]] #{##[ref a i ΓεnΣym-2 #$0 [$nop] #$1 [$ret] #$2 $push/int/byte bytecode-op->int #$3 [$add/int] #$4 $apply/dynamic #$5 [$get] #$6 $push/val/ext literals bit-or bit-shift-left #$7 $def #$8 $set #$9 $jmp* bytecode-arr->offset #$A $jt* #$B $jf* #$C [$dup] #$D [$drop] #$E $get/val disassemble/maybe-quote #$F $get/val/ext #$11 [$car] #$12 [$cdr] #$13 [$closure/push] #$14 [$cons] #$15 [$let] #$16 [$closure/pop] #$17 [$fn/dynamic] #$18 [$macro/dynamic] #$19 $try #$1A $push/val #$1E [$<] #$1F [$<=] #$20 [$=] #$21 [$>=] #$22 [$>] #$24 [$push/nil] #$25 [$add] #$26 [$sub] #$27 [$mul] #$28 [$div] #$29 [$rem] #$2A [$zero?] :unknown-op]
150E000E010E0204021A03070D0E031A04200B00081A050902E00E031A06200B
00081A070902D30E031A08200B001A1A090E0A0E000E010E0202012504020401
2414140902B40E031A0B200B00081A0C0902A70E031A0D200B001A1A0E0E0A0E
000E010E02020125040204012414140902880E031A0F200B00081A1009027B0E
031A11200B00391A120E000E130E140E0A0E000E010E02020125040204010E15
0E0A0E000E010E0202022504020401020804020402040224141409023D0E031A
16200B000A1A17241409022E0E031A18200B000A1A19241409021F0E031A1A20
0B00161A1B0E1C0E010E0202012504022414140902040E031A1D200B00161A1E
0E1C0E010E0202012504022414140901E90E031A1F200B00161A200E1C0E010E
0202012504022414140901CE0E031A21200B00081A220901C10E031A23200B00
081A240901B40E031A25200B00241A260E270E000E130E0A0E000E010E020201
25040204010402040124141409018B0E031A28200B00391A290E000E130E140E
0A0E000E010E02020125040204010E150E0A0E000E010E020202250402040102
0804020402040224141409014D0E031A2A200B00081A2B0901400E031A2C200B
00081A2D0901330E031A2E200B00081A2F0901260E031A30200B00081A310901
190E031A32200B00081A3309010C0E031A34200B00081A350900FF0E031A3620
0B00081A370900F20E031A38200B00081A390900E50E031A3A200B00161A3B0E
1C0E010E0202012504022414140900CA0E031A3C200B00241A3D0E270E000E13
0E0A0E000E010E0202012504020401040204012414140900A10E031A3E200B00
081A3F0900940E031A40200B00081A410900870E031A42200B00081A4309007A
0E031A44200B00081A4509006D0E031A46200B00081A470900600E031A48200B
00081A490900530E031A4A200B00081A4B0900460E031A4C200B00081A4D0900
390E031A4E200B00081A4F09002C0E031A50200B00081A5109001F0E031A5220
0B00081A530900120E031A54200B00081A550900051A561601
} disassemble/array [a i literals] #@[documentation: "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" source: ["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" [def ret #nil] [while [< i [array/length a]] [cons! [cons i [disassemble/op a i literals]] ret] [set! i [+ i [disassemble/length [ref a i]]]]] [nreverse ret]]] #{##[ret i disassemble/op a literals disassemble/length ref array/length nreverse]
241A00070D2409002A0D0E010E020E030E010E040403140E00141A00080D0E01
0E050E060E030E0104020401251A01080E010E070E0304011E0AFFD00D0E080E
00040101
} disassemble/bytecode-array [code] #@[documentation: "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," source: ["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 [bytecode-literals code]]]] #{##[disassemble/array bytecode-arr->arr code bytecode-literals]
0E000E010E02040102000E030E020401040301
} disassemble/print [bc] #@[source: [[doseq [a [disassemble/bytecode-array bc]] [println [cat [ansi-blue [string/pad-start [string [car a]] 6]] " - " [cdr a]]]]]] #{##[disassemble/bytecode-array bc ΓεnΣym-3 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" a println cat ansi-blue string/pad-start string " - "]
150E000E0104011A02070D2409007A0D1A030E040E020401200B000724090019
0E050E061A071A080E000E0104010E090400040404010D0E040E0204011A0320
0B0007240900150E050E061A071A0A0E020E090400040404010D0E02111A0B07
0D0E0C0E0D0E0E0E0F0E100E0B1104010206040204011A110E0B12040304010D
0E02121A02080E020AFF871601
} disassemble [bc] #@[documentation: "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," source: ["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," [case [type-of bc] [[:lambda :macro] [disassemble/print [closure/code bc]]] [:bytecode-array [disassemble/print bc]] [otherwise [throw [list :type-error "Can't disassemble that" bc [current-lambda]]]]]]] #{##[type-of bc ΓεnΣym-4 :lambda :macro #f disassemble/print closure/code :bytecode-array throw list :type-error "Can't disassemble that" current-lambda]
150E000E0104011A02070D0E021A03200C0A00100D0E021A04200C0A00060D1A
050B00100E060E070E01040104010900260E021A08200B000C0E060E01040109
00150E090E0A1A0B1A0C0E010E0D0400040404011601
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B171A28070D1A2C1A2D1A2E1A2F171A2C0701
}#{##[compile/backend/none [expr] #@[source: [expr]] #{##[expr]
0E0001
} compile/backend/bytecode [expr] #@[source: [[-> [bytecompile expr] assemble*]]] #{##[assemble* bytecompile expr]
0E000E010E020401040101
} :bytecode *active-backend* tree/new :none backend/tree backend [expr] #@[source: [[[tree/ref backend/tree *active-backend*] expr]]] #{##[tree/ref backend/tree *active-backend* expr]
0E000E010E0204020E03040101
} compile/for [backend expr environment] #@[source: [[def last-backend *active-backend*] [def ret #nil] [try [fn [e] [set! *active-backend* last-backend] [throw e]] [set! *active-backend* backend] [set! ret [compile expr environment]] [set! *active-backend* last-backend] [return ret]]]] #{##[*active-backend* last-backend ret anonymous [e] #@[source: [[set! *active-backend* last-backend] [throw e]]] #{##[last-backend *active-backend* throw e]
0E001A01080D0E020E03040101
} backend compile* expr current-closure]
0E001A01070D241A02070D1A031A041A051A06171900210E071A00080D0E080E
090E0A040004021A02080D0E011A00080D0E02011601
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A09070D
0E0A1A080E041A0B0E0004041A0C070D1A0D1A0E1A0F1A10171A0D070D1A111A
121A131A14171A110701
}#{##[load/forms [source environment] #@[documentation: "Load multiple forms, evaluating the results in environment, so we can make use of macros we just defined" source: ["Load multiple forms, evaluating the results in environment, so we can make use of macros we just defined" [doseq [form source] [apply environment [compile* source environment]]]]] #{##[source ΓεnΣym-1 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" form apply environment compile*]
150E001A01070D240900660D1A020E030E010401200B0007240900150E040E05
1A061A070E000E080400040404010D0E030E0104011A02200B0007240900150E
040E051A061A090E010E080400040404010D0E01111A0A070D0E0B0E0C0E0D0E
000E0C040204020D0E01121A01080E010AFF9B1601
} macroexpand/forms [source-raw environment] #@[documentation: "Expand multiple forms, evaluating the source in a temporary environment, so we can make use of macros we just defined." source: ["Expand multiple forms, evaluating the source in a temporary environment, so we can make use of macros we just defined." [when-not environment [set! environment [environment*]]] [load/forms source-raw environment] [macroexpand source-raw environment]]] #{##[environment load/forms source-raw macroexpand]
0E000B00072409000B15240D13161A00080D0E010E020E0004020D0E030E020E
00040201
} compile* [source environment] #@[documentation: "Compile SOURCE so it can be evaluated/applied" source: ["Compile SOURCE so it can be evaluated/applied" [-> [macroexpand source environment] constant-fold backend]]] #{##[backend constant-fold macroexpand source environment]
0E000E010E020E030E0404020401040101
} compile/debug [expr] #@[source: [[disassemble [compile expr]]]] #{##[disassemble compile* expr current-closure]
0E000E010E020E0304000402040101
} compile/do* [source environment] #@[source: [[if [pair? source] [compile* [cons do source] environment] source]]] #{##[:pair type-of source compile* do environment]
1A000E010E020401200B00110E030E040E02140E0504020900050E0201
} compile [source] #@[documentation: "Compile SOURCE so it can be evaluated/applied" source: ["Compile SOURCE so it can be evaluated/applied" [quasiquote [compile* [unquote source] [current-closure]]]]] #{##[compile* source current-closure]
1A000E011A0224142414141401
} compile/do [source] #@[documentation: "Compile SOURCE so it can be evaluated/applied" source: ["Compile SOURCE so it can be evaluated/applied" [quasiquote [compile* [cons do [unquote source]] [current-closure]]]]] #{##[compile* cons do source current-closure]
1A001A011A020E03241414141A0424142414141401
} meta/parse/body [type args body] #@[source: [[def meta [tree/new #nil]] [doseq [v body] [case [type-of v] [:pair [return meta]] [:string [tree/set! meta :documentation [trim [cat [string [tree/ref meta :documentation]] "\n" v]]]] [:keyword [tree/set! meta v #t]]]] [return meta]]] #{##[tree/new meta body ΓεnΣym-2 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" v ΓεnΣym-3 :string tree/set! :documentation trim cat string tree/ref "\n" :keyword]
0E002404011A01070D150E021A03070D240900B20D1A040E050E030401200B00
07240900150E060E071A081A090E020E0A0400040404010D0E050E0304011A04
200B0007240900150E060E071A081A0B0E030E0A0400040404010D0E03111A0C
070D150E050E0C04011A0D070D0E0D1A04200B00090E01010900430E0D1A0E20
0B00260E0F0E011A100E110E120E130E140E011A10040204011A150E0C040304
0104030900180E0D1A16200B000F0E0F0E010E0C1B040309000424160D0E0312
1A03080E030AFF4F160D0E010101
} defmacro [name args . body] #@[documentation: "Define a new macro" source: ["Define a new macro" [quasiquote [def [unquote name] [macro* '[unquote name] '[unquote args] [unquote [tree/set! [meta/parse/body :macro args body] :source body]] '[unquote [compile/do* body [current-closure]]]]]]]] #{##[def name macro* quote args tree/set! meta/parse/body :macro body :source compile/do* current-closure]
1A000E011A021A030E012414141A030E042414140E050E061A070E040E080403
1A090E0804031A030E0A0E080E0B040004022414142414141414142414141401
} fn/check [args body] #@[source: [[when-not args [exception :type-error "Every function needs an argument list" args]] [while args [when-not [or [symbol? args] [pair? args]] [exception :type-error "Wrong type for argument list" args]] [cdr! args]] [when-not body [exception :type-error "Every function needs a body" body]]]] #{##[args throw list :type-error "Every function needs an argument list" current-lambda symbol? :pair type-of #f "Wrong type for argument list" body "Every function needs a body"]
0E000B0007240900150E010E021A031A040E000E050400040404010D2409003F
0D0E060E0004010C0A00140D1A070E080E000401200C0A00060D1A090B000724
0900150E010E021A031A0A0E000E050400040404010D0E00121A00080E000AFF
C20D0E0B0B0007240900150E010E021A031A0C0E0B0E0504000404040101
} fn [args . body] #@[documentation: "Define an anonymous function" source: ["Define an anonymous function" [fn/check args body] [quasiquote [fn* 'anonymous '[unquote args] [unquote [tree/set! [meta/parse/body :lambda args body] :source body]] '[unquote [compile/do* body [current-closure]]]]]]] #{##[fn/check args body fn* quote anonymous tree/set! meta/parse/body :lambda :source compile/do* current-closure]
0E000E010E0204020D1A031A041A052414141A040E012414140E060E071A080E
010E0204031A090E0204031A040E0A0E020E0B04000402241414241414141414
01
} defn [name args . body] #@[documentation: "Define a new function" source: ["Define a new function" [fn/check args body] [quasiquote [def [unquote name] [fn* '[unquote name] '[unquote args] [unquote [tree/set! [meta/parse/body :lambda args body] :source body]] '[unquote [compile/do* body [current-closure]]]]]]]] #{##[fn/check args body def name fn* quote tree/set! meta/parse/body :lambda :source compile/do* current-closure]
0E000E010E0204020D1A030E041A051A060E042414141A060E012414140E070E
081A090E010E0204031A0A0E0204031A060E0B0E020E0C040004022414142414
141414142414141401
} eval-in [closure expr] #@[documentation: "Compile and the immediatly evaluate the result\nMostly used by lRun()" source: ["Compile and the immediatly evaluate the result" "" "Mostly used by lRun()" [apply closure [compile* expr closure]]]] #{##[apply closure compile* expr]
0E000E010E020E030E010402040201
} eval [expr] #@[documentation: "Compile, Evaluate and then return the result of EXPR" source: ["Compile, Evaluate and then return the result of EXPR" [quasiquote [eval-in [current-closure] [unquote expr]]]]] #{##[eval-in current-closure expr]
1A001A0124140E022414141401
} typecheck/only [v t] #@[source: [[quasiquote [when-not [= [type-of [unquote v]] [unquote t]] [throw [list :type-error [unquote [fmt "Expected a value of type {t}"]] [unquote v] [current-lambda]]]]]]] #{##[when-not = type-of v t throw list :type-error cat "Expected a value of type " current-lambda]
1A001A011A020E032414140E04241414141A051A061A070E081A090E0404020E
031A0A24142414141414142414142414141401
} typecheck/numeric/single [v] #@[source: [[quasiquote [when-not [numeric? [unquote v]] [throw [list :type-error [unquote [fmt "Expected numeric value"]] [unquote v] [current-lambda]]]]]]] #{##[when-not numeric? v throw list :type-error "Expected numeric value" current-lambda]
1A001A010E022414141A031A041A051A060E021A072414241414141414241414
2414141401
} typecheck/numeric v #@[source: [[map v typecheck/numeric/single]]] #{##[map v typecheck/numeric/single]
0E000E010E02040201
} profile-form [raw] #@[source: [[def start-time [time/milliseconds]] [def val [eval raw]] [def end-time [time/milliseconds]] [display [cat "Evaluating " [ansi-yellow [string/write raw]] " to " [ansi-green [string/write val]] " took " [ansi-red [cat [- end-time start-time] "ms"] "\n"]]]]] #{##[time/milliseconds start-time eval-in current-closure raw val end-time print cat "Evaluating " ansi-yellow string/write " to " ansi-green " took " ansi-red "ms" "\n"]
0E0004001A01070D0E020E0304000E0404021A05070D0E0004001A06070D0E07
0E081A090E0A0E0B0E04040104011A0C0E0D0E0B0E05040104011A0E0E0F0E08
0E060E01261A1004021A1104020406040101
} profile body #@[documentation: "Measure and display how much time and ressources it takes for BODY to be evaluated" source: ["Measure and display how much time and ressources it takes for BODY to be evaluated" [quasiquote [profile-form '[unquote [if [last? body] [car body] [cons 'do body]]]]]]] #{##[profile-form quote nil? body do]
1A001A010E020E031204010B00090E03110900081A040E031424141424141401
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17181A14070D1A181A191A1A1A1B181A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23181A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B181A28070D1A2C1A2D1A2E1A2F181A2C070D1A301A31
1A321A33171A30070D1A341A351A361A37181A34070D1A381A391A3A1A3B181A
38070D1A3C1A3D1A3E1A3F171A3C070D1A401A411A421A43181A40070D1A441A
451A461A47171A44070D1A481A491A4A1A4B181A480701
}#{##[pure? [expr] #@[source: [[and [not [pair? expr]] [not [symbol? expr]] #t]]] #{##[:pair type-of expr symbol?]
1A000E010E020401200B00071C0900041B0C0B00180D0E030E0204010B00071C
0900041B0C0B00050D1B01
} constant-foldable? [fun] #@[source: [[meta fun :pure]]] #{##[meta fun :pure]
0E000E011A02040201
} constant-fold/resolve [sym] #@[source: [[when-not [symbol? sym] [return sym]] [resolve sym]]] #{##[symbol? sym resolve]
0E000E0104010B0007240900060E01010D0E020E01040101
} constant-fold/args [expr] #@[source: [[when-not expr [return expr]] [if [pair? [car expr]] [cons [constant-fold [car expr]] [constant-fold/args [cdr expr]]] [cons [car expr] [constant-fold/args [cdr expr]]]]]] #{##[expr :pair type-of constant-fold constant-fold/args]
0E000B0007240900060E00010D1A010E020E00110401200B00150E030E001104
010E040E001204011409000E0E00110E040E001204011401
} constant-fold [expr] #@[documentation: "Will try and evaluate as many constant as possible to make the expression simpler." source: ["Will try and evaluate as many constant as possible to make the expression simpler." [if-not [pair? expr] expr [do [def folded-fun [car expr]] [when [= 'quote folded-fun] [return expr]] [def folded-args [constant-fold/args [cdr expr]]] [if [and [constant-foldable? folded-fun] [every? folded-args pure?]] [try [fn [] [cons folded-fun folded-args]] [apply [constant-fold/resolve folded-fun] folded-args]] [cons folded-fun folded-args]]]]]] #{##[:pair type-of expr folded-fun quote constant-fold/args folded-args constant-foldable? every? pure? anonymous [] #@[source: [[cons folded-fun folded-args]]] #{##[folded-fun folded-args]
0E000E011401
} apply constant-fold/resolve]
1A000E010E020401200B005F0E02111A03070D1A040E03200B00090E02010900
04240D0E050E021204011A06070D0E070E0304010C0B000C0D0E080E060E0904
020B001F1A0A1A0B1A0C1A0D171900100E0E0E0F0E0304010E06040216090008
0E030E06140900050E0201
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
01
}#{##[macroexpand/do/args [args env] #@[source: [[if [last? args] [cons [macroexpand* [car args] env] #nil] [if [pair? [car args]] [let* [def ocar [macroexpand* [car args] env]] [if [pair? ocar] [cons ocar [macroexpand/do/args [cdr args] env]] [macroexpand/do/args [cdr args] env]]] [macroexpand/do/args [cdr args] env]]]]] #{##[nil? args macroexpand* env :pair type-of ocar macroexpand/do/args]
0E000E011204010B00110E020E01110E030402241409004F1A040E050E011104
01200B0039150E020E01110E0304021A06070D1A040E050E060401200B00120E
060E070E01120E0304021409000C0E070E01120E0304021609000C0E070E0112
0E03040201
} macroexpand/do [source env] #@[source: [[def args [macroexpand/do/args source env]] [if [last? args] [car args] [cons 'do args]]]] #{##[macroexpand/do/args source env args nil? do]
0E000E010E0204021A03070D0E040E031204010B00090E03110900081A050E03
1401
} macroexpand/form [source env op arity implicit-do? no-expand-bitmap] #@[source: [[def ret [cons op #nil]] [def l [cdr source]] [dotimes [i arity] [cons! [if [bit-test? no-expand-bitmap i] [car l] [macroexpand* [car l] env]] ret] [cdr! l]] [if implicit-do? [set! ret [cons [macroexpand/do l env] ret]] [when l [throw [list :arity-error [cat "form contains more than " arity " arguments"] source [current-lambda]]]]] [return [nreverse ret]]]] #{##[op ret source l i bit-test? no-expand-bitmap macroexpand* env arity implicit-do? macroexpand/do throw list :arity-error cat "form contains more than " " arguments" current-lambda nreverse]
0E0024141A01070D0E02121A03070D1502001A04070D240900340D0E050E060E
0404020B00090E031109000C0E070E03110E0804020E01141A01080D0E03121A
03080D02010E04031A04080E040E091E0AFFCA0D24160D0E0A0B00140E0B0E03
0E0804020E01141A01080900260E030B00200E0C0E0D1A0E0E0F1A100E091A11
04030E020E12040004040401090004240D0E130E0104010101
} macroexpand/fold [op source env] #@[source: [[if [cdr source] [if [cddr source] [list op [macroexpand/fold op [except-last-pair source] env] [macroexpand* [car [last-pair source]] env]] [list op [macroexpand* [car source] env] [macroexpand* [cadr source] env]]] [list op [macroexpand* [car source] env]]]]] #{##[source list op macroexpand/fold except-last-pair env macroexpand* last-pair]
0E00120B004A0E0012120B00270E010E020E030E020E040E0004010E0504030E
060E070E000401110E050402040309001C0E010E020E060E00110E0504020E06
0E0012110E05040204030900120E010E020E060E00110E050402040201
} macroexpand* [source env] #@[documentation: "Expand all macros within source" source: ["Expand all macros within source" [def op [if [resolves? [car source] env] [resolve [car source] env] [car source]]] [case [type-of op] [:nil source] [:macro [macroexpand* [macro-apply op [cdr source]] env]] [:native-function [case op 'source [do [macroexpand/do source env]] [return [macroexpand/form source env op 1 #f 0]] [[try while] [macroexpand/form source env op 1 #t 0]] [[def set!] [macroexpand/form source env op 2 #f 1]] [if [macroexpand/form source env op 3 #f 0]] [[fn* macro*] [macroexpand/form source env op 4 #t 7]] [[let* environment*] [list op [macroexpand/do [cdr source] env]]] [otherwise [if [meta op :fold] [macroexpand/fold op [cdr source]] [map source [fn [α] [macroexpand* α env]]]]]]] [otherwise [map source [fn [α] [macroexpand* α env]]]]]]] #{##[resolves? source env resolve op type-of ΓεnΣym-1 :nil :macro macroexpand* macro-apply :native-function ΓεnΣym-2 quote do macroexpand/do return macroexpand/form try while #f def set! if fn* macro* let* environment* list meta :fold macroexpand/fold map anonymous [α] #@[source: [[macroexpand* α env]]] #{##[macroexpand* α env]
0E000E010E02040201
} [α] #{##[macroexpand* α env]
0E000E010E02040201
}]
0E000E01110E0204020B000F0E030E01110E0204020900060E01111A04070D15
0E050E0404011A06070D0E061A07200B00080E010901650E061A08200B00150E
090E0A0E040E011204020E02040209014B0E061A0B200B0134150E041A0C070D
0E0C0E0D200B00080E0109011C0E0C0E0E200B000E0E0F0E010E020402090109
0E0C0E10200B00150E110E010E020E0402011C020004060900EF0E0C0E12200C
0A00100D0E0C0E13200C0A00060D1A140B00150E110E010E020E0402011B0200
04060900C40E0C0E15200C0A00100D0E0C0E16200C0A00060D1A140B00150E11
0E010E020E0402021C020104060900990E0C0E17200B00150E110E010E020E04
02031C0200040609007F0E0C0E18200C0A00100D0E0C0E19200C0A00060D1A14
0B00150E110E010E020E0402041B020704060900540E0C0E1A200C0A00100D0E
0C0E1B200C0A00060D1A140B00150E1C0E040E0F0E01120E0204020402090029
0E1D0E041A1E04020B000F0E1F0E040E011204020900120E200E011A211A221A
231A24170402160900120E200E011A211A251A231A261704021601
} macroexpand [source env] #@[documentation: "Macroexpand the forms in source" source: ["Macroexpand the forms in source" [macroexpand* source [or env [current-closure]]]]] #{##[macroexpand* source env current-closure #f]
0E000E010E020C0A000F0D0E0304000C0A00060D1A04040201
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A140701
}#{##[let/arg [arg] #@[source: [[when arg [when [or [not [pair? arg]] [not [symbol? [car arg]]]] [throw [list :invalid-let-form "Please fix the structure of the let form" arg]]] [quasiquote [def [unquote [car arg]] [unquote [cadr arg]]]]]]] #{##[arg :pair type-of symbol? #f throw list :invalid-let-form "Please fix the structure of the let form" def]
0E000B00551A010E020E000401200B00071C0900041B0C0A001A0D0E030E0011
04010B00071C0900041B0C0A00060D1A040B00140E050E061A071A080E000403
0401090004240D1A090E00110E001211241414140900042401
} let/args [args] #@[source: [[if-not args #nil [cons [let/arg [car args]] [let/args [cdr args]]]]]] #{##[args let/arg let/args]
0E000B00150E010E001104010E020E00120401140900042401
} let [bindings . body] #@[documentation: "Evalutes to BODY if PRED is true" source: ["Evalutes to BODY if PRED is true" [quasiquote [let* [do [unquote-splicing [let/args bindings]] [unquote-splicing body]]]]]] #{##[let* do append let/args bindings body]
1A001A010E020E030E0404010E020E0524040204021424141401
} if-let [binding then else] #@[source: [[quasiquote [let* [def [unquote [car binding]] [unquote [cadr binding]]] [if [unquote [car binding]] [unquote then] [unquote else]]]]]] #{##[let* def binding if then else]
1A001A010E02110E021211241414141A030E02110E040E052414141414241414
1401
} when-let [binding . body] #@[source: [[quasiquote [if-let [unquote binding] [unquote [cons 'do body]] #nil]]]] #{##[if-let binding do body]
1A000E011A020E031424241414141401
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B181A08070D1A0C1A0D1A0E1A0F181A0C070D1A101A111A121A13181A1007
01
}#{##[otherwise deftest l #@[source: []] #{##[]
2401
} defqtest #{##[]
2401
} comment body #@[documentation: "Does nothing" source: ["Does nothing" #nil]] #{##[]
2401
} += [val inc] #@[source: [[quasiquote [set! [unquote val] [+ [unquote val] [unquote inc]]]]]] #{##[set! val + inc]
1A000E011A020E010E03241414142414141401
} cdr! [l] #@[documentation: "[set! l [cdr l]]" source: ["[set! l [cdr l]]" [quasiquote [set! [unquote l] [cdr [unquote l]]]]]] #{##[set! l cdr]
1A000E011A020E012414142414141401
} boolean [v] #@[documentation: "Coerce to boolean" source: [:inline "Coerce to boolean" [if v #t #f]] inline: #t] #{##[v]
0E000B00071B0900041C01
} not [v] #@[documentation: "Return true if V is false" source: [:inline "Return true if V is false" [if v #f #t]] inline: #t] #{##[v]
0E000B00071C0900041B01
} identity [α] #@[documentation: "Returns its argument" source: [:inline "Returns its argument" α] inline: #t] #{##[α]
0E0001
} list arguments #@[documentation: "Return ARGUMENTS as a list" source: ["Return ARGUMENTS as a list" arguments]] #{##[arguments]
0E0001
} caar [p] #@[documentation: "[car [car p]]" source: [:inline "[car [car p]]" [car [car p]]] inline: #t] #{##[p]
0E00111101
} cadr [p] #@[documentation: "[car [cdr p]]" source: [:inline "[car [cdr p]]" [car [cdr p]]] inline: #t] #{##[p]
0E00121101
} cdar [p] #@[documentation: "[cdr [car p]]" source: [:inline "[cdr [car p]]" [cdr [car p]]] inline: #t] #{##[p]
0E00111201
} cddr [p] #@[documentation: "[cdr [cdr p]]" source: [:inline "[cdr [cdr p]]" [cdr [cdr p]]] inline: #t] #{##[p]
0E00121201
} cadar [p] #@[documentation: "[cdr [car p]]" source: ["[cdr [car p]]" [car [cdr [car p]]]]] #{##[p]
0E0011121101
} caddr [p] #@[documentation: "[car [cdr [cdr p]]]" source: ["[car [cdr [cdr p]]]" [car [cdr [cdr p]]]]] #{##[p]
0E0012121101
} cdddr [p] #@[documentation: "[cdr [cdr [cdr p]]]" source: ["[cdr [cdr [cdr p]]]" [cdr [cdr [cdr p]]]]] #{##[p]
0E0012121201
} cadddr [p] #@[documentation: "[car [cdr [cdr [cdr p]]]]" source: ["[car [cdr [cdr [cdr p]]]]" [car [cdr [cdr [cdr p]]]]]] #{##[p]
0E001212121101
} cddddr [p] #@[documentation: "[car [cdr [cdr [cdr p]]]]" source: ["[car [cdr [cdr [cdr p]]]]" [cdr [cdr [cdr [cdr p]]]]]] #{##[p]
0E001212121201
} caddddr [p] #@[documentation: "[car [cdr [cdr [cdr p]]]]" source: ["[car [cdr [cdr [cdr p]]]]" [car [cdr [cdr [cdr [cdr p]]]]]]] #{##[p]
0E00121212121101
} cdddddr [p] #@[documentation: "[cdr [cdr [cdr [cdr p]]]]" source: ["[cdr [cdr [cdr [cdr p]]]]" [cdr [cdr [cdr [cdr [cdr p]]]]]]] #{##[p]
0E00121212121201
} keyword->string [α] #@[source: [[when-not [keyword? α] [throw [list :type-error "[keyword->string] can only be called on keywords" α [current-lambda]]]] [symbol->string [keyword->symbol α]]]] #{##[keyword? α throw list :type-error "[keyword->string] can only be called on keywords" current-lambda symbol->string keyword->symbol]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
0E070E080E010401040101
} string->keyword [α] #@[source: [[when-not [string? α] [throw [list :type-error "[string->keyword] can only be called on strings" α [current-lambda]]]] [symbol->keyword [string->symbol α]]]] #{##[string? α throw list :type-error "[string->keyword] can only be called on strings" current-lambda symbol->keyword string->symbol]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
0E070E080E010401040101
} exception [type description value] #@[source: [[quasiquote [throw [list [unquote type] [unquote description] [unquote value] [current-lambda]]]]]] #{##[throw list type description value current-lambda]
1A001A010E020E030E041A05241424141414141424141401
}]
1B1A00070D1A011A021A031A04181A01070D1A051A021A031A06181A05070D1A
071A081A091A0A181A07070D1A0B1A0C1A0D1A0E181A0B070D1A0F1A101A111A
12181A0F070D1A131A141A151A16171A13070D1A171A181A191A1A171A17070D
1A1B1A1C1A1D1A1E171A1B070D1A1F1A201A211A22171A1F070D1A231A241A25
1A26171A23070D1A271A281A291A2A171A27070D1A2B1A2C1A2D1A2E171A2B07
0D1A2F1A301A311A32171A2F070D1A331A341A351A36171A33070D1A371A381A
391A3A171A37070D1A3B1A3C1A3D1A3E171A3B070D1A3F1A401A411A42171A3F
070D1A431A441A451A46171A43070D1A471A481A491A4A171A47070D1A4B1A4C
1A4D1A4E171A4B070D1A4F1A501A511A52171A4F070D1A531A541A551A56171A
53070D1A571A581A591A5A181A570701
}#{##[if-not [pred then else] #@[source: [[quasiquote [if [unquote pred] [unquote else] [unquote then]]]]] #{##[if pred else then]
1A000E010E020E03241414141401
} when-not [pred . body] #@[documentation: "Evalutes to BODY if PRED is false" source: ["Evalutes to BODY if PRED is false" [quasiquote [if [unquote pred] #nil [do [unquote-splicing body]]]]]] #{##[if pred do append body]
1A000E01241A020E030E0424040214241414141401
} when [pred . body] #@[documentation: "Evalutes to BODY if PRED is true" source: ["Evalutes to BODY if PRED is true" [quasiquote [if [unquote pred] [do [unquote-splicing body]] #nil]]]] #{##[if pred do append body]
1A000E011A020E030E042404021424241414141401
} case/clauses/multiple [key-sym cases] #@[source: [[when cases [cons [list '= key-sym [car cases]] [case/clauses/multiple key-sym [cdr cases]]]]]] #{##[cases list = key-sym case/clauses/multiple]
0E000B001B0E011A020E030E001104030E040E030E00120402140900042401
} case/clauses [key-sym clauses] #@[source: [[when 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]]]]]]] #{##[clauses otherwise do list if :pair type-of quote nil? symbol? = key-sym or case/clauses/multiple case/clauses]
0E000B00920E0011111A01200B000D1A020E0011121409007B0E031A041A050E
060E0011110401200B004B0E001111111A07200C0B001D0D0E080E0011111212
04010C0B000E0D0E090E001111121104010B00120E031A0A0E0B0E0011110403
0900101A0C0E0D0E0B0E00111104021409000F0E031A0A0E0B0E00111104031A
020E001112140E0E0E0B0E0012040204040900042401
} case [key-form . clauses] #@[source: [[def key-sym [gensym]] [list 'let* [list 'def key-sym key-form] [case/clauses key-sym clauses]]]] #{##[gensym key-sym list let* def key-form case/clauses clauses]
0E0004001A01070D0E021A030E021A040E010E0504030E060E010E0704020403
01
} cond body #@[documentation: "Contains multiple cond clauses" source: ["Contains multiple cond clauses" [when [and body [caar body]] [list 'if [caar body] [cons 'do [cdar body]] [macro-apply cond [cdr body]]]]]] #{##[body list if do macro-apply cond]
0E000C0B00080D0E0011110B00200E011A020E0011111A030E001112140E040E
050E0012040204040900042401
} dotimes [binding . body] #@[documentation: "binding => [name n result-form]\nRepeatedly executes body with name bound to integers from 0 through n-1. Returns result-form or #nil." source: ["binding => [name n result-form]" "Repeatedly executes body with name bound to integers from 0 through n-1. Returns result-form or #nil." [def sym [car binding]] [typecheck/only sym :symbol] [def times [cadr binding]] [def result-form [caddr binding]] [quasiquote [let [[[unquote sym] 0]] [while [< [unquote sym] [unquote times]] [unquote-splicing body] [set! [unquote sym] [add/int 1 [unquote sym]]]] [unquote result-form]]]]] #{##[binding sym type-of :symbol throw list :type-error "Expected a value of type :symbol" current-lambda times caddr result-form let while < append body set! add/int]
0E00111A01070D0E020E0104011A03200B0007240900150E040E051A061A070E
010E080400040404010D0E0012111A09070D0E0A0E0004011A0B070D1A0C0E01
020024141424141A0D1A0E0E010E09241414140E0F0E101A110E011A1202010E
0124141414241414142414040214140E0B241414141401
} doseq [for-loop . body] #@[documentation: "[doseq [l [list 1 2 3 4]] [println l]]" source: ["[doseq [l [list 1 2 3 4]] [println l]]" [def symbol-name [gensym]] [quasiquote [let [[[unquote symbol-name] [unquote [cadr for-loop]]]] [while [unquote symbol-name] [when-not [pair? [unquote symbol-name]] [exception :type-error "Improper list detected, please provide a proper list instead" [unquote [cadr for-loop]]]] [typecheck/only [unquote symbol-name] :pair] [def [unquote [car for-loop]] [car [unquote symbol-name]]] [unquote-splicing body] [cdr! [unquote symbol-name]]]]]]] #{##[gensym symbol-name let for-loop while when-not pair? exception :type-error "Improper list detected, please provide a proper list instead" typecheck/only :pair def car append body cdr!]
0E0004001A01070D1A020E010E03121124141424141A040E011A051A060E0124
14141A071A081A090E0312112414141414241414141A0A0E011A0B241414141A
0C0E03111A0D0E01241414241414140E0E0E0F1A100E01241414241404021414
1414142414141401
} thread/-> [init fun] #@[source: [[if-not fun init [if [pair? [car fun]] [quasiquote [[unquote [caar fun]] [unquote [thread/-> init [cdr fun]]] [unquote-splicing [cdar fun]]]] [list [car fun] [thread/-> init [cdr fun]]]]]]] #{##[fun :pair type-of thread/-> init append list]
0E000B003E1A010E020E00110401200B001E0E0011110E030E040E001204020E
050E00111224040214140900130E060E00110E030E040E001204020402090005
0E0401
} -> [init . fun] #@[documentation: "Thread init as the first argument through every function in fun" source: ["Thread init as the first argument through every function in fun" [thread/-> init [reverse fun]]]] #{##[thread/-> init reverse fun]
0E000E010E020E030401040201
} thread/->> [init fun] #@[source: [[if-not fun init [append [car fun] [cons [thread/->> init [cdr fun]] #nil]]]]] #{##[fun append thread/->> init]
0E000B00180E010E00110E020E030E00120402241404020900050E0301
} ->> [init . fun] #@[documentation: "Thread init as the last argument through every function in fun" source: ["Thread init as the last argument through every function in fun" [thread/->> init [reverse fun]]]] #{##[thread/->> init reverse fun]
0E000E010E020E030401040201
}]
1A001A011A021A03181A00070D1A041A051A061A07181A04070D1A081A091A0A
1A0B181A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17181A14070D1A181A191A1A1A1B181A18070D1A1C1A1D1A
1E1A1F181A1C070D1A201A211A221A23181A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B181A28070D1A2C1A2D1A2E1A2F171A2C070D1A301A31
1A321A33181A300701
}#{##[tree/new module/cache module/store module/loader module/add-loader [f] #@[source: [[set! module/loader [cons f module/loader]]]] #{##[f module/loader]
0E000E01141A010801
} module/save-state [] #@[source: [[tree/new :cache module/cache :loader module/loader]]] #{##[tree/new :cache module/cache :loader module/loader]
0E001A010E021A030E04040401
} module/restore-state [c] #@[source: [[set! module/cache [tree/ref c :cache]] [set! module/loader [tree/ref c :loader]]]] #{##[tree/ref c :cache module/cache :loader module/loader]
0E000E011A0204021A03080D0E000E011A0404021A050801
} module/qualify-symbol [module-name symbol] #@[source: [[string->symbol [cat [keyword->symbol module-name] "/" [string symbol]]]]] #{##[string->symbol cat keyword->symbol module-name "/" string symbol]
0E000E010E020E0304011A040E050E0604010403040101
} module body #@[documentation: "Define a new module and return it" source: ["Define a new module and return it" [macroexpand [cons 'environment* [cons '[def exports [tree/new #nil]] body]]]]] #{##[macroexpand environment* [def exports [tree/new #nil]] body]
0E001A011A020E031414040101
} defmodule [name . body] #@[documentation: "Define a new named module" source: ["Define a new named module" [quasiquote [module/insert [unquote name] [module [def *module* [unquote name]] [unquote-splicing body]]]]]] #{##[module/insert name module def *module* append body]
1A000E011A021A031A040E01241414140E050E0624040214142414141401
} defmodule/defer [name . body] #@[documentation: "Define a new named module" source: ["Define a new named module" [quasiquote [module/insert/defer [unquote name] [string/write [unquote [list 'quote [cons 'do body]]]]]]]] #{##[module/insert/defer name string/write list quote do body]
1A000E011A020E031A041A050E061404022414142414141401
} export [name value] #@[source: [[quasiquote [tree/set! exports '[unquote name] [unquote value]]]]] #{##[tree/set! exports quote name value]
1A001A011A020E032414140E04241414141401
} require* [module env qualify?] #@[source: [[def mod [module/load module]] [def exports [resolve 'exports mod]] [doseq [k [tree/keys exports]] [def q [if qualify? [module/qualify-symbol module [keyword->symbol k]] [keyword->symbol k]]] [def expr [quasiquote [def [unquote q] [module/import [unquote mod] '[unquote [keyword->symbol k]]]]]] [apply env [compile* expr env]]]]] #{##[module/load module mod resolve exports tree/keys ΓεnΣym-1 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" k qualify? module/qualify-symbol keyword->symbol q def module/import quote expr apply env compile*]
0E000E0104011A02070D0E031A040E0204021A04070D150E050E0404011A0607
0D240900A70D1A070E080E060401200B0007240900190E090E0A1A0B1A0C0E05
0E0404010E0D0400040404010D0E080E0604011A07200B0007240900150E090E
0A1A0B1A0E0E060E0D0400040404010D0E06111A0F070D0E100B00120E110E01
0E120E0F040104020900090E120E0F04011A13070D1A140E131A150E021A160E
120E0F040124141424141414241414141A17070D0E180E190E1A0E170E190402
04020D0E06121A06080E060AFF5A1601
} use [module] #@[source: [[quasiquote [require* [unquote module] [current-closure] #f]]]] #{##[require* module current-closure]
1A000E011A0224141C241414141401
} require [module] #@[source: [[quasiquote [require* [unquote module] [current-closure] #t]]]] #{##[require* module current-closure]
1A000E011A0224141B241414141401
} import* [local-symbol module module-symbol] #@[source: [[quasiquote [def [unquote local-symbol] [module/import [unquote module] '[unquote module-symbol]]]]]] #{##[def local-symbol module/import module quote module-symbol]
1A000E011A020E031A040E05241414241414142414141401
} import [names module] #@[source: [[when-not [list? names] [return [quasiquote [import* [unquote names] [module/load [unquote module]] [unquote names]]]]] [def ret #nil] [while names [if [= [cadr names] :as] [do [set! ret [cons [quasiquote [import* [unquote [caddr names]] [module/load [unquote module]] [unquote [car names]]]] ret]] [set! names [cddr names]]] [set! ret [cons [quasiquote [import* [unquote [car names]] [module/load [unquote module]] [unquote [car names]]]] ret]]] [cdr! names]] [cons do [nreverse ret]]]] #{##[list? names import* module/load module ret :as caddr do nreverse]
0E000E0104010B0007240900161A020E011A030E042414140E01241414141401
0D241A05070D240900570D0E0112111A06200B002B1A020E070E0104011A030E
042414140E011124141414140E05141A05080D0E0112121A010809001D1A020E
01111A030E042414140E011124141414140E05141A05080D0E01121A01080E01
0AFFAA0D0E080E090E0504011401
} module/load/cache [name] #@[source: [[tree/ref module/cache name]]] #{##[tree/ref module/cache name]
0E000E010E02040201
} module/load/store [name] #@[source: [[def source [tree/ref module/store name]] [when source [eval-in [environment*] [quasiquote [defmodule [unquote name] [unquote-splicing [read source]]]]] [module/load/cache name]]]] #{##[tree/ref module/store name source eval-in defmodule append read module/load/cache]
0E000E010E0204021A03070D0E030B00270E0415240D13161A050E020E060E07
0E030401240402141404020D0E080E0204010900042401
} module/load/external [name] #@[source: [[doseq [loader module/loader] [def mod [loader name]] [when mod [tree/set! module/cache name mod] [return mod]]] [return #nil]]] #{##[module/loader ΓεnΣym-2 :pair type-of throw list :type-error "Improper list detected, please provide a proper list instead" current-lambda "Expected a value of type :pair" loader name mod tree/set! module/cache]
150E001A01070D240900790D1A020E030E010401200B0007240900150E040E05
1A061A070E000E080400040404010D0E030E0104011A02200B0007240900150E
040E051A061A090E010E080400040404010D0E01111A0A070D0E0A0E0B04011A
0C070D0E0C0B00140E0D0E0E0E0B0E0C04030D0E0C01090004240D0E01121A01
080E010AFF88160D240101
} module/insert/defer [name module-source] #@[source: [[tree/set! module/store name module-source]]] #{##[tree/set! module/store name module-source]
0E000E010E020E03040301
} module/insert [name module] #@[source: [[tree/set! module/cache name module]]] #{##[tree/set! module/cache name module]
0E000E010E020E03040301
} module/load [name] #@[source: [[case [type-of name] [:object name] [:keyword [or [module/load/cache name] [module/load/store name] [module/load/external name]]] [otherwise [exception "Can't load that value as a module" name]]]]] #{##[type-of name ΓεnΣym-3 :object :keyword module/load/cache module/load/store module/load/external #f throw list "Can't load that value as a module" current-lambda]
150E000E0104011A02070D0E021A03200B00080E010900420E021A04200B0029
0E050E0104010C0A001C0D0E060E0104010C0A00110D0E070E0104010C0A0006
0D1A080900140E090E0A1A0B0E01240E0C0400040404011601
} module/import-all [module symbol] #@[source: [[def exports [resolve 'exports module]] [typecheck/only exports :tree] [return exports]]] #{##[resolve exports module type-of :tree throw list :type-error "Expected a value of type :tree" current-lambda]
0E001A010E0204021A01070D0E030E0104011A04200B0007240900150E050E06
1A071A080E010E090400040404010D0E010101
} module/import [module symbol] #@[source: [[def exports [module/import-all module symbol]] [when-not [tree/has? exports symbol] [exception :import-error [if [resolves? symbol module] "That symbol was not exported" "That symbol does not exist in that module"]]] [tree/ref exports symbol]]] #{##[module/import-all module symbol exports tree/has? throw list :import-error resolves? "That symbol was not exported" "That symbol does not exist in that module" current-lambda tree/ref]
0E000E010E0204021A03070D0E040E030E0204020B0007240900240E050E061A
070E080E020E0104020B00081A090900051A0A240E0B0400040404010D0E0C0E
030E02040201
}]
0E002404011A01070D0E002404011A02070D241A03070D1A041A051A061A0717
1A04070D1A081A091A0A1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A10
1A111A121A13171A10070D1A141A151A161A17181A14070D1A181A191A1A1A1B
181A18070D1A1C1A1D1A1E1A1F181A1C070D1A201A211A221A23181A20070D1A
241A251A261A27171A24070D1A281A291A2A1A2B181A28070D1A2C1A2D1A2E1A
2F181A2C070D1A301A311A321A33181A30070D1A341A351A361A37181A34070D
1A381A391A3A1A3B171A38070D1A3C1A3D1A3E1A3F171A3C070D1A401A411A42
1A43171A40070D1A441A451A461A47171A44070D1A481A491A4A1A4B171A4807
0D1A4C1A4D1A4E1A4F171A4C070D1A501A511A521A53171A50070D1A541A551A
561A57171A540701
}#{##[numeric? [a] #@[documentation: "Return #t if a is a number" source: ["Return #t if a is a number" [or [int? a] [float? a]]]] #{##[int? a float? #f]
0E000E0104010C0A00110D0E020E0104010C0A00060D1A0301
} last? [a] #@[documentation: "Return #t if a is the last pair in a list" source: [:inline "Return #t if a is the last pair in a list" [nil? [cdr a]]] inline: #t] #{##[nil? a]
0E000E0112040101
} pos? [a] #@[documentation: "Return #t if a is positive" source: [:inline "Return #t if a is positive" [>= a 0.0]] inline: #t] #{##[a 0.0]
0E001A012101
} zero-neg? [a] #@[documentation: "Return #t if a is zero or negative" source: [:inline "Return #t if a is zero or negative" [<= a 0.0]] inline: #t] #{##[a 0.0]
0E001A011F01
} neg? [a] #@[documentation: "Returns #t if a is negative" source: [:inline "Returns #t if a is negative" [< a 0.0]] inline: #t] #{##[a 0.0]
0E001A011E01
} odd? [a] #@[documentation: "Predicate that returns #t if a is odd" source: ["Predicate that returns #t if a is odd" [= [rem [int a] 2] 1]]] #{##[int a]
0E000E01040102022902012001
} even? [a] #@[documentation: "Predicate that returns #t if a is even" source: ["Predicate that returns #t if a is even" [= [mod/int [int a] 2] 0]]] #{##[mod/int int a]
0E000E010E0204010202040202002001
} not-zero? [val] #@[documentation: "#t if VAL is not zero" source: [:inline "#t if VAL is not zero" [not= 0 val]] inline: #t] #{##[not= val]
0E0002000E01040201
} equal? [a b] #@[documentation: "High level equality comparator, can also recursively test lists/arrays for equivalence, can be slow." source: ["High level equality comparator, can also recursively test lists/arrays for equivalence, can be slow." [def cur-type [type-of a]] [if [not= cur-type [type-of b]] #f [case cur-type [:array [array/equal? a b]] [:tree [tree/equal? a b]] [:pair [list/equal? a b]] [otherwise [= a b]]]]]] #{##[type-of a cur-type not= b ΓεnΣym-1 :array array/equal? :tree tree/equal? :pair list/equal?]
0E000E0104011A02070D0E030E020E000E04040104020B00071C090049150E02
1A05070D0E051A06200B000E0E070E010E04040209002E0E051A08200B000E0E
090E010E04040209001B0E051A0A200B000E0E0B0E010E0404020900080E010E
04201601
} inequal? [a b] #@[documentation: "High level inequality comparator" source: ["High level inequality comparator" [not [equal? a b]]]] #{##[equal? a b]
0E000E010E0204020B00071C0900041B01
} int? [val] #@[source: [[= :int [type-of val]]]] #{##[:int type-of val]
1A000E010E0204012001
} float? [val] #@[source: [[= :float [type-of val]]]] #{##[:float type-of val]
1A000E010E0204012001
} boolean? [val] #@[source: [[= :bool [type-of val]]]] #{##[:bool type-of val]
1A000E010E0204012001
} pair? [val] #@[source: [:inline [= :pair [type-of val]]] inline: #t] #{##[:pair type-of val]
1A000E010E0204012001
} array? [val] #@[source: [[= :array [type-of val]]]] #{##[:array type-of val]
1A000E010E0204012001
} string? [val] #@[source: [[= :string [type-of val]]]] #{##[:string type-of val]
1A000E010E0204012001
} symbol? [val] #@[source: [[= :symbol [type-of val]]]] #{##[:symbol type-of val]
1A000E010E0204012001
} object? [val] #@[source: [[= :object [type-of val]]]] #{##[:object type-of val]
1A000E010E0204012001
} tree? [val] #@[source: [[= :tree [type-of val]]]] #{##[:tree type-of val]
1A000E010E0204012001
} keyword? [v] #@[source: [[= :keyword [type-of v]]]] #{##[:keyword type-of v]
1A000E010E0204012001
} macro? [val] #@[source: [[= :macro [type-of val]]]] #{##[:macro type-of val]
1A000E010E0204012001
} lambda? [val] #@[source: [[or [= :lambda [type-of val]]]]] #{##[:lambda type-of val #f]
1A000E010E020401200C0A00060D1A0301
} native? [val] #@[source: [[= :native-function [type-of val]]]] #{##[:native-function type-of val]
1A000E010E0204012001
} procedure? [val] #@[source: [[or [lambda? val] [native? val]]]] #{##[lambda? val native? #f]
0E000E0104010C0A00110D0E020E0104010C0A00060D1A0301
} buffer? [v] #@[source: [[= :buffer [type-of v]]]] #{##[:buffer type-of v]
1A000E010E0204012001
} buffer-view? [v] #@[source: [[= :buffer-view [type-of v]]]] #{##[:buffer-view type-of v]
1A000E010E0204012001
} bytecode-array? [v] #@[source: [[= :bytecode-array [type-of v]]]] #{##[:bytecode-array type-of v]
1A000E010E0204012001
} bytecode-op? [v] #@[source: [[= :bytecode-op [type-of v]]]] #{##[:bytecode-op type-of v]
1A000E010E0204012001
} in-range? [v min max] #@[source: [[and [>= v min] [<= v max]]]] #{##[v min max]
0E000E01210C0B00090D0E000E021F01
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B171A28070D1A2C1A2D1A2E1A2F171A2C070D1A301A31
1A321A33171A30070D1A341A351A361A37171A34070D1A381A391A3A1A3B171A
38070D1A3C1A3D1A3E1A3F171A3C070D1A401A411A421A43171A40070D1A441A
451A461A47171A44070D1A481A491A4A1A4B171A48070D1A4C1A4D1A4E1A4F17
1A4C070D1A501A511A521A53171A50070D1A541A551A561A57171A54070D1A58
1A591A5A1A5B171A58070D1A5C1A5D1A5E1A5F171A5C070D1A601A611A621A63
171A60070D1A641A651A661A67171A64070D1A681A691A6A1A6B171A68070D1A
6C1A6D1A6E1A6F171A6C070D1A701A711A721A73171A700701
}#{##[quasiquote-real [l depth] #@[source: [[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 #nil]] l]]]]] #{##[nil? l :pair type-of unquote-splicing depth list append quasiquote-real unquote quasiquote cons symbol? quote]
0E000E0104010B0007240900EB1A020E030E010401200B00C20E0111111A0420
0B00360E052A0B001A0E061A070E011112110E080E01120E0504020403090016
0E061A040E080E01121102FF0E0525040204020900820E01111A09200B00260E
052A0B000A0E0112110900160E061A090E080E01121102FF0E05250402040209
00560E01111A0A200B00190E080E080E01121102010E052504020E0504020900
370E052A0B001E0E061A0B0E080E01110E0504020E080E01120E050402040309
00160E080E01110E0504020E080E01120E050402140900200E052A0C0B000A0D
0E0C0E0104010B000D1A0D0E012414140900050E0101
} quasiquote [l] #@[source: [[quasiquote-real l 0]]] #{##[quasiquote-real l]
0E000E010200040201
} unquote [expr] #@[source: [[throw [list :unquote-without-quasiquote "unquote should only occur inside a quasiquote, never evaluated directly"]]]] #{##[throw list :unquote-without-quasiquote "unquote should only occur inside a quasiquote, never evaluated directly"]
0E000E011A021A030402040101
} unquote-splicing [expr] #@[source: [[throw [list :unquote-splicing-without-quasiq "unquote-splicing should only occur inside a quasiquote, never evaluated directly"]]]] #{##[throw list :unquote-splicing-without-quasiq "unquote-splicing should only occur inside a quasiquote, never evaluated directly"]
0E000E011A021A030402040101
}]
1A001A011A021A03171A00070D1A041A051A061A07181A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C0701
}#{##[3.14159 PI π inc [x] #@[documentation: "Return a number 1 greater than x" source: [:inline "Return a number 1 greater than x" [+ 1 x]] inline: #t] #{##[x]
02010E002501
} inc! [i v] #@[documentation: "Decrement I by V (defaults to 1) and store the result in I" source: ["Decrement I by V (defaults to 1) and store the result in I" [quasiquote [set! [unquote i] [+ [unquote i] [unquote [or v 1]]]]]]] #{##[set! i + v #f]
1A000E011A020E010E030C0A000D0D02010C0A00060D1A042414141424141414
01
} dec [x] #@[documentation: "Return a number 1 less than x" source: [:inline "Return a number 1 less than x" [+ -1 x]] inline: #t] #{##[x]
02FF0E002501
} dec! [i v] #@[documentation: "Decrement I by V and store the result in I" source: ["Decrement I by V and store the result in I" [quasiquote [set! [unquote i] [- [unquote i] [unquote [or v 1]]]]]]] #{##[set! i - v #f]
1A000E011A020E010E030C0A000D0D02010C0A00060D1A042414141424141414
01
} +x [α] #@[documentation: "Return a function that adds α to it's argument, useful for mapping" source: ["Return a function that adds α to it's argument, useful for mapping" [fn [β] [+ α β]]]] #{##[anonymous [β] #@[source: [[+ α β]]] #{##[α β]
0E000E012501
}]
1A001A011A021A031701
} fib [i] #@[documentation: "Terribly inefficient, but, useful for testing the GC" source: ["Terribly inefficient, but, useful for testing the GC" [if [< i 2] i [+ [fib [- i 2]] [fib [- i 1]]]]]] #{##[i fib]
0E0002021E0B00080E000900160E010E0002022604010E010E00020126040125
01
} wrap-value [val min max] #@[documentation: "Constrains VAL to be within MIN and MAX, wrapping it around" source: ["Constrains VAL to be within MIN and MAX, wrapping it around" [+ min [rem [- val min] [- max min]]]]] #{##[min val max]
0E000E010E00260E020E0026292501
} +1 [v] #@[source: [[quasiquote [+ 1 [unquote v]]]]] #{##[+ v]
1A0002010E012414141401
} radians [degrees] #@[documentation: "Convert a quantity in degrees to radians" source: ["Convert a quantity in degrees to radians" [/ [* π degrees] 180.0]]] #{##[π degrees 180.0]
0E000E01271A022801
}]
1A001A01070D1A001A02070D1A031A041A051A06171A03070D1A071A081A091A
0A181A07070D1A0B1A0C1A0D1A0E171A0B070D1A0F1A101A111A12181A0F070D
1A131A141A151A16171A13070D1A171A181A191A1A171A17070D1A1B1A1C1A1D
1A1E171A1B070D1A1F1A201A211A22181A1F070D1A231A241A251A26171A2307
01
}#{##[describe/closure [c i] #@[source: [[when c [if [= c root-closure] [cat [ansi-blue [cat [int [or i 0]] "# <root environment>"]] "\r\n"] [do [def data [closure/data c]] [def l [length data]] [cat [ansi-blue [cat [int [or i 0]] "# " [string/write c]]] " - " [if [< l 16] [string/write data] "-+- Very big tree structure -+-"] "\r\n" [describe/closure [closure/caller c] [+ [int [or i 0]] 1]]]]]]]] #{##[c root-closure cat ansi-blue int i #f "# <root environment>" "\r\n" closure/data data length l "# " string/write " - " "-+- Very big tree structure -+-" describe/closure closure/caller]
0E000B00A90E000E01200B002A0E020E030E020E040E050C0A000D0D02000C0A
00060D1A0604011A07040204011A0804020900770E090E0004011A0A070D0E0B
0E0A04011A0C070D0E020E030E020E040E050C0A000D0D02000C0A00060D1A06
04011A0D0E0E0E000401040304011A0F0E0C02101E0B000C0E0E0E0A04010900
051A101A080E110E120E0004010E040E050C0A000D0D02000C0A00060D1A0604
01020125040204050900042401
} stacktrace [] #@[source: [[display [describe/closure [closure/caller [current-lambda]]]]]] #{##[print describe/closure closure/caller current-lambda]
0E000E010E020E03040004010401040101
} display/error/wrap [i text] #@[source: [[case i [0 [ansi-red text]] [1 [string text]] [2 [ansi-yellow [string/write text]]] [3 [describe/closure text]] [otherwise text]]]] #{##[i ΓεnΣym-1 ansi-red text string ansi-yellow string/write describe/closure]
150E001A01070D0E010200200B000C0E020E03040109003C0E010201200B000C
0E040E03040109002B0E010202200B00100E050E060E03040104010900160E01
0203200B000C0E070E0304010900050E031601
} display/error/iter [error i] #@[source: [[if error [cons [display/error/wrap i [car error]] [display/error/iter [cdr error] [+ 1 i]]] [cons "" #nil]]]] #{##[error display/error/wrap i display/error/iter ""]
0E000B001C0E010E020E001104020E030E001202010E02250402140900071A04
241401
} display/error [error] #@[documentation: "Display ERROR in a nice, human readable way" source: ["Display ERROR in a nice, human readable way" [display [join [display/error/iter error 0] "\r\n"]]]] #{##[print join display/error/iter error "\r\n"]
0E000E010E020E03020004021A040402040101
} closure/documentation [o] #@[source: [[meta o :documentation]]] #{##[meta o :documentation]
0E000E011A02040201
} describe/thing [o] #@[documentation: "Describe a specific value O" source: ["Describe a specific value O" [def documentation [closure/documentation o]] [def arguments [closure/arguments o]] [fmt "{arguments:?} - {documentation}"]]] #{##[closure/documentation o documentation closure/arguments arguments cat string/write " - "]
0E000E0104011A02070D0E030E0104011A04070D0E050E060E0404011A070E02
040301
} describe/string [a] #@[documentation: "Descibe whatever value string A resolves to" source: ["Descibe whatever value string A resolves to" [describe/thing [resolve [string->symbol a]]]]] #{##[describe/thing resolve string->symbol a]
0E000E010E020E0304010401040101
} describe [fun] #@[documentation: "Describe FUN, if there is documentation available" source: ["Describe FUN, if there is documentation available" [if [string? fun] [describe/string fun] [describe/thing fun]]]] #{##[string? fun describe/string describe/thing]
0E000E0104010B000C0E020E0104010900090E030E01040101
} symbol-table [off len environment] #@[documentation: "Return a list of LEN symbols defined in ENVIRONMENT starting at OFF" source: ["Return a list of LEN symbols defined in ENVIRONMENT starting at OFF" [when-not environment [set! environment root-closure]] [when-not off [set! off 0]] [when-not len [set! len 9999999]] [sublist [eval-in environment '[symbol-table*]] off [+ off len] #nil]]] #{##[environment root-closure off len 9999999 sublist eval-in [symbol-table*]]
0E000B0007240900080E011A00080D0E020B00072409000802001A02080D0E03
0B0007240900081A041A03080D0E050E060E001A0704020E020E020E03252404
0401
} gensym/counter gensym [prefix] #@[source: [[inc! gensym/counter] [string->symbol [cat prefix "ΓεnΣym-" gensym/counter]]]] #{##[gensym/counter string->symbol cat prefix "ΓεnΣym-"]
0E000201251A00080D0E010E020E031A040E000403040101
} current-closure root-closure]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D1A241A251A261A27171A24
070D02001A28070D1A291A2A1A2B1A2C171A29070D0E2D04001A2E0701
}#{##[random/seed random/seed-initialize! [] #@[source: [[set! random/seed [bit-xor [time] [time/milliseconds]]]]] #{##[bit-xor time time/milliseconds random/seed]
0E000E0104000E02040004021A030801
} random/rng! [] #@[source: [[set! random/seed [+ 12345 [* random/seed 1103515245]]] [bit-or [bit-shift-left [bit-and random/seed 65535] 16] [bit-and [bit-shift-right random/seed 16] 65535]]]] #{##[12345 random/seed 1103515245 bit-or bit-shift-left bit-and 65535 bit-shift-right]
1A000E011A0227251A01080D0E030E040E050E011A060402021004020E050E07
0E01021004021A060402040201
} random/seed! [new-seed] #@[documentation: "Set a new seed value for the RNG" source: ["Set a new seed value for the RNG" [set! seed new-seed]]] #{##[new-seed seed]
0E001A010801
} [] #@[documentation: "Return the current RNG seed value" source: ["Return the current RNG seed value" seed]] #{##[seed]
0E0001
} random [max] #@[documentation: "Return a value from 0 to MAX, or, if left out, a random int" source: ["Return a value from 0 to MAX, or, if left out, a random int" [if [numeric? max] [rem [abs [random/rng!]] max] [random/rng!]]]] #{##[numeric? max abs random/rng!]
0E000E0104010B00110E020E03040004010E01290900070E03040001
}]
02001A00070D1A011A021A031A04171A01070D1A051A061A071A08171A05070D
1A091A0A1A0B1A0C171A09070D1A001A0D1A0E1A0F171A00070D1A101A111A12
1A13171A10070D0E01040001
}#{##[ansi/disabled "\e[0m" ansi-reset "\e[0;39m" ansi-fg-reset "\e[49m" ansi-bg-reset 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" ansi-fg "\e[40m" "\e[41m" "\e[42m" "\e[43m" "\e[44m" "\e[45m" "\e[46m" "\e[47m" ansi-bg ansi-wrap [code string] #@[documentation: "Wrap STRING in the ansi color CODE" source: ["Wrap STRING in the ansi color CODE" [cat [or ansi/disabled [array/ref ansi-fg code]] string [or ansi/disabled ansi-reset]]]] #{##[cat ansi/disabled array/ref ansi-fg code #f string ansi-reset]
0E000E010C0A00130D0E020E030E0404020C0A00060D1A050E060E010C0A000D
0D0E070C0A00060D1A05040301
} ansi-black args #@[documentation: "Wrap ARGS in black" source: ["Wrap ARGS in black" [ansi-wrap 0 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002000E010E020E030402040201
} ansi-dark-red #@[documentation: "Wrap ARGS in dark red" source: ["Wrap ARGS in dark red" [ansi-wrap 1 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002010E010E020E030402040201
} ansi-dark-green #@[documentation: "Wrap ARGS in dark green" source: ["Wrap ARGS in dark green" [ansi-wrap 2 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002020E010E020E030402040201
} ansi-brown #@[documentation: "Wrap ARGS in brown" source: ["Wrap ARGS in brown" [ansi-wrap 3 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002030E010E020E030402040201
} ansi-dark-blue #@[documentation: "Wrap ARGS in dark blue" source: ["Wrap ARGS in dark blue" [ansi-wrap 4 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002040E010E020E030402040201
} ansi-purple #@[documentation: "Wrap ARGS in purple" source: ["Wrap ARGS in purple" [ansi-wrap 5 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002050E010E020E030402040201
} ansi-teal #@[documentation: "Wrap ARGS in teal" source: ["Wrap ARGS in teal" [ansi-wrap 6 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002060E010E020E030402040201
} ansi-dark-gray #@[documentation: "Wrap ARGS in dark gray" source: ["Wrap ARGS in dark gray" [ansi-wrap 7 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002070E010E020E030402040201
} ansi-gray #@[documentation: "Wrap ARGS in gray" source: ["Wrap ARGS in gray" [ansi-wrap 8 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002080E010E020E030402040201
} ansi-red #@[documentation: "Wrap ARGS in red" source: ["Wrap ARGS in red" [ansi-wrap 9 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E0002090E010E020E030402040201
} ansi-green #@[documentation: "Wrap ARGS in green" source: ["Wrap ARGS in green" [ansi-wrap 10 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E00020A0E010E020E030402040201
} ansi-yellow #@[documentation: "Wrap ARGS in yellow" source: ["Wrap ARGS in yellow" [ansi-wrap 11 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E00020B0E010E020E030402040201
} ansi-blue #@[documentation: "Wrap ARGS in blue" source: ["Wrap ARGS in blue" [ansi-wrap 12 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E00020C0E010E020E030402040201
} ansi-pink #@[documentation: "Wrap ARGS in pink" source: ["Wrap ARGS in pink" [ansi-wrap 13 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E00020D0E010E020E030402040201
} ansi-cyan #@[documentation: "Wrap ARGS in cyan" source: ["Wrap ARGS in cyan" [ansi-wrap 14 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E00020E0E010E020E030402040201
} ansi-white #@[documentation: "Wrap ARGS in white" source: ["Wrap ARGS in white" [ansi-wrap 15 [apply cat args]]]] #{##[ansi-wrap apply cat args]
0E00020F0E010E020E030402040201
} ansi-rainbow #@[documentation: "Wrap ARGS in the colors of the rainbow!" source: ["Wrap ARGS in the colors of the rainbow!" [let* [def count 0] [cat [join [map [split [apply cat args] ""] [fn [a] [set! count [bit-and [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [if [zero? count] 7 [+ count 8]]]] a]]] ""] [or ansi/disabled ansi-fg-reset]]]]] #{##[count cat join map split apply args "" anonymous [a] #@[source: [[set! count [bit-and [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [if [zero? count] 7 [+ count 8]]]] a]]] #{##[bit-and count cat ansi/disabled array/ref ansi-fg #f a]
0E0002010E0125020704021A01080D0E020E030C0A00210D0E040E050E012A0B
000802070900080E0102082504020C0A00060D1A060E07040201
} ansi/disabled ansi-fg-reset #f]
1502001A00070D0E010E020E030E040E050E010E0604021A0704021A081A091A
0A1A0B1704021A0704020E0C0C0A000D0D0E0D0C0A00060D1A0E04021601
} ansi-rainbow-bg #@[documentation: "Wrap ARGS in the colors of the rainbow!" source: ["Wrap ARGS in the colors of the rainbow!" [def count 0] [def colored-list [map [split [apply cat args] ""] [fn [a] [set! count [bit-and [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [bit-xor count 7]]] [or ansi/disabled [array/ref ansi-bg count]] a]]]] [cat [join colored-list ""] [or ansi/disabled ansi-reset]]]] #{##[count map split apply cat args "" anonymous [a] #@[source: [[set! count [bit-and [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [bit-xor count 7]]] [or ansi/disabled [array/ref ansi-bg count]] a]]] #{##[bit-and count cat ansi/disabled array/ref ansi-fg bit-xor #f ansi-bg a]
0E0002010E0125020704021A01080D0E020E030C0A00190D0E040E050E060E01
0207040204020C0A00060D1A070E030C0A00130D0E040E080E0104020C0A0006
0D1A070E09040301
} colored-list join ansi/disabled ansi-reset #f]
02001A00070D0E010E020E030E040E0504021A0604021A071A081A091A0A1704
021A0B070D0E040E0C0E0B1A0604020E0D0C0A000D0D0E0E0C0A00060D1A0F04
0201
} reprint-line [text width] #@[source: [[when-not width [set! width 20]] [print "\r"] [dotimes [i width] [print " "]] [print "\r"] [print text]]] #{##[width print "\r" i " " text]
0E000B00072409000802141A00080D0E011A0204010D1502001A03070D240900
130D0E011A0404010D02010E03031A03080E030E001E0AFFEB0D24160D0E011A
0204010D0E010E05040101
}]
1C1A00070D1A011A02070D1A031A04070D1A051A06070D0E071A081A091A0A1A
0B1A0C1A0D1A0E1A0F1A101A111A121A131A141A151A161A1704101A18070D1A
011A02070D0E071A191A1A1A1B1A1C1A1D1A1E1A1F1A2004081A21070D1A221A
231A241A25171A22070D1A261A271A281A29171A26070D1A2A1A271A2B1A2C17
1A2A070D1A2D1A271A2E1A2F171A2D070D1A301A271A311A32171A30070D1A33
1A271A341A35171A33070D1A361A271A371A38171A36070D1A391A271A3A1A3B
171A39070D1A3C1A271A3D1A3E171A3C070D1A3F1A271A401A41171A3F070D1A
421A271A431A44171A42070D1A451A271A461A47171A45070D1A481A271A491A
4A171A48070D1A4B1A271A4C1A4D171A4B070D1A4E1A271A4F1A50171A4E070D
1A511A271A521A53171A51070D1A541A271A551A56171A54070D1A571A271A58
1A59171A57070D1A5A1A271A5B1A5C171A5A070D1A5D1A5E1A5F1A60171A5D07
01
}#{##[tree/new :align :right :debug :base :width :padding-char " " fmt/format-arg/default fmt/find-non-digit-from-right [s i] #@[source: [[if [< i 0] -1 [do [def char [char-at s i]] [if [and [>= char 48] [<= char 57]] [fmt/find-non-digit-from-right s [- i 1]] i]]]]] #{##[i char-at s char fmt/find-non-digit-from-right]
0E0002001E0B000802FF0900310E010E020E0004021A03070D0E030230210C0B
00090D0E0302391F0B00110E040E020E0002012604020900050E0001
} fmt/parse-spec [opts spec] #@[source: [[if [zero? [string/length spec]] opts [case [char-at spec [- [string/length spec] 1]] [[48 49 50 51 52 53 54 55 56 57] [def next-non-digit [fmt/find-non-digit-from-right spec [- [string/length spec] 1]]] [def number [string/cut spec [+ 1 next-non-digit] [string/length spec]]] [tree/set! opts :width [read/single number]] [when [= 48 [char-at number 0]] [tree/set! opts :padding-char "0"]] [fmt/parse-spec opts [string/cut spec 0 [+ 1 next-non-digit]]]] [63 [fmt/parse-spec [tree/set! opts :debug #t] [string/cut spec 0 [- [string/length spec] 1]]]] [88 [fmt/parse-spec [tree/set! opts :base :HEXADECIMAL] [string/cut spec 0 [- [string/length spec] 1]]]] [120 [fmt/parse-spec [tree/set! opts :base :hexadecimal] [string/cut spec 0 [- [string/length spec] 1]]]] [100 [fmt/parse-spec [tree/set! opts :base :decimal] [string/cut spec 0 [- [string/length spec] 1]]]] [111 [fmt/parse-spec [tree/set! opts :base :octal] [string/cut spec 0 [- [string/length spec] 1]]]] [98 [fmt/parse-spec [tree/set! opts :base :binary] [string/cut spec 0 [- [string/length spec] 1]]]] [60 [fmt/parse-spec [tree/set! opts :align :left] [string/cut spec 0 [- [string/length spec] 1]]]] [94 [fmt/parse-spec [tree/set! opts :align :center] [string/cut spec 0 [- [string/length spec] 1]]]] [62 [fmt/parse-spec [tree/set! opts :align :right] [string/cut spec 0 [- [string/length spec] 1]]]] [46 [fmt/parse-spec [tree/set! opts :precision [tree/ref opts :width]] [string/cut spec 0 [- [string/length spec] 1]]]] [otherwise [throw [list :format-error "Unknown form-spec option" spec [current-closure]]]]]]]] #{##[string/length spec opts char-at ΓεnΣym-1 #f fmt/find-non-digit-from-right next-non-digit string/cut number tree/set! :width read/single :padding-char "0" fmt/parse-spec :debug :base :HEXADECIMAL :hexadecimal :decimal :octal :binary :align :left :center :right :precision tree/ref throw list :format-error "Unknown form-spec option" current-closure]
0E000E0104012A0B00080E020902A6150E030E010E000E01040102012604021A
04070D0E040230200C0A00600D0E040231200C0A00560D0E040232200C0A004C
0D0E040233200C0A00420D0E040234200C0A00380D0E040235200C0A002E0D0E
040236200C0A00240D0E040237200C0A001A0D0E040238200C0A00100D0E0402
39200C0A00060D1A050B006D0E060E010E000E01040102012604021A07070D0E
080E0102010E07250E000E01040104031A09070D0E0A0E021A0B0E0C0E090401
04030D02300E030E0902000402200B00100E0A0E021A0D1A0E0403090004240D
0E0F0E020E080E01020002010E0725040304020901BE0E04023F200B00240E0F
0E0A0E021A101B04030E080E0102000E000E010401020126040304020901950E
040258200B00250E0F0E0A0E021A111A1204030E080E0102000E000E01040102
01260403040209016B0E040278200B00250E0F0E0A0E021A111A1304030E080E
0102000E000E010401020126040304020901410E040264200B00250E0F0E0A0E
021A111A1404030E080E0102000E000E010401020126040304020901170E0402
6F200B00250E0F0E0A0E021A111A1504030E080E0102000E000E010401020126
040304020900ED0E040262200B00250E0F0E0A0E021A111A1604030E080E0102
000E000E010401020126040304020900C30E04023C200B00250E0F0E0A0E021A
171A1804030E080E0102000E000E010401020126040304020900990E04025E20
0B00250E0F0E0A0E021A171A1904030E080E0102000E000E0104010201260403
040209006F0E04023E200B00250E0F0E0A0E021A171A1A04030E080E0102000E
000E010401020126040304020900450E04022E200B002B0E0F0E0A0E021A1B0E
1C0E021A0B040204030E080E0102000E000E010401020126040304020900150E
1D0E1E1A1F1A200E010E210400040404011601
} fmt/debug [opts] #@[source: [[if-not [tree/ref opts :debug] opts [tree/set! opts :argument [list string/write [tree/ref opts :argument]]]]]] #{##[tree/ref opts :debug tree/set! :argument list string/write]
0E000E011A0204020B001C0E030E011A040E050E060E000E011A040402040204
030900050E0101
} fmt/number-format [opts] #@[source: [[case [tree/ref opts :base] [:binary [tree/set! opts :argument [list int->string/binary [tree/ref opts :argument]]]] [:octal [tree/set! opts :argument [list int->string/octal [tree/ref opts :argument]]]] [:decimal [tree/set! opts :argument [list int->string/decimal [tree/ref opts :argument]]]] [:hexadecimal [tree/set! opts :argument [list int->string/hex [tree/ref opts :argument]]]] [:HEXADECIMAL [tree/set! opts :argument [list int->string/HEX [tree/ref opts :argument]]]] [otherwise opts]]]] #{##[tree/ref opts :base ΓεnΣym-2 :binary tree/set! :argument list int->string/binary :octal int->string/octal :decimal int->string/decimal :hexadecimal int->string/hex :HEXADECIMAL int->string/HEX]
150E000E011A0204021A03070D0E031A04200B001C0E050E011A060E070E080E
000E011A060402040204030900890E031A09200B001C0E050E011A060E070E0A
0E000E011A060402040204030900680E031A0B200B001C0E050E011A060E070E
0C0E000E011A060402040204030900470E031A0D200B001C0E050E011A060E07
0E0E0E000E011A060402040204030900260E031A0F200B001C0E050E011A060E
070E100E000E011A060402040204030900050E011601
} :binary "#b" :octal "#o" :decimal "#d" :hexadecimal "#x" :HEXADECIMAL fmt/number-format-prefixex fmt/number-format-prefix [opts] #@[source: [[if [or [not [tree/ref opts :debug]] [not [tree/ref opts :base]]] opts [-> [if [member '[:binary :octal :decimal :hexadecimal :HEXADECIMAL] [tree/ref opts :base]] [tree/set! opts :argument [list cat [tree/ref fmt/number-format-prefixex [tree/ref opts :base]] [tree/ref opts :argument]]] opts] [tree/set! :debug #f]]]]] #{##[tree/ref opts :debug :base #f tree/set! member [:binary :octal :decimal :hexadecimal :HEXADECIMAL] :argument list cat fmt/number-format-prefixex]
0E000E011A0204020B00071C0900041B0C0A001B0D0E000E011A0304020B0007
1C0900041B0C0A00060D1A040B00080E010900440E050E061A070E000E011A03
040204020B002A0E050E011A080E090E0A0E000E0B0E000E011A03040204020E
000E011A080402040304030900050E011A021C040301
} fmt/add-padding [opts] #@[source: [[if-not [tree/ref opts :width] opts [tree/set! opts :argument [list [case [tree/ref opts :align] [:right string/pad-start] [:center string/pad-middle] [:left string/pad-end]] [tree/ref opts :argument] [if [and [tree/ref opts :debug] [tree/ref opts :base]] [- [tree/ref opts :width] 2] [tree/ref opts :width]] [tree/ref opts :padding-char]]]]]] #{##[tree/ref opts :width tree/set! :argument list :align ΓεnΣym-3 :right string/pad-start :center string/pad-middle :left string/pad-end :debug :base :padding-char]
0E000E011A0204020B00860E030E011A040E05150E000E011A0604021A07070D
0E071A08200B00080E0909001E0E071A0A200B00080E0B0900110E071A0C200B
00080E0D09000424160E000E011A0404020E000E011A0E04020C0B000C0D0E00
0E011A0F04020B00110E000E011A02040202022609000B0E000E011A0204020E
000E011A100402040404030900050E0101
} fmt/precision [opts] #@[source: [[if-not [tree/ref opts :precision] opts [tree/set! opts :argument [list string/round [tree/ref opts :argument] [tree/ref opts :precision]]]]]] #{##[tree/ref opts :precision tree/set! :argument list string/round]
0E000E011A0204020B00240E030E011A040E050E060E000E011A0404020E000E
011A020402040304030900050E0101
} fmt/truncate [opts] #@[source: [[if-not [tree/ref opts :width] opts [tree/set! opts :argument [list string/cut [tree/ref opts :argument] 0 [+ 1 [tree/ref opts :width]]]]]]] #{##[tree/ref opts :width tree/set! :argument list string/cut]
0E000E011A0204020B00290E030E011A040E050E060E000E011A040402020002
010E000E011A02040225040404030900050E0101
} fmt/output [opts] #@[source: [[tree/ref opts :argument]]] #{##[tree/ref opts :argument]
0E000E011A02040201
} fmt/format-arg [spec argument] #@[source: [[-> [tree/set! [fmt/parse-spec [tree/dup fmt/format-arg/default] spec] :argument argument] fmt/number-format fmt/precision fmt/add-padding fmt/truncate fmt/number-format-prefix fmt/debug fmt/output]]] #{##[fmt/output fmt/debug fmt/number-format-prefix fmt/truncate fmt/add-padding fmt/precision fmt/number-format tree/set! fmt/parse-spec tree/dup fmt/format-arg/default spec :argument argument]
0E000E010E020E030E040E050E060E070E080E090E0A04010E0B04021A0C0E0D
0403040104010401040104010401040101
} fmt/valid-argument? [argument] #@[source: [[or [int? argument] [symbol? argument]]]] #{##[int? argument symbol? #f]
0E000E0104010C0A00110D0E020E0104010C0A00060D1A0301
} fmt/arg-sym [v] #@[source: [[case [type-of v] [:int [fmt/arg-sym [cat "fmt-arg-" [string v]]]] [:symbol v] [:string [string->symbol v]] [otherwise [throw [list :type-error "Invalid fmt argument name" v [current-lambda]]]]]]] #{##[type-of v ΓεnΣym-4 :int fmt/arg-sym cat "fmt-arg-" string :symbol :string string->symbol throw list :type-error "Invalid fmt argument name" current-lambda]
150E000E0104011A02070D0E021A03200B00160E040E051A060E070E01040104
0204010900330E021A08200B00080E010900260E021A09200B000C0E0A0E0104
010900150E0B0E0C1A0D1A0E0E010E0F0400040404011601
} fmt/expr [expr arguments-used opts] #@[source: [[when-not [string? expr] [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 [tree/-- opts :expr-count] [array/set! arguments-used [tree/ref opts :expr-count] #t] [fmt/format-arg format-spec [fmt/arg-sym [tree/ref opts :expr-count]]]] [let [[read-vals [read argument]]] [when [cdr read-vals] [throw [list :format-error "Format argument specifier contains more than a single atom" argument [current-lambda]]]] [when-not [fmt/valid-argument? [car read-vals]] [throw [list :format-error "Format argument specifier should be either an integer or a symbol" argument [current-lambda]]]] [when [int? [car read-vals]] [when [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]]]] [array/set! arguments-used [car read-vals] #t]] [fmt/format-arg format-spec [fmt/arg-sym [car read-vals]]]]]]] #{##[string? expr throw list :format-error "fmt needs a string literal as a first argument, since it is implemented as a macro" current-lambda split ":" split-expr argument "" #f format-spec tree/+= opts :expr-count array/set! arguments-used tree/ref fmt/format-arg fmt/arg-sym read read-vals "Format argument specifier contains more than a single atom" fmt/valid-argument? "Format argument specifier should be either an integer or a symbol" int? array/length "fmt numbered argument is out of bounds"]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
0E070E011A0804021A09070D0E09111A0A070D0E0912110C0A000D0D1A0B0C0A
00060D1A0C1A0D070D1A0B0E0A200B00330E0E0E0F1A1002FF04030D0E110E12
0E130E0F1A1004021B04030D0E140E0D0E150E130E0F1A100402040104020900
A9150E160E0A04011A17070D0E17120B00180E020E031A041A180E0A0E060400
04040401090004240D0E190E171104010B0007240900150E020E031A041A1A0E
0A0E060400040404010D0E1B0E171104010B00460E171102001E0C0A00150D0E
17110E1C0E120401210C0A00060D1A0C0B00180E020E031A041A1D0E0A0E0604
0004040401090004240D0E110E120E17111B0403090004240D0E140E0D0E150E
1711040104021601
} fmt [format-string . args] #@[documentation: "Return a formatted string" source: ["Return a formatted string" [when-not [string? format-string] [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] [dotimes [i [string/length format-string]] [case [char-at format-string i] [123 [do [when [int? [car cuts]] [throw [list :format-error "fmt placeholders can't be nested" format-string [current-lambda]]]] [set! cuts [cons i cuts]]]] [125 [do [when-not [int? [car cuts]] [throw [list :format-error "fmt expects all brackets to be closed" format-string [current-lambda]]]] [set! cuts [cons [cons [car cuts] i] [cdr cuts]]]]]]] [when [int? [car cuts]] [throw [list :format-error "fmt placeholders can't be nested" format-string [current-lambda]]]] [def expr-list #nil] [def last-pos [string/length format-string]] [def arguments-used [-> [array/allocate [length args]] [array/fill! #f]]] [def opts [tree/new :expr-count [array/length arguments-used]]] [doseq [c cuts] [def lit [string/cut format-string [+ [cdr c] 1] last-pos]] [when-not [= "" lit] [set! expr-list [cons lit expr-list]]] [def expr [fmt/expr [string/cut format-string [+ 1 [car c]] [cdr c]] arguments-used opts]] [set! expr-list [cons expr expr-list]] [set! last-pos [car c]]] [when [> last-pos 0] [def lit [string/cut format-string 0 last-pos]] [set! expr-list [cons lit expr-list]]] [dotimes [i [array/length arguments-used]] [when-not [array/ref arguments-used i] [throw [list :format-error "fmt expects all arguments to be used" [list format-string [list/ref args i]] [current-lambda]]]]] [def expr [if [cdr expr-list] [cons 'cat expr-list] [if [string? [car expr-list]] [car expr-list] [cons 'string expr-list]]]] [def fmt/args/map-fun/count 0] [defn fmt/args/map-fun [arg] [def s [string->symbol [cat "fmt-arg-" [string fmt/args/map-fun/count]]]] [inc! fmt/args/map-fun/count] [list 'def s arg]] [if args [quasiquote [let* [unquote-splicing [map args fmt/args/map-fun]] [unquote expr]]] expr]]] #{##[string? format-string throw list :type-error "fmt needs a string literal as a first argument, since it is implemented as a macro" current-lambda cuts i char-at ΓεnΣym-5 int? :format-error "fmt placeholders can't be nested" "fmt expects all brackets to be closed" string/length expr-list last-pos array/fill! array/allocate length args arguments-used tree/new :expr-count array/length opts ΓεnΣym-6 :pair type-of "Improper list detected, please provide a proper list instead" "Expected a value of type :pair" c string/cut lit "" fmt/expr expr array/ref "fmt expects all arguments to be used" list/ref cat string fmt/args/map-fun/count fmt/args/map-fun [arg] #@[source: [[def s [string->symbol [cat "fmt-arg-" [string fmt/args/map-fun/count]]]] [inc! fmt/args/map-fun/count] [list 'def s arg]]] #{##[string->symbol cat "fmt-arg-" string fmt/args/map-fun/count s list def arg]
0E000E011A020E030E040401040204011A05070D0E040201251A04080D0E061A
070E050E08040301
} let* append map]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
241A07070D1502001A08070D240900890D150E090E010E0804021A0A070D0E0A
027B200B002F0E0B0E071104010B00180E020E031A0C1A0D0E010E0604000404
0401090004240D0E080E07141A070809003D0E0A027D200B00340E0B0E071104
010B0007240900150E020E031A0C1A0E0E010E060400040404010D0E07110E08
140E0712141A070809000424160D02010E08031A08080E080E0F0E0104011E0A
FF710D24160D0E0B0E071104010B00180E020E031A0C1A0D0E010E0604000404
0401090004240D241A10070D0E0F0E0104011A11070D0E120E130E140E150401
04011C04021A16070D0E171A180E190E16040104021A1A070D150E071A1B070D
240900A90D1A1C0E1D0E1B0401200B0007240900150E020E031A041A1E0E070E
060400040404010D0E1D0E1B04011A1C200B0007240900150E020E031A041A1F
0E1B0E060400040404010D0E1B111A20070D0E210E010E20120201250E110403
1A22070D1A230E22200B00072409000B0E220E10141A10080D0E240E210E0102
010E2011250E201204030E160E1A04031A25070D0E250E10141A10080D0E2011
1A11080D0E1B121A1B080E1B0AFF58160D0E110200220B001C0E210E0102000E
1104031A22070D0E220E10141A1008090004240D1502001A08070D2409003A0D
0E260E160E0804020B0007240900210E020E031A0C1A270E030E010E280E150E
08040204020E060400040404010D02010E08031A08080E080E190E1604011E0A
FFC00D24160D0E10120B000B1A290E10140900180E000E101104010B00090E10
110900081A2A0E10141A25070D02001A2B070D1A2C1A2D1A2E1A2F171A2C070D
0E150B00191A300E310E320E150E2C04020E2524140402140900050E2501
} pfmt [format-string . args] #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [print [fmt [unquote format-string] [unquote-splicing args]]]]]] #{##[print fmt format-string append args]
1A001A010E020E030E04240402141424141401
} efmt [format-string . args] #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [error [fmt [unquote format-string] [unquote-splicing args]]]]]] #{##[error fmt format-string append args]
1A001A010E020E030E04240402141424141401
} pfmtln [format-string . args] #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [println [fmt [unquote format-string] [unquote-splicing args]]]]]] #{##[println fmt format-string append args]
1A001A010E020E030E04240402141424141401
} efmtln [format-string . args] #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [errorln [fmt [unquote format-string] [unquote-splicing args]]]]]] #{##[errorln fmt format-string append args]
1A001A010E020E030E04240402141424141401
}]
0E001A011A021A031C1A041C1A05241A061A07040A1A08070D1A091A0A1A0B1A
0C171A09070D1A0D1A0E1A0F1A10171A0D070D1A111A121A131A14171A11070D
1A151A161A171A18171A15070D0E001A191A1A1A1B1A1C1A1D1A1E1A1F1A201A
211A20040A1A22070D1A231A241A251A26171A23070D1A271A281A291A2A171A
27070D1A2B1A2C1A2D1A2E171A2B070D1A2F1A301A311A32171A2F070D1A331A
341A351A36171A33070D1A371A381A391A3A171A37070D1A3B1A3C1A3D1A3E17
1A3B070D1A3F1A401A411A42171A3F070D1A431A441A451A46171A43070D1A47
1A481A491A4A181A47070D1A4B1A4C1A4D1A4E181A4B070D1A4F1A501A511A52
181A4F070D1A531A541A551A56181A53070D1A571A581A591A5A181A570701
}#{##[string->keyword [α] #@[documentation: "Return string α as a keyword" source: [:inline "Return string α as a keyword" [symbol->keyword [string->symbol α]]] inline: #t] #{##[symbol->keyword string->symbol α]
0E000E010E020401040101
} string->byte-array [a] #@[documentation: "Turn a string into an UTF-8 encoded byte array" source: ["Turn a string into an UTF-8 encoded byte array" [def ret [array/allocate [string/length a]]] [dotimes [i [string/length a]] [array/set! ret i [char-at a i]]] ret]] #{##[array/allocate string/length a ret i array/set! char-at]
0E000E010E02040104011A03070D1502001A04070D2409001D0D0E050E030E04
0E060E020E04040204030D02010E04031A04080E040E010E0204011E0AFFDD0D
24160D0E0301
} println [str] #@[documentation: "Print STR on a single line" source: ["Print STR on a single line" [print [cat str "\r\n"]]]] #{##[print cat str "\r\n"]
0E000E010E021A030402040101
} errorln [str] #@[documentation: "Print to stderr STR on a single line" source: ["Print to stderr STR on a single line" [error [cat str "\r\n"]]]] #{##[error cat str "\r\n"]
0E000E010E021A030402040101
} display [value] #@[documentation: "Display VALUE" source: [:inline "Display VALUE" [print value]] inline: #t] #{##[print value]
0E000E01040101
} newline [] #@[documentation: "Print a single line feed character" source: ["Print a single line feed character" [print "\r\n"]]] #{##[print "\r\n"]
0E001A01040101
} br [num] #@[documentation: "Return NUM=1 linebreaks" source: ["Return NUM=1 linebreaks" [if [or [nil? num] [<= [int num] 1]] "\n" [cat "\n" [br [+ -1 num]]]]]] #{##[nil? num int #f "\n" cat br]
0E000E0104010C0A00140D0E020E01040102011F0C0A00060D1A030B00081A04
0900120E051A040E0602FF0E01250401040201
} path/ext?! [ext] #@[documentation: "Return a predicate that checks if a path ends on EXT" source: ["Return a predicate that checks if a path ends on EXT" [case [type-of ext] [:string [fn [path] [= ext [lowercase [path/extension path]]]]] [:pair [fn [path] [def cext [lowercase [path/extension path]]] [reduce ext [fn [α β] [or α [= β cext]]]]]] [otherwise [throw [list :type-error "Expected a :string or :list" ext]]]]]] #{##[type-of ext ΓεnΣym-1 :string anonymous [path] #@[source: [[= ext [lowercase [path/extension path]]]]] #{##[ext lowercase path/extension path]
0E000E010E020E03040104012001
} :pair [path] #@[source: [[def cext [lowercase [path/extension path]]] [reduce ext [fn [α β] [or α [= β cext]]]]]] #{##[lowercase path/extension path cext reduce ext anonymous [α β] #@[source: [[or α [= β cext]]]] #{##[α β cext #f]
0E000C0A00100D0E010E02200C0A00060D1A0301
}]
0E000E010E02040104011A03070D0E040E051A061A071A081A0917040201
} throw list :type-error "Expected a :string or :list"]
150E000E0104011A02070D0E021A03200B000F1A041A051A061A07170900250E
021A08200B000F1A041A091A0A1A0B170900110E0C0E0D1A0E1A0F0E01040304
011601
} path/extension [path] #@[documentation: "Return the extension of PATH" source: ["Return the extension of PATH" [def last-period [last-index-of path "."]] [if [>= last-period 0] [string/cut path [+ 1 last-period] [string/length path]] path]]] #{##[last-index-of path "." last-period string/cut string/length]
0E000E011A0204021A03070D0E030200210B00170E040E0102010E03250E050E
01040104030900050E0101
} path/without-extension [path] #@[documentation: "Return PATH, but without the extension part" source: ["Return PATH, but without the extension part" [def last-period [last-index-of path "."]] [if [>= last-period 0] [string/cut path 0 last-period] path]]] #{##[last-index-of path "." last-period string/cut]
0E000E011A0204021A03070D0E030200210B00100E040E0102000E0304030900
050E0101
} int->string/binary [α] #@[documentation: "Turn α into a its **binary** string representation" source: ["Turn α into a its **binary** string representation" [def ret ""] [when-not α [def α 0]] [when [zero? α] [set! ret "0"]] [while [not-zero? α] [set! ret [cat [from-char-code [+ 48 [bit-and α 1]]] ret]] [set! α [bit-shift-right α 1]]] ret]] #{##["" ret α "0" cat from-char-code bit-and bit-shift-right not=]
1A001A01070D0E020B00072409000802001A02070D0E022A0B000B1A031A0108
090004240D240900280D0E040E0502300E060E02020104022504010E0104021A
01080D0E070E02020104021A02080E0802000E0204020AFFD30D0E0101
} int->string/octal [α] #@[documentation: "Turn α into a its **octal** string representation" source: ["Turn α into a its **octal** string representation" [def ret ""] [when-not α [def α 0]] [when [zero? α] [set! ret "0"]] [while [not-zero? α] [set! ret [cat [from-char-code [+ 48 [bit-and α 7]]] ret]] [set! α [bit-shift-right α 3]]] ret]] #{##["" ret α "0" cat from-char-code bit-and bit-shift-right not=]
1A001A01070D0E020B00072409000802001A02070D0E022A0B000B1A031A0108
090004240D240900280D0E040E0502300E060E02020704022504010E0104021A
01080D0E070E02020304021A02080E0802000E0204020AFFD30D0E0101
} array/new "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F" int->string/hex/conversion-arr int->string/HEX [α] #@[documentation: "Turn α into a its **hexadecimal** string representation" source: ["Turn α into a its **hexadecimal** string representation" [def ret ""] [when-not α [def α 0]] [when [zero? α] [set! ret "0"]] [when [< α 0] [throw [list :type-error "Can't print negative numbers in hex for now" α [current-lambda]]]] [while [not-zero? α] [set! ret [cat [array/ref int->string/hex/conversion-arr [bit-and α 15]] ret]] [set! α [bit-shift-right α 4]]] ret]] #{##["" ret α "0" throw list :type-error "Can't print negative numbers in hex for now" current-lambda cat array/ref int->string/hex/conversion-arr bit-and bit-shift-right not=]
1A001A01070D0E020B00072409000802001A02070D0E022A0B000B1A031A0108
090004240D0E0202001E0B00180E040E051A061A070E020E0804000404040109
0004240D240900270D0E090E0A0E0B0E0C0E02020F040204020E0104021A0108
0D0E0D0E02020404021A02080E0E02000E0204020AFFD40D0E0101
} int->string/hex [α] #@[documentation: "Turn α into a its **hexadecimal** string representation" source: ["Turn α into a its **hexadecimal** string representation" [lowercase [int->string/HEX α]]]] #{##[lowercase int->string/HEX α]
0E000E010E020401040101
} int->string/decimal [α] #@[documentation: "Turn α into a its **decimal** string representation" source: ["Turn α into a its **decimal** string representation" [string α]]] #{##[string α]
0E000E01040101
} int->string string/pad-start [text goal-length char] #@[documentation: "Pad out TEXT with CHAR at the start until it is GOAL-LENGTH chars long, may also truncate the string" source: ["Pad out TEXT with CHAR at the start until it is GOAL-LENGTH chars long, may also truncate the string" [when-not char [set! char " "]] [when-not [string? text] [set! text [string text]]] [when-not [string? char] [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] [string/cut text [- [string/length text] goal-length] [string/length text]] text]]] #{##[char " " string? text string throw list :type-error "string/pad-start needs char as a string, so that one can pad with multiple characters" current-lambda cat string/length goal-length string/cut]
0E000B0007240900081A011A00080D0E020E0304010B00072409000C0E040E03
04011A03080D0E020E0004010B0007240900150E050E061A071A080E000E0904
00040404010D2409000F0D0E0A0E000E0304021A03080E0B0E0304010E0C1E0A
FFEB0D0E0B0E0304010E0C220B001B0E0D0E030E0B0E0304010E0C260E0B0E03
040104030900050E0301
} string/pad-end [text goal-length char] #@[documentation: "Pad out TEXT with CHAR at the end until it is GOAL-LENGTH chars long, may also truncate the string" source: ["Pad out TEXT with CHAR at the end until it is GOAL-LENGTH chars long, may also truncate the string" [when-not char [set! char " "]] [when-not [string? text] [set! text [string text]]] [when-not [string? char] [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] [string/cut text 0 goal-length] text]]] #{##[char " " string? text string throw list :type-error "string/pad-start needs char as a string, so that one can pad with multiple characters" current-lambda cat string/length goal-length string/cut]
0E000B0007240900081A011A00080D0E020E0304010B00072409000C0E040E03
04011A03080D0E020E0004010B0007240900150E050E061A071A080E000E0904
00040404010D2409000F0D0E0A0E030E0004021A03080E0B0E0304010E0C1E0A
FFEB0D0E0B0E0304010E0C220B00100E0D0E0302000E0C04030900050E0301
} string/pad-middle [text goal-length char] #@[documentation: "Pad out TEXT with CHAR at the end until it is GOAL-LENGTH chars long, may also truncate the string" source: ["Pad out TEXT with CHAR at the end until it is GOAL-LENGTH chars long, may also truncate the string" [when-not char [set! char " "]] [when-not [string? text] [set! text [string text]]] [when-not [string? char] [throw [list :type-error "string/pad-middle 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 char]]] [if [> [string/length text] goal-length] [let [[end-overflow [/ [- [string/length text] goal-length] 2]] [start-overflow [- [- [string/length text] goal-length] end-overflow]]] [string/cut text start-overflow [+ start-overflow goal-length]]] text]]] #{##[char " " string? text string throw list :type-error "string/pad-middle needs char as a string, so that one can pad with multiple characters" current-lambda cat string/length goal-length end-overflow start-overflow string/cut]
0E000B0007240900081A011A00080D0E020E0304010B00072409000C0E040E03
04011A03080D0E020E0004010B0007240900150E050E061A071A080E000E0904
00040404010D240900110D0E0A0E000E030E0004031A03080E0B0E0304010E0C
1E0AFFE90D0E0B0E0304010E0C220B0035150E0B0E0304010E0C260202281A0D
070D0E0B0E0304010E0C260E0D261A0E070D0E0F0E030E0E0E0E0E0C25040316
0900050E0301
} string/round [text decimal-digits] #@[documentation: "Round the floating point representation in TEXT to have at most DECIMAL-DIGITS after the period" source: ["Round the floating point representation in TEXT to have at most DECIMAL-DIGITS after the period" [def pos [last-index-of text "."]] [if [>= pos 0] [string/cut text 0 [+ pos 1 decimal-digits]] text]]] #{##[last-index-of text "." pos string/cut decimal-digits]
0E000E011A0204021A03070D0E030200210B00160E040E0102000E030201250E
052504030900050E0101
} split/empty [str separator] #@[source: [[def slen [string/length str]] [def start 0] [def ret #nil] [while [< start slen] [set! ret [cons [string/cut str start [+ 1 start]] ret]] [inc! start]] [reverse ret]]] #{##[string/length str slen start ret string/cut reverse]
0E000E0104011A02070D02001A03070D241A04070D240900200D0E050E010E03
02010E032504030E04141A04080D0E030201251A03080E030E021E0AFFDE0D0E
060E04040101
} split/string [str separator start] #@[source: [[when-not start [set! start 0]] [def pos-found [index-of str separator start]] [if [>= pos-found 0] [cons [string/cut str start pos-found] [split/string str separator [+ pos-found [string/length separator]]]] [cons [string/cut str start [string/length str]] #nil]]]] #{##[start index-of str separator pos-found string/cut split/string string/length]
0E000B00072409000802001A00080D0E010E020E030E0004031A04070D0E0402
00210B00220E050E020E000E0404030E060E020E030E040E070E030401250403
140900130E050E020E000E070E0204010403241401
} split [str separator] #@[documentation: "Splits STR into a list at every occurunse of SEPARATOR" source: ["Splits STR into a list at every occurunse of SEPARATOR" [typecheck/only str :string] [typecheck/only separator :string] [case [string/length separator] [0 [split/empty str]] [otherwise [split/string str separator 0]]]]] #{##[type-of str :string throw list :type-error "Expected a value of type :string" current-lambda separator string/length ΓεnΣym-2 split/empty split/string]
0E000E0104011A02200B0007240900150E030E041A051A060E010E0704000404
04010D0E000E0804011A02200B0007240900150E030E041A051A060E080E0704
00040404010D150E090E0804011A0A070D0E0A0200200B000C0E0B0E01040109
000D0E0C0E010E08020004031601
} read/single [text] #@[documentation: "Uses the reader and returns the first single value read from string TEXT" source: ["Uses the reader and returns the first single value read from string TEXT" [typecheck/only text :string] [car [read text]]]] #{##[type-of text :string throw list :type-error "Expected a value of type :string" current-lambda read]
0E000E0104011A02200B0007240900150E030E041A051A060E010E0704000404
04010D0E080E0104011101
} read/int [text] #@[documentation: "Reads the first string from TEXT" source: ["Reads the first string from TEXT" [int [read/single text]]]] #{##[int read/single text]
0E000E010E020401040101
} read/float [text] #@[documentation: "Reads the first float from TEXT" source: ["Reads the first float from TEXT" [float [read/single text]]]] #{##[float read/single text]
0E000E010E020401040101
} string/length?! [chars] #@[source: [[fn [a] [= chars [string/length a]]]]] #{##[anonymous [a] #@[source: [[= chars [string/length a]]]] #{##[chars string/length a]
0E000E010E0204012001
}]
1A001A011A021A031701
} contains-any? [str chars] #@[source: [[apply or [map [split chars ""] [fn [a] [>= [index-of str a] 0]]]]]] #{##[apply or map split chars "" anonymous [a] #@[source: [[>= [index-of str a] 0]]] #{##[index-of str a]
0E000E010E02040202002101
}]
0E000E010E020E030E041A0504021A061A071A081A09170402040201
} contains-all? [str chars] #@[source: [[apply and [map [split chars ""] [fn [a] [>= [index-of str a] 0]]]]]] #{##[apply and map split chars "" anonymous [a] #@[source: [[>= [index-of str a] 0]]] #{##[index-of str a]
0E000E010E02040202002101
}]
0E000E010E020E030E041A0504021A061A071A081A09170402040201
} from-char-codes l #@[documentation: "Turn the provided char codes into a string and return it" source: ["Turn the provided char codes into a string and return it" [apply cat [map l from-char-code]]]] #{##[apply cat map l from-char-code]
0E000E010E020E030E040402040201
}]
1A001A011A021A03171A00070D1A041A051A061A07171A04070D1A081A091A0A
1A0B171A08070D1A0C1A0D1A0E1A0F171A0C070D1A101A111A121A13171A1007
0D1A141A151A161A17171A14070D1A181A191A1A1A1B171A18070D1A1C1A1D1A
1E1A1F171A1C070D1A201A211A221A23171A20070D1A241A251A261A27171A24
070D1A281A291A2A1A2B171A28070D1A2C1A2D1A2E1A2F171A2C070D0E301A31
1A321A331A341A351A361A371A381A391A3A1A3B1A3C1A3D1A3E1A3F1A400410
1A41070D1A421A431A441A45171A42070D1A461A471A481A49171A46070D1A4A
1A4B1A4C1A4D171A4A070D0E4A1A4E070D1A4F1A501A511A52171A4F070D1A53
1A541A551A56171A53070D1A571A581A591A5A171A57070D1A5B1A5C1A5D1A5E
171A5B070D1A5F1A601A611A62171A5F070D1A631A641A651A66171A63070D1A
671A681A691A6A171A67070D1A6B1A6C1A6D1A6E171A6B070D1A6F1A701A711A
72171A6F070D1A731A741A751A76171A73070D1A771A781A791A7A171A77070D
1A7B1A7C1A7D1A7E171A7B070D1A7F1A801A811A82171A7F070D1A831A841A85
1A86171A830701
}#{##[module/insert/defer :array/2d string/write [do [def *module* :array/2d] [export allocate [defn array/2d/allocate [width height] [tree/new :data [-> [array/allocate [* width height]] [array/fill! 0]] :width width :height height]]] [export fill! [defn array/2d/fill! [data v] [array/fill! [tree/ref data :data] v] [return data]]] [export ref [defn array/2d/ref [data x y oob-val] [if [or [>= x [tree/ref data :width]] [>= y [tree/ref data :height]] [< x 0] [< y 0]] oob-val [array/ref [tree/ref data :data] [+ x [* y [tree/ref data :width]]]]]]] [export set! [defn array/2d/set! [data x y val] [if [or [>= x [tree/ref data :width]] [>= y [tree/ref data :height]] [< x 0] [< y 0]] [exception :out-of-bounds "Trying to set an array out of bounds" data] [array/set! [tree/ref data :data] [+ x [* y [tree/ref data :width]]] val]] [return data]]] [export print [defn array/2d/print [data] [dotimes [y [tree/ref data :height]] [dotimes [x [tree/ref data :width]] [display [cat [array/2d/ref data x y] " "]]] [newline]] [return data]]] [deftest #t [-> [array/2d/allocate 4 4] [array/2d/set! 1 1 #t] [array/2d/ref 1 1]]] [deftest #t [-> [array/2d/allocate 3 3] [array/2d/fill! #t] [array/2d/ref 1 1]]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :avl string/write [do [def *module* :avl] [def avl/empty :e] [defn avl/empty? [n] [= :e n]] [export default-cmp [defn avl/default-cmp [x y] [if [< x y] -1 [if [> x y] 1 0]]]] [defn avl/typecheck [r k] [or [avl/empty? [avl/root r]] [= [type-of k] [type-of [avl/key [avl/root r]]]] [throw [list :type-error "AVL trees can only contains keys of a single type" k [current-lambda]]]]] [export tree [defn avl/tree [cmp] [array/new avl/empty [or cmp avl/default-cmp]]]] [defn avl/height [n] [if [avl/empty? n] 0 [array/ref n 0]]] [defn avl/key [n] [array/ref n 1]] [defn avl/left [n] [array/ref n 2]] [defn avl/right [n] [array/ref n 3]] [defn avl/root [r] [array/ref r 0]] [defn avl/cmp [r] [array/ref r 1]] [defn avl/min-node [n] [if [avl/empty? n] avl/empty [let [[l [avl/left n]]] [if [avl/empty? l] n [avl/min-mode l]]]]] [defn avl/update-left [n l] [array/set! [array/dup n] 2 l]] [defn avl/update-right [n r] [array/set! [array/dup n] 3 r]] [defn avl/update-key [n k] [array/set! [array/dup n] 1 k]] [defn avl/update-root [t r] [array/set! [array/dup t] 0 r]] [defn avl/update-height [n] [array/set! [array/dup n] 0 [+ 1 [max [avl/height [avl/left n]] [avl/height [avl/right n]]]]]] [defn avl/rotate-right [y] [let [[x [avl/left y]]] [avl/update-height [avl/update-right x [avl/update-height [avl/update-left y [avl/right x]]]]]]] [defn avl/rotate-left [x] [let [[y [avl/right x]]] [avl/update-height [avl/update-left y [avl/update-height [avl/update-right x [avl/left y]]]]]]] [defn avl/balance [n] [if [avl/empty? n] 0 [- [avl/height [avl/left n]] [avl/height [avl/right n]]]]] [defn avl/insert-rebalance [n cmp v] [let [[b [avl/balance n]]] [cond [[> b 1] [case [cmp v [avl/key [avl/left n]]] [-1 [avl/rotate-right n]] [1 [avl/rotate-right [avl/update-left n [avl/rotate-left [avl/left n]]]]] [0 n]]] [[< b -1] [case [cmp v [avl/key [avl/right n]]] [1 [avl/rotate-left n]] [-1 [avl/rotate-left [avl/update-right n [avl/rotate-right [avl/right n]]]]] [0 n]]] [#t n]]]] [defn avl/node-insert [n cmp v] [if [avl/empty? n] [array/new 1 v avl/empty avl/empty] [case [cmp v [avl/key n]] [-1 [avl/insert-rebalance [avl/update-height [avl/update-left n [avl/node-insert [avl/left n] cmp v]]] cmp v]] [1 [avl/insert-rebalance [avl/update-height [avl/update-right n [avl/node-insert [avl/right n] cmp v]]] cmp v]] [0 [avl/update-key n v]]]]] [export insert [defn avl/insert [t v] "Insert key V into tree T.  If a node with an equivalent key already exists, its key is updated to V" [avl/typecheck t v] [avl/update-root t [avl/node-insert [avl/root t] [avl/cmp t] v]]]] [defn avl/node-get [n cmp v] [if [avl/empty? n] #nil [case [cmp v [avl/key n]] [0 [avl/key n]] [-1 [avl/node-get [avl/left n] cmp v]] [1 [avl/node-get [avl/right n] cmp v]]]]] [export get [defn avl/get [t v] "Retrieve the key V from tree T, or #nil if V is not in it" [if [or [avl/empty? [avl/root t]] [not= [type-of v] [type-of [avl/key [avl/root t]]]]] #nil [avl/node-get [avl/root t] [avl/cmp t] v]]]] [export from-list [defn avl/from-list [l cmp] "Create a new avl tree using the keys in L and the comparison function CMP" [list/reduce l avl/insert [avl/tree cmp]]]] [defn avl/remove-rebalance [n] [if [avl/empty? n] n [let [[b [avl/balance n]] [l [avl/left n]] [r [avl/right n]]] [cond [[> b 1] [if [>= [avl/balance l] 0] [avl/rotate-right n] [avl/rotate-right [avl/update-left n [avl/rotate-left l]]]]] [[< b -1] [if [<= [avl/balance r] 0] [avl/rotate-left n] [avl/rotate-left [avl/update-right n [avl/rotate-right r]]]]] [#t n]]]]] [defn avl/node-remove [n cmp v] [if [avl/empty? n] n [let [[root [case [cmp v [avl/key n]] [-1 [avl/update-left n [avl/node-remove [avl/left n] cmp v]]] [1 [avl/update-right n [avl/node-remove [avl/right n] cmp v]]] [0 [cond [[avl/empty? [avl/left n]] [avl/right n]] [[avl/empty? [avl/right n]] [avl/left n]] [#t [let [[k [avl/key [avl/min-node [avl/right n]]]]] [avl/update-key [avl/update-right [avl/right n] [avl/node-remove [avl/right n] cmp v]] k]]]]]]]] [set! root [avl/update-height root]] [avl/remove-rebalance root]]]] [export remove [defn avl/remove [t v] "Remove the key V from tree T if it is contained within it" [avl/update-root t [avl/node-remove [avl/root t] [avl/cmp t] v]]]] [defn avl/equal-node? [a b] [if [avl/empty? a] [avl/empty? b] [and [equal? [avl/key a] [avl/key b]] [avl/equal-node? [avl/left a] [avl/left b]] [avl/equal-node? [avl/right a] [avl/right b]]]]] [export equal? [defn avl/equal? [a b] "Test if two avl trees are equal" [avl/equal-node? [avl/root a] [avl/root b]]]] [defn avl/reduce-node [node o s] [if [avl/empty? node] s [o [avl/key node] [avl/reduce-node [avl/right node] o [avl/reduce-node [avl/left node] o s]]]]] [export reduce [defn avl/reduce [t o s] "Reduce T in-order with a reducer O taking a key and the result of the reductions of one subtree" [avl/reduce-node [avl/root t] o s]]] [defn avl/reduce-node-bin [n o s] [if [avl/empty? n] s [o [o [avl/key n] [avl/reduce-node-bin [avl/left n] o s]] [avl/reduce-node-bin [avl/right n] o s]]]] [export reduce-bin [defn avl/reduce-bin [t o s] "Reduce T with a reducer O taking a key and the result of the reductions of both subtrees" [avl/reduce-node-bin [avl/root t] o s]]] [export map [defn avl/map [t f] "Create a new avl tree by mapping each key in T using F, using the same comparison function as T" [avl/reduce t [fn [x acc] [avl/insert acc [f x]]] [avl/tree [avl/cmp t]]]]] [export map-to [defn avl/map-to [t f cmp] "Create a new avl tree by mapping each key in in T using F, using the comparison function CMP, which may be different from the comparison used in T" [avl/reduce t [fn [x acc] [avl/insert acc [f x]]] [avl/tree cmp]]]] [export to-list [defn avl/to-list [t] [avl/reduce t cons #nil]]] [deftest 1 [avl/get [avl/from-list '[1 2 3]] 1]] [deftest 4 [avl/get [avl/from-list '[1 2 3 4 5]] 4]] [deftest 15 [avl/get [avl/from-list '[23 42 100 10 15 64 101]] 15]] [deftest 100 [avl/get [avl/from-list '[23 42 100 100 101 100]] 100]] [deftest 101 [avl/get [avl/from-list '[23 42 100 100 101 100]] 101]] [deftest 100 [avl/get [avl/remove [avl/from-list '[23 42 100 10 64 101]] 15] 100]] [deftest #nil [avl/get [avl/from-list '[1 2 3]] 4]] [deftest #nil [avl/get [avl/from-list #nil] 1]] [deftest #nil [avl/get [avl/remove [avl/from-list '[23 42 100 10 15 64 101]] 15] 15]] [deftest #nil [avl/get [avl/remove [avl/from-list '[23 42 100 10 64 101]] 15] 15]] [deftest 355 [avl/reduce [avl/from-list '[23 42 100 10 15 64 101]] + 0]] [deftest 355 [avl/reduce-bin [avl/from-list '[23 42 100 10 15 64 101]] + 0]] [deftest -19 [avl/reduce [avl/from-list '[23 42 100 10 15 64 101]] - 0]] [deftest 125 [avl/reduce-bin [avl/from-list '[23 42 100 10 15 64 101]] - 0]] [deftest '[42 100 101 64 15 23 10] [avl/to-list [avl/from-list '[23 42 100 10 15 64 101]]]] [deftest 200 [avl/get [avl/map [avl/from-list '[23 42 100 10 15 64 101]] [fn [x] [* x 2]]] 200]] [deftest #nil [avl/get [avl/map [avl/from-list '[23 42 100 10 15 64 101]] [fn [x] [* x 2]]] 100]] [deftest 100 [avl/get [avl/insert [avl/map [avl/remove [avl/from-list '[23 42 100 10 15 64 101]] 100] [fn [x] [* x 2]]] 100] 100]] [deftest "100" [avl/get [avl/map [avl/from-list '[23 42 100 10 15 64 101]] string] "100"]] [deftest "100" [avl/get [avl/map-to [avl/from-list '[23 42 100 10 15 64 101]] string [fn [x y] [if [< x y] -1 [if [> x y] 1 0]]]] "100"]] [deftest "a" [avl/get [avl/from-list '["a" "b" "c"]] "a"]] [deftest "ein" [avl/get [avl/from-list '["Dies" "ist" "ein" "Test"]] "ein"]] [deftest #nil [avl/get [avl/from-list '["a" "b" "c"]] "d"]] [deftest #nil [avl/get [avl/from-list '["a" "b" "c"]] :a]] [deftest :c [avl/get [avl/from-list '[:a :b :c]] :c]] [deftest #nil [avl/get [avl/from-list '[:a :b :c]] :d]] [deftest #nil [avl/get [avl/from-list '[:a :b :c]] "c"]] [deftest 'c [avl/get [avl/from-list '[c b a]] 'c]] [deftest 'c [avl/get [avl/from-list '[b c a]] 'c]] [deftest 'c [avl/get [avl/from-list '[b c b b b a]] 'c]] [deftest '[b c a] [avl/to-list [avl/from-list '[b c b b b a]] 'c]] [deftest #nil [avl/get [avl/from-list '[c b a]] 'd]] [deftest :type-error [try car [avl/from-list '[c :b a]]]] [deftest :type-error [try car [avl/from-list '["c" b a]]]] [deftest :type-error [try car [avl/from-list '[123 b a]]]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :crypto/adler32 string/write [do [def *module* :crypto/adler32] [export hash [defn hash [data] [def a 1] [def b 0] [when [string? data] [set! data [string->buffer data]]] [when [not= [type-of data] :buffer] [exception :type-error "Can only hash buffers or strings"]] [def v [buffer/view/u8* data]] [dotimes [i [buffer/length data]] [set! a [mod/int [add/int a [buffer/view/ref v i]] 65521]] [set! b [mod/int [add/int a b] 65521]]] [bit-or a [bit-shift-left b 16]]]] [deftest "00620062" [fmt "{:08X}" [crypto/adler32/hash "a"]]] [deftest "0F9D02BC" [fmt "{:08X}" [crypto/adler32/hash "asdQWE123"]]] [deftest "796B110D" [fmt "{:08X}" [crypto/adler32/hash "DiesIstEinTestDerNujelAdler32Implementierung"]]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :image/bmp string/write [do [def *module* :image/bmp] [defn buffer/view/le/set! [u8v offset bytes val] [while [> bytes 0] [buffer/view/set! u8v [inc! offset] [bit-and 255 val]] [dec! bytes] [set! val [bit-shift-right val 8]]] offset] [defn image/bmp/row-padding [width pixel-length] [def ret [- 4 [bit-and [* width pixel-length] 3]]] [if [= ret 4] 0 ret]] [export encode [defn image/bmp/encode [image] [require :image] [def image-size [* [tree/ref image :height] 3 [+ [tree/ref image :width] [image/bmp/row-padding [tree/ref image :width] 3]]]] [def header-size [+ 14 40]] [def file-size [+ image-size header-size]] [def out [buffer/allocate file-size]] [def b [buffer/view/u8* out]] [def i -1] [buffer/view/set! b [inc! i] 66] [buffer/view/set! b [inc! i] 77] [set! i [buffer/view/le/set! b i 4 file-size]] [set! i [buffer/view/le/set! b i 4 0]] [set! i [buffer/view/le/set! b i 4 header-size]] [set! i [buffer/view/le/set! b i 4 40]] [set! i [buffer/view/le/set! b i 4 [tree/ref image :width]]] [set! i [buffer/view/le/set! b i 4 [tree/ref image :height]]] [set! i [buffer/view/le/set! b i 2 1]] [set! i [buffer/view/le/set! b i 2 24]] [set! i [buffer/view/le/set! b i 4 0]] [set! i [buffer/view/le/set! b i 4 image-size]] [set! i [buffer/view/le/set! b i 4 8192]] [set! i [buffer/view/le/set! b i 4 8192]] [set! i [buffer/view/le/set! b i 4 0]] [set! i [buffer/view/le/set! b i 4 0]] [def row-padding [image/bmp/row-padding [tree/ref image :width] 3]] [def pixels [- header-size 1]] [let [[y [- [tree/ref image :height] 1]]] [while [>= y 0] [dotimes [x [tree/ref image :width]] [set! pixels [buffer/view/le/set! b pixels 3 [image/ref image x y]]]] [set! pixels [+ pixels row-padding]] [set! y [add/int y -1]]]] [return out]]] [export init! [defn image/bmp/init! [] [require :image] [image/add-encoder! "bmp" image/bmp/encode]]] [deftest 3149043687 [import hash :crypto/adler32] [import [test-image-xor] :image] [hash [image/bmp/encode [test-image-xor]]]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :image string/write [do [def *module* :image] [def image/decoders [tree/new #nil]] [def image/encoders [tree/new #nil]] [export add-encoder! [defn image/add-encoder! [ext enc] [def ext [string->keyword [lowercase ext]]] [tree/set! image/encoders ext enc]]] [export add-decoder! [defn image/add-decoder! [ext dec] [def ext [string->keyword [lowercase ext]]] [tree/set! image/decoders ext dec]]] [defn image/get-encoder [path] [def ext [string->keyword [lowercase [path/extension path]]]] [tree/ref image/encoders ext]] [defn image/get-decoder [path] [def ext [string->keyword [lowercase [path/extension path]]]] [tree/ref image/decoders ext]] [export new [defn image/new [width height] [def buffer [buffer/allocate [* width height 4]]] [tree/new :width width :height height :buffer buffer :pixels [buffer/view/u32* buffer]]]] [export ref [defn image/ref [img x y] [def i [+ [int x] [* [int y] [tree/ref img :width]]]] [buffer/view/ref [tree/ref img :pixels] i]]] [export set! [defn image/set! [img x y value] [def i [+ [int x] [* [int y] [tree/ref img :width]]]] [buffer/view/set! [tree/ref img :pixels] i value]]] [export fill! [defn image/fill! [img value] [def p [tree/ref img :pixels]] [dotimes [i [* [tree/ref img :width] [tree/ref img :height]]] [buffer/view/set! p i value]] [return img]]] [export map! [defn image/map! [img fun] [def p [tree/ref img :pixels]] [dotimes [i [* [tree/ref img :width] [tree/ref img :height]]] [buffer/view/set! p i [fun [buffer/view/ref p i]]]] [return img]]] [export dup [defn image/dup [img] [def ret [image/new [tree/ref img :width] [tree/ref img :height]]] [def in [tree/ref img :pixels]] [def out [tree/ref ret :pixels]] [dotimes [i [* [tree/ref img :width] [tree/ref img :height]]] [buffer/view/set! out i [buffer/view/ref in i]]] [return ret]]] [export save! [defn image/save! [img path] [def enc [image/get-encoder path]] [if enc [file/write [enc img] path] [exception :missing-encoder "Currently there is no encoder loaded for that image format" path]]]] [export adler32 [defn image/adler32 [img] [import [hash] :crypto/adler32] [hash [tree/ref img :buffer]]]] [export test-image-xor [defn image/test-image-xor [] [def w 256] [def h 256] [def out [image/new w h]] [dotimes [x w] [dotimes [y h] [image/set! out x y [bit-or x [bit-shift-left y 8] [bit-shift-left [bit-xor x y] 16]]]]] [return out]]] [deftest 4040398435 [image/adler32 [image/test-image-xor]]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :io/ansi string/write [do [def *module* :io/ansi] [def disabled #f] [export disable! [defn disable! [v] [set! disabled [if [nil? v] #t v]]]] [def reset "\e[0m"] [def fg-reset "\e[0;39m"] [def 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-bg [array/new "\e[40m" "\e[41m" "\e[42m" "\e[43m" "\e[44m" "\e[45m" "\e[46m" "\e[47m"]] [export wrap [defn wrap [code string] "Wrap STRING in the ansi color CODE" [cat [or disabled [array/ref ansi-fg code]] string [or disabled reset]]]] [export black [defn black args [wrap 0 [apply cat args]]]] [export dark-red [defn dark-red args [wrap 1 [apply cat args]]]] [export dark-green [defn dark-green args [wrap 2 [apply cat args]]]] [export dark-brown [defn brown args [wrap 3 [apply cat args]]]] [export dark-blue [defn dark-blue args [wrap 4 [apply cat args]]]] [export purple [defn purple args [wrap 5 [apply cat args]]]] [export teal [defn teal args [wrap 6 [apply cat args]]]] [export dark-gray [defn dark-gray args [wrap 7 [apply cat args]]]] [export gray [defn gray args [wrap 8 [apply cat args]]]] [export red [defn red args [wrap 9 [apply cat args]]]] [export green [defn green args [wrap 10 [apply cat args]]]] [export yellow [defn yellow args [wrap 11 [apply cat args]]]] [export blue [defn blue args [wrap 12 [apply cat args]]]] [export pink [defn pink args [wrap 13 [apply cat args]]]] [export cyan [defn cyan args [wrap 14 [apply cat args]]]] [export white [defn white args [wrap 15 [apply cat args]]]] [export rainbow [defn rainbow args "Wrap ARGS in the colors of the rainbow!" [let* [def count 0] [cat [join [map [split [apply cat args] ""] [fn [a] [set! count [bit-and [+ 1 count] 7]] [cat [or disabled [array/ref ansi-fg [if [zero? count] 7 [+ count 8]]]] a]]] ""] [or disabled fg-reset]]]]] [export rainbow-bg [defn rainbow-bg args "Wrap ARGS in the colors of the rainbow!" [def count 0] [def colored-list [map [split [apply cat args] ""] [fn [a] [set! count [bit-and [+ 1 count] 7]] [cat [or disabled [array/ref ansi-fg [bit-xor count 7]]] [or disabled [array/ref ansi-bg count]] a]]]] [cat [join colored-list ""] [or disabled reset]]]] [export reprint-line [defn reprint-line [text width] [when-not width [set! width 20]] [print "\r"] [dotimes [i width] [print " "]] [print "\r"] [print text]]] [deftest "\e[0;33mabc\e[0m" [io/ansi/wrap 3 "abc"]] [deftest "\e[0;30m123\e[0m" [io/ansi/black "123"]] [deftest "\e[0;31m123\e[0m" [io/ansi/dark-red "123"]] [deftest "\e[0;32m123\e[0m" [io/ansi/dark-green "123"]] [deftest "\e[0;33m123\e[0m" [io/ansi/dark-brown "123"]] [deftest "\e[0;34m123\e[0m" [io/ansi/dark-blue "123"]] [deftest "\e[0;35m123\e[0m" [io/ansi/purple "123"]] [deftest "\e[0;36m123\e[0m" [io/ansi/teal "123"]] [deftest "\e[0;37m123\e[0m" [io/ansi/dark-gray "123"]] [deftest "\e[1;30m123\e[0m" [io/ansi/gray "123"]] [deftest "\e[1;31m123\e[0m" [io/ansi/red "123"]] [deftest "\e[1;32m123\e[0m" [io/ansi/green "123"]] [deftest "\e[1;33m123\e[0m" [io/ansi/yellow "123"]] [deftest "\e[1;34m123\e[0m" [io/ansi/blue "123"]] [deftest "\e[1;35m123\e[0m" [io/ansi/pink "123"]] [deftest "\e[1;36m123\e[0m" [io/ansi/cyan "123"]] [deftest "\e[1;37m123\e[0m" [io/ansi/white "123"]] [deftest "\e[1;31mt\e[1;32me\e[1;33ms\e[1;34mt\e[1;35me\e[1;36mr\e[1;37ml\e[0;37me\e[0;39m" [io/ansi/rainbow "testerle"]] [deftest "\e[0;36m\e[41mt\e[0;35m\e[42me\e[0;34m\e[43ms\e[0;33m\e[44mt\e[0;32m\e[45me\e[0;31m\e[46mr\e[0;30m\e[47ml\e[0;37m\e[40me\e[0m" [io/ansi/rainbow-bg "testerle"]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :serialization/json string/write [do [def *module* :serialization/json] [defn tree->json [v] "Converts a tree into a JSON encoded string, you should prefer VAL->JSON" [cat "{" [join [map [tree/keys v] [fn [k] [cat "\"" [keyword->string k] "\": " [val->json [tree/ref v k]]]]] ",\n"] "}"]] [export serialize [defn val->json [v] "Return V as a JSON encoded string" [case [type-of v] [:nil "null"] [[:int :float] [string v]] [:bool [if v "true" "false"]] [[:array :pair] [cat "[" [join [map v val->json] ","] "]"]] [:string [string/write v]] [:symbol [cat "\"" [symbol->string v] "\""]] [:keyword [cat "\"" [keyword->string v] "\""]] [:tree [tree->json v]] [otherwise [throw [list :type-error "Can't encode the value into JSON" v [current-lambda]]]]]]] [deftest "null" [serialization/json/serialize #nil]] [deftest "123" [serialization/json/serialize 123]] [deftest "123.123" [serialization/json/serialize 123.123]] [deftest "true" [serialization/json/serialize #t]] [deftest "false" [serialization/json/serialize #f]] [deftest "[1,2,3]" [serialization/json/serialize [array/new 1 2 3]]] [deftest "[1,true,3.0]" [serialization/json/serialize '[1 #t 3.0]]] [deftest "\"asd\"" [serialization/json/serialize 'asd]] [deftest "\"asd\"" [serialization/json/serialize :asd]] [deftest "\"asd\"" [serialization/json/serialize "asd"]] [deftest "\"asd\"" [serialization/json/serialize "asd"]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :test string/write [do [def *module* :test] [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] [export add* [defn test/add* [result expr] [set! test-list [cons [cons result expr] test-list]] [set! test-count [+ test-count 1]]]] [export add [defmacro test/add [result . expr] "Add a test where EXPR must eval to RESULT" [quasiquote [[unquote test/add*] [unquote result] [unquote [list 'quote [cons 'do expr]]]]]]] [export reset! [defn reset! [] [set! test-list [cons 4 '[+ 3 1]]] [set! test-count 1]]] [defn display-results [description] "Prints the result Message" [random/seed-initialize!] [efmtln "{} {} - [{} / {}] in {} ms" [if [and [zero? error-count] [> test-count 0]] [if [zero? success-count] [ansi-yellow "?"] [ansi-green "✓"]] [ansi-red "✗"]] description [if [zero? success-count] [ansi-yellow success-count] [ansi-green success-count]] [if [zero? error-count] [ansi-gray error-count] [ansi-red error-count]] [- [time/milliseconds] nujel-start]]] [defn test-success [res-should res-is expr] "Should be called after a test has finished successfully" [when print-passes [efmtln "{} == {}\r\n{}\r\n\r\n" [ansi-green [string/write res-is]] [ansi-green [string/write res-should]] [string/write expr]]] [set! success-count [+ 1 success-count]]] [defn test-failure [res-should res-is expr] "Should be called if EXPR does not equal RES" [when print-errors [pfmtln "{} != {}\r\n{}\r\n\r\n" [ansi-red [string/write res-is]] [ansi-green [string/write res-should]] [string/write expr]]] [set! error-count [+ 1 error-count]]] [export run-test! [defn run-test! [result rawexpr i] "Tests that RAWEXPR evaluates to RESULT" [try [fn [err] [display/error err] [test-failure result [list :exception-caught err] rawexpr]] [def expr [eval rawexpr]] [if [equal? result expr] [test-success result expr rawexpr] [test-failure result expr rawexpr]]]]] [export init! [defn init! [output-passes hide-errors] "Initialize the testing framework" [set! print-errors [not [boolean hide-errors]]] [set! print-passes [boolean output-passes]] [set! nujel-start [time/milliseconds]] [set! success-count 0] [set! error-count 0]]] [export finish! [defn finish! [description] [display-results description] [return error-count]]] [export run [defn run [output-passes hide-errors] "Run through all automated Tests" [init!] [doseq [cur-test test-list] [run-test! [car cur-test] [cdr cur-test]]] [finish! [fmt "{} {} [{System/OS} {System/Architecture}]" [ansi-blue ":core"] [ansi-rainbow "Nujel"]]]]] [reset!] [deftest #t [lambda? test/run]]]]
0E001A010E021A030401040201
}#{##[module/insert/defer :time string/write [do [def *module* :time] [export seconds [defn seconds [timestamp] "Return the seconds part of TIMESTAMP, defaults to current time" [rem [or timestamp [time]] 60]]] [export minutes [defn minutes [timestamp] "Return the minutes part of TIMESTAMP, defaults to current time" [rem [/ [or timestamp [time]] 60] 60]]] [export hours [defn hours [timestamp] "Return the hours part of TIMESTAMP, defaults to current time" [rem [/ [or timestamp [time]] 3600] 24]]] [deftest 34 [time/seconds 1637755714]] [deftest 8 [time/minutes 1637755714]] [deftest 12 [time/hours 1637755714]] [deftest 59 [time/seconds 1637755739]] [deftest 0 [time/seconds 1637755740]]]]
0E001A010E021A030401040201
}
Ben / Nujel
