Ben/Nujel - bootstrap/stdlib.no

Ben (X13/Arch) Some new benchmarks e8038fb 3 years ago 793 Commits
Raw
application/octet-stream • 194.43 KB • 1537 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
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D0E08070C0D1A0D1A0E1A0F1A1017070D0D1A111A121A131A14170711
0D1A151A161A171A181707150D1A191A1A1A1B1A1C17071901
}#{##[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]
0E000E01040107020D15020007030D240900160D0E040E010E030E0504030D02
010E030305030E030E021E0AFFE80D24160D0E010101
} 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
240E070400040404010D0E080E090E0104010E090E020401250401070A0D1502
00070B0D2409001C0D0E0C0E0A0E0B0E0D0E010E0B040204030D02010E0B0305
0B0E0B0E090E0104011E0AFFDE0D24160D150E090E010401070B0D0E090E0A04
01070E0D240900230D0E0C0E0A0E0B0E0D0E020E0B0E090E0104012604020403
0D0E0B020103050B0E0B0E0E1E0AFFDB160D0E0A0101
} 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]
0E000E010E020401040107030D15020007040D2409001C0D0E050E030E040E06
0E020E04040204030D02010E040305040E040E010E0204011E0AFFDE0D24160D
0E030101
} 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]
0E000E01040107020D15020007030D2409001C0D0E040E050E060E010E030402
040205050D02010E030305030E030E021E0AFFE20D24160D0E050101
} 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]
0E000E01040107020D15020007030D240900200D0E040E010E030E050E060E01
0E030402040104030D02010E030305030E030E021E0AFFDE0D24160D0E010101
} 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!]
020007000D0E010E02040107030D0E040E03040107050D15020007060D240900
370D0E070E080E020E06040204010B001E0E090E050E000E080E020E06040204
030D0E000201250500090004240D02010E060305060E060E031E0AFFC70D2416
0D0E0A0E050E00040201
} 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
1C01090056151B07060D15020007070D240900330D0E080E090E010E0704020E
090E020E07040204020B00072409000F1C05060D0E040E01040105070D02010E
070305070E070E040E0104011E0AFFC70D24160D0E06011601
} 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]
0E000E010E02040207030D0E040E040E010E020E000E010E05040204030E050E
03040301
} 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]
0E0007010D1B07020D2409008B0D0E030E000201040202012507040D0E030E00
0201040202022507050D0E040E061E0C0B00150D0E070E080E0404020E070E08
0E010402220B000A0E040501090004240D0E050E061E0C0B00150D0E070E080E
0504020E070E080E010402220B000A0E050501090004240D0E010E00200B0009
1C05020900120E090E080E000E0104030D0E0105000E020AFF760D0E080101
} 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]
0E000E01040107020D0E0202022807030D240900160D0E040E010E020E030403
0D0E0302012605030E030200210AFFE80D0E010101
} 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]
0E000E0104010D0E020E01040107030D240900210D0E0302012605030D0E040E
0102000E0304030D0E050E010E03020004030E030200220AFFDD0D0E010101
} 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]
0E0002000E01040205010D0E020E030E0404010E05040205050D0E060E000200
0E050E01260402040107070D0E0107080D2409001F0D0E090E070E080E01260E
0A0E040E08040204030D0E0802010305080E080E051E0AFFDF0D0E070101
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D1A241A251A261A271707240D1A281A291A2A1A2B
1707280D1A2C1A2D1A2E1A2F17072C0D1A301A311A321A331707300D1A341A35
1A361A371707340D0E3407380D1A391A3A1A3B1A3C17073901
}#{##[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
}]
0E000B0007240900071A0105000D0E020B00160E030E021A041A051A061A0717
2404030900051A0101
} 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
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A151A191A1A1707180D1A1B1A1C1A1D1A1E17071B0D
1A1F1A201A211A2217071F0D1A231A241A251A261707230D1A271A281A291A2A
17072701
}#{##[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]
150E000E01040107020D0E021A03200B0007240900610E021A04200B000E0E05
0E010E06040209004E0E021A07200B000E0E080E010E06040209003B0E021A09
200B000E0E0A0E010E0604020900280E021A0B200B000E0E0C0E010E06040209
00150E0D0E0E1A0F1A100E010E110400040404011601
} 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]
150E000E01040107020D0E021A03200B00072409004E0E021A04200B000E0E05
0E010E06040209003B0E021A07200B000E0E080E010E0604020900280E021A09
200B000E0E0A0E010E0604020900150E0B0E0C1A0D1A0E0E010E0F0400040404
011601
} 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]
150E000E01040107020D0E021A03200B00080E040900540E021A05200B00100E
060E010E070E04040309003F0E021A08200B00100E090E010E070E0404030900
2A0E021A0A200B00100E0B0E010E070E0404030900150E0C0E0D1A0E1A0F0E01
0E100400040404011601
} 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]
150E000E01040107020D0E021A03200B000802000900590E021A04200B000C0E
050E0104010900480E021A06200B000C0E070E0104010900370E021A08200B00
0C0E090E0104010900260E021A0A200B000C0E0B0E0104010900150E0C0E0D1A
0E1A0F0E010E100400040404011601
} 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]
150E000E01040107020D0E021A03200B00072409003B0E021A04200B000E0E05
0E010E0604020900280E021A07200B000E0E080E010E0604020900150E090E0A
1A0B1A0C0E010E0D0400040404011601
} 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]
150E000E01040107020D0E021A03200B0007240900370E021A04200B000C0E05
0E0104010900260E021A06200B000C0E070E0104010900150E080E091A0A1A0B
0E010E0C0400040404011601
} 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]
150E000E01040107020D0E021A03200B000E0E040E010E0504020900150E060E
071A081A090E010E0A0400040404011601
} 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]
150E000E01040107020D0E021A03200B00100E040E010E050E06040309003F0E
021A07200B00100E080E010E050E06040309002A0E021A09200B00100E0A0E01
0E050E0604030900150E0B0E0C1A0D1A0E0E010E0F0400040404011601
} collection? [l] #@[source: [[case [type-of l] [[:pair :array :tree] #t] [otherwise #f]]]] #{##[type-of l ΓεnΣym-9 :pair :array :tree #f]
150E000E01040107020D0E021A03200C0A001A0D0E021A04200C0A00100D0E02
1A05200C0A00060D1A060B00071B0900041C1601
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A2317072001
}#{##[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]
0E000E01040102012607020D2407030D240900190D0E040E010E0204020E0314
05030D0E0202012605020E020200210AFFE50D0E030101
} 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]
240900090D0E001205000E00120AFFF70D0E0001
} 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]
2407000D2409000B0D0E010E001405000E0202012605020200210AFFEE0D0E00
01
} 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]
0E000B00072409000F0E010E021A031A04040204010D0E050B00072409000702
0005050D0E060B000724090007020105060D0E061A07210B00080E080900050E
09070A0D24070B0D240900130D0E050E0B14050B0D0E050E062505050E0A0E05
0E0004020AFFE80D0E0C0E0B040101
} 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]
150E0007010D240900600D1A020E030E010401200B0007240900150E040E051A
061A070E000E080400040404010D0E030E0104011A02200B0007240900150E04
0E051A061A090E010E080400040404010D0E0111070A0D0E0B0E0C0E0A040205
0C0D0E011205010E010AFFA1160D0E0C01
} 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]
240900110D0E0002012605000D0E011205010E010C0B00090D0E000200220AFF
E60D0E011101
} 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]
2407000D150E0107020D2409005D0D1A030E040E020401200B0007240900150E
050E061A071A080E010E090400040404010D0E040E0204011A03200B00072409
00150E050E061A071A0A0E020E090400040404010D0E0211070B0D0E0B0E0014
05000D0E021205020E020AFFA4160D0E0001
} 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]
020007000D150E0107020D2409005D0D1A030E040E020401200B000724090015
0E050E061A071A080E010E090400040404010D0E040E0204011A03200B000724
0900150E050E061A071A0A0E020E090400040404010D0E0211070B0D0E000201
2505000D0E021205020E020AFFA4160D0E0001
} 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]
2407000D150E0107020D2409006A0D1A030E040E020401200B0007240900150E
050E061A071A080E010E090400040404010D0E040E0204011A03200B00072409
00150E050E061A071A0A0E020E090400040404010D0E0211070B0D0E0C0E0B04
010B000D0E0B0E00140500090004240D0E021205020E020AFF97160D0E0D0E00
040101
} 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]
2407000D150E0107020D240900610D1A030E040E020401200B0007240900150E
050E061A071A080E010E090400040404010D0E040E0204011A03200B00072409
00150E050E061A071A0A0E020E090400040404010D0E0211070B0D0E0C0E0B04
010E001405000D0E021205020E020AFFA0160D0E0D0E00040101
} 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]
0E0007010D0E020E03040105030D150E0307040D2409005D0D1A050E060E0404
01200B0007240900150E070E081A091A0A0E030E0B0400040404010D0E060E04
04011A05200B0007240900150E070E081A091A0C0E040E0B0400040404010D0E
0411070D0D0E0D0E011405010D0E041205040E040AFFA4160D0E0101
} 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]
0E000B00510E001107010D2407020D0E001205000D2409002B0D0E00110E011F
0B00130E010E021405020D0E0011050109000B0E00110E021405020D0E001205
000E000AFFD60D0E010E030E020401140900042401
} 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]
0E000E011204010B00080E0109001E0E020E01040107030D0E040E050E031104
010E050E03120401040201
} 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]
0E000B0007240900051C010D2409001C0D1A010E020E000401200B0007240900
051C010D0E001205000E000AFFE50D1B0101
} 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
}]
1A001A011A021A031807000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D1A241A251A261A271707240D1A281A291A2A1A2B
1707280D1A2C1A2D1A2E1A2F17072C0D1A301A311A321A331707300D1A341A35
1A361A371707340D1A381A391A3A1A3B1707380D1A3C1A3D1A3E1A3F17073C0D
1A401A411A421A431707400D1A441A451A461A471707440D1A481A491A4A1A4B
1707480D1A4C1A4D1A4E1A4F17074C0D1A501A511A521A531707500D1A541A55
1A561A571707540D1A581A591A5A1A5B1707580D1A5C1A5D1A5E1A5F17075C0D
0E5C07600D1A611A621A631A641707610D1A651A661A671A681707650D1A691A
6A1A6B1A6C1707690D1A6D1A6E1A6F1A7017076D0D1A711A721A731A74170771
0D1A751A761A771A7817077501
}#{##[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]
0E0024040107010D150E0207030D240900670D1A040E050E030401200B000724
0900150E060E071A081A090E020E0A0400040404010D0E050E0304011A04200B
0007240900150E060E071A081A0B0E030E0A0400040404010D0E0311070C0D0E
0D0E010E0C0E0E1104030D0E0E12050E0D0E031205030E030AFF9A160D0E0101
} 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!]
0E0024040107010D150E020E03040107040D2409007C0D1A050E060E04040120
0B0007240900190E070E081A091A0A0E020E0304010E0B0400040404010D0E06
0E0404011A05200B0007240900150E070E081A091A0C0E040E0B040004040401
0D0E0411070D0D0E0E0E030E0D0402070F0D0E100E0F04010B00100E110E010E
0D0E0F0403090004240D0E041205040E040AFF85160D0E0101
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1807080D1A0C1A0D1A0E1A0F18070C0D1A101A111A121A131807100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C01
}#{##[$nop [#nil] #@[documentation: "[] -> []\nDo nothing" source: ["[] -> []" "Do nothing" :inline '[#$0]] inline: #t] #{##[[#$0]]
1A0001
} $ret [#nil] #@[documentation: "[a] -> []\nReturn top of value stack" source: ["[a] -> []" "Return top of value stack" :inline '[#$1]] inline: #t] #{##[[#$1]]
1A0001
} $add/int [#nil] #@[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
} $dup [#nil] #@[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 [#nil] #@[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 [#nil] #@[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 [#nil] #@[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 [#nil] #@[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
} $< [#nil] #@[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
} $<= [#nil] #@[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
} $= [#nil] #@[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
} $>= [#nil] #@[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
} $> [#nil] #@[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 [#nil] #@[documentation: "[] -> [nil]\nPush a #nil on the stack" source: ["[] -> [nil]" "Push a #nil on the stack" :inline '[#$24]] inline: #t] #{##[[#$24]]
1A0001
} $car [#nil] #@[documentation: "[l] -> [car]\nReplace L with its car" source: ["[l] -> [car]" "Replace L with its car" :inline '[#$11]] inline: #t] #{##[[#$11]]
1A0001
} $cdr [#nil] #@[documentation: "[l] -> [cdr]\nReplace L with its cdr" source: ["[l] -> [cdr]" "Replace L with its cdr" :inline '[#$12]] inline: #t] #{##[[#$12]]
1A0001
} $cons [#nil] #@[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 [#nil] #@[documentation: "[name args docs body] -> [λ]\nCreate a new λ" source: ["[name args docs body] -> [λ]" "Create a new λ" :inline '[#$17]] inline: #t] #{##[[#$17]]
1A0001
} $macro/dynamic [#nil] #@[documentation: "[name args docs body] -> [μ]\nCreate a new μ" source: ["[name args docs body] -> [μ]" "Create a new μ" :inline '[#$18]] inline: #t] #{##[[#$18]]
1A0001
} $add [#nil] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$25]] inline: #t] #{##[[#$25]]
1A0001
} $sub [#nil] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$26]] inline: #t] #{##[[#$26]]
1A0001
} $mul [#nil] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$27]] inline: #t] #{##[[#$27]]
1A0001
} $div [#nil] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$28]] inline: #t] #{##[[#$28]]
1A0001
} $rem [#nil] #@[documentation: "[a b] -> [result]" source: ["[a b] -> [result]" :inline '[#$29]] inline: #t] #{##[[#$29]]
1A0001
} $push/true [#nil] #@[documentation: "[] -> [#t]" source: ["[] -> [#t]" '[#$1B]]] #{##[[#$1B]]
1A0001
} $push/false [#nil] #@[documentation: "[] -> [#f]" source: ["[] -> [#f]" '[#$1C]]] #{##[[#$1C]]
1A0001
} $zero? [#nil] #@[documentation: "[a] -> [result]" source: ["[a] -> [result]" :inline '[#$2A]] inline: #t] #{##[[#$2A]]
1A0001
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D1A241A251A261A271707240D1A281A291A2A1A2B
1707280D1A2C1A2D1A2E1A2F17072C0D1A301A311A321A331707300D1A341A35
1A361A371707340D1A381A391A3A1A3B1707380D1A3C1A3D1A3E1A3F17073C0D
1A401A411A421A431707400D1A441A451A461A471707440D1A481A491A4A1A4B
1707480D1A4C1A4D1A4E1A4F17074C0D1A501A511A521A531707500D1A541A55
1A561A571707540D1A581A591A5A1A5B1707580D1A5C1A5D1A5E1A5F17075C0D
1A601A611A621A631707600D1A641A651A661A671707640D1A681A691A6A1A6B
17076801
}#{##[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 < <= = >= >]
150E0007010D0E010E02200C0A002E0D0E010E03200C0A00240D0E010E04200C
0A001A0D0E010E05200C0A00100D0E010E06200C0A00060D1A070B000B0E0802
02200900710E010E09200C0A00600D0E010E0A200C0A00560D0E010E0B200C0A
004C0D0E010E0C200C0A00420D0E010E0D200C0A00380D0E010E0E200C0A002E
0D0E010E0F200C0A00240D0E010E10200C0A001A0D0E010E11200C0A00100D0E
010E12200C0A00060D1A070B00071B090004241601
} $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]]
150E0007010D0E010201200B0046150E0207030D0E030E04200B00081A050900
2F0E030E06200B00081A070900220E030E08200B00081A090900150E0A0E0B1A
0C1A0D0E020E0E040004040401160900D50E010202200B00BB150E02070F0D0E
0F0E10200B00081A110900A40E0F0E12200B00081A130900970E0F0E14200B00
081A1509008A0E0F0E16200B00081A1709007D0E0F0E18200B00081A19090070
0E0F0E1A200B00081A1B0900630E0F0E1C200B00081A1D0900560E0F0E1E200B
00081A1F0900490E0F0E20200B00081A2109003C0E0F0E22200B00081A230900
2F0E0F0E24200B00081A250900220E0F0E26200B00081A270900150E0A0E0B1A
0C1A0D0E020E0E040004040401160900150E0A0E0B1A0C1A0D0E020E0E040004
0404011601
} $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
} $set/val [v] #@[documentation: "[v] -> [v]\nResolve V and get the associated value on the stack" source: ["[v] -> [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 #$5 [list :literal v]]]] #{##[symbol? v throw list :invalid-bc-op "Can only get symbol" current-lambda #$5 :literal]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
0E031A070E031A080E010402040201
} $def/val [v] #@[documentation: "[v] -> [v]\nResolve V and get the associated value on the stack" source: ["[v] -> [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 #$7 [list :literal v]]]] #{##[symbol? v throw list :invalid-bc-op "Can only get symbol" current-lambda #$7 :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]
2409008A0D150E000E0111040107020D0E021A03200B00150E040E051A060E07
0201250507040309005D0E021A08200B003C150E011107090D0E091A0A200B00
180E040E050E0112110E0704030D0E011205010900140E091A0B200B000B0E01
120501090004241609001C0E021A0C200B00130E0D0E01110E050E0704030507
09000424160D0E011205010E010AFF770D0E070101
} 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]
0E000E010E021211040207030D0E030E040E020401250E052607060D0E070E08
0E0502012505050E090E0A0E0B0E060E0C0E02040104021A0D0402040104030D
0E050101
} 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]
0E00111A01200B00140E020E000E030E040E05040405040900A5150E0007060D
240900950D1A070E080E060401200B0007240900150E090E0A1A0B1A0C0E000E
0D0400040404010D0E080E0604011A07200B0007240900150E090E0A1A0B1A0E
0E060E0D0400040404010D0E0611070F0D150E080E0F040107100D0E101A1120
0B00150E120E050E0402012505040E0F040309001D0E101A07200B00140E130E
0F0E030E040E050404050409000424160D0E061205060E060AFF6C160D0E0401
01
} 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
04240D0E090E0A0E0B04011A0C04020B0044150200070D0D240900280D0E0E0E
0F0E010E0D04020E0B04020B000D0E100E0D040101090004240D02010E0D0305
0D0E0D0E000E0104011E0AFFD20D2416090004240D0E110E0102010E000E0104
012504020D0E120E010E000E0104010201260E0B04030D0E100E000E01040102
0126040101
} 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]]]] [[and [= [car code] #$5] [= [car [cadr code]] :literal]] [cdr! code] [def index-op [assemble/add-literal [cadar code] lit-arr]] [cons [if [pair? index-op] #$10 #$5] [cons index-op [assemble/build-lit-arr [cdr code] lit-arr]]]] [[and [= [car code] #$7] [= [car [cadr code]] :literal]] [cdr! code] [def index-op [assemble/add-literal [cadar code] lit-arr]] [cons [if [pair? index-op] #$8 #$7] [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 #$5 #$10 #$7 #$8 otherwise]
0E000B00072409000524010D1A010E020E00110401200B00190E030E00110E04
04020E030E00120E040402140901760E00111A05200C0B000C0D0E001211111A
06200B003B0E001205000D0E070E080E0004010E04040207090D1A010E020E09
0401200B00081A0A0900051A050E090E030E00120E04040214140901280E0011
1A0B200C0B000C0D0E001211111A06200B003B0E001205000D0E070E080E0004
010E04040207090D1A010E020E090401200B00081A0C0900051A0B0E090E030E
00120E04040214140900DA0E00111A0D200C0B000C0D0E001211111A06200B00
3B0E001205000D0E070E080E0004010E04040207090D1A010E020E090401200B
00081A0E0900051A0D0E090E030E00120E040402141409008C0E00111A0F200C
0B000C0D0E001211111A06200B003B0E001205000D0E070E080E0004010E0404
0207090D1A010E020E090401200B00081A100900051A0F0E090E030E00120E04
0402141409003E1A060E0011200B001F0E001205000D0E070E00110E0404020E
030E00120E040402140900190E110B00130E00110E030E00120E040402140900
042401
} 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
0D0E040E00120E01040205010D1A020E030E00110401200C0B00140D0E050E00
111104010B00071C0900041B0B000F0E040E00110E0104020900090E00110E01
1401
} 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]
0E0024040107010D0E0224040107030D0E040E050E0604010E03040207070D0E
080E070E01020004030D0E090E0A0E011A0B04020401070C0D0E0D0E070E0102
FF0E0C04040D0E0E0E0C0E03040201
} 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]
0E000E010E02040207030D0E040E0304010D0E000E0504000E031B040307060D
0E07150E0607080D0E090E060401070A0D0E0B1A0C0E0D0E0804010E0A040316
040101
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D0E2007240D1A251A261A271A281707250D1A291A
2A1A2B1A2C1707290D1A2D1A2E1A2F1A3017072D0D1A311A321A331A34170731
0D1A351A361A371A381707350D1A391A3A1A3B1A3C1707390D1A3D1A3E1A3F1A
4017073D0D1A411A421A431A441707410D1A451A461A471A481707450D1A491A
4A1A4B1A4C1707490D1A4D1A4E1A4F1A5017074D0D020007510D1A521A531A54
1A551707520D1A561A571A581A591707560D1A5A1A5B1A5C1A5D17075A0D1A5E
1A5F1A601A6117075E0D1A621A631A641A651707620D1A661A671A681A691807
660D1A6A1A671A6B1A6C17076A01
}#{##[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-"]
0E0002012505000D0E010E020E031A040E000403040101
} 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]
150E000E01040107020D0E021A03200B000C0E040E01040109006C0E021A0520
0B00081A0609005F0E021A07200B00160E010B000A0E0804000900070E090400
0900440E021A0A200B00100E0B0E0C0E010401040109002F0E021A0D200C0A00
100D0E021A0E200C0A00060D1A0F0B00100E100E110E01040104010900090E12
0E0104011601
} 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]
150E000E01040107020D0E021A03200B00081A0409001A0E021A05200B000C0E
060E0104010900090E070E0104011601
} 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] [$def/val [cadr source]]]]] #{##[symbol? source #f throw list :type-error "[def] needs a symbol name and a value as arguments" env bytecompile* caddr $def/val]
0E000E01121104010B00071C0900041B0C0A00170D0E0112120B00071C090004
1B0C0A00060D1A020B00150E030E041A051A06240E0704040401090004240D0E
040E080E090E0104010E0704020E0A0E0112110401040201
} 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] [$set/val [cadr source]]]]] #{##[symbol? source #f throw list :type-error "[set!] needs a symbol name and a value as arguments" env bytecompile* caddr $set/val]
0E000E01121104010B00071C0900041B0C0A00170D0E0112120B00071C090004
1B0C0A00060D1A020B00150E030E041A051A06240E0704040401090004240D0E
040E080E090E0104010E0704020E0A0E0112110401040201
} 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]
150E00040007010D0E00040007020D0E030E040E0512110E0604020E070E0104
010E040E080E0504010E0604020E090E0204010E031A0A0E0104020E040E0B0E
0504010E0604020E031A0A0E02040204071601
} 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]
0E00040007010D0E00040007020D0E031A040E050E0204010E031A060E010402
1A070E080E0912120E0A04020E031A060E0204020E0B0E0912110E0A04020E0C
0E010401040801
} 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]
0E000E01040107020D0E020201220B00180E030E041A051A060E070E08040004
040401090004240D0E090E0A0E071A0B04020E0C0402070D0D0E0E0E07040111
070F0D0E010B00170E100E110E0D0E0F0E011104030E0C040209000B0E100E0D
0E0C040201
} 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
1A080E010E09040004040401090004240D0E0A0E0B0401070C0D0E0D0E010E0C
04020B00210E060E0B0B000C0E0E0E0B0401090004240E0F0E0C0E0104020402
0900240E060E100E110E1204020E0B0B000C0E0E0E0B0401090004240E130E0C
0401040301
} 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]
0E00040007010D0E020E030E04120E050E0104030E021A060E010402040201
} 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]
0E00040007010D0E020E030E04120E050E0104030E061C04010E021A070E0104
02040301
} 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]]
0E000E0112040107020D0E030E02020504020B00180E040E051A061A070E010E
08040004040401090004240D0E011205010D0E050E090E01110E0A04020E090E
0112110E0A04020E090E0B0E0104010E0A04020E090E0C0E0104010E0A04021A
0D040501
} 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]]
0E000E0112040107020D0E030E02020504020B00180E040E051A061A070E010E
08040004040401090004240D0E011205010D0E050E090E01110E0A04020E090E
0112110E0A04020E090E0B0E0104010E0A04020E090E0C0E0104010E0A04021A
0D040501
} 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]
0E00040007010D0E020E030E0412110E0504020E060E0104010E070E0412120E
0504021A080E021A090E010402040501
} 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]
0E000E01110E0204020B000F0E030E01110E0204020900060E011107040D150E
050E04040107060D0E061A07200C0A00240D0E061A08200C0A001A0D0E061A09
200C0A00100D0E061A0A200C0A00060D1A0B0B0125150E04070C0D0E0C0E0D20
0B000E0E0E0E010E0204020901080E0C0E0F200B000E0E100E010E0204020900
F50E0C0E11200B000E0E120E010E0204020900E20E0C0E13200B000E0E140E01
0E0204020900CF0E0C0E15200B000E0E160E010E0204020900BC0E0C0E17200B
000E0E180E010E0204020900A90E0C0E19200B000E0E1A0E010E020402090096
0E0C0E1B200B000E0E1C0E010E0204020900830E0C0E1D200B000E0E1E0E010E
0204020900700E0C0E1F200B000E0E200E010E02040209005D0E0C0E21200B00
0E0E220E010E02040209004A0E0C0E23200B000E0E240E010E0204020900370E
0C0E25200B000E0E260E010E0204020900240E0C0E27200B000E0E280E011211
04010900110E290E040E01120E020E011104041609002A1A090E050E01040120
0B00180E2A0E2B1A2C1A2D0E010E2E0400040404010900090E2F0E0104011601
} bytecompile [form environment] #@[source: [[list [bytecompile* form environment] [$ret]]]] #{##[list bytecompile* form environment [#$1]]
0E000E010E020E0304021A04040201
}]
020007000D1A011A021A031A041707010D1A051A061A071A081707050D1A091A
0A1A0B1A0C1707090D1A0D1A0E1A0F1A1017070D0D1A111A121A131A14170711
0D1A151A161A171A181707150D1A191A1A1A1B1A1C1707190D1A1D1A1E1A1F1A
2017071D0D1A211A221A231A241707210D1A251A261A271A281707250D1A291A
2A1A2B1A2C1707290D1A2D1A2E1A2F1A3017072D0D1A311A321A331A34170731
0D1A351A361A371A381707350D1A391A3A1A3B1A3C1707390D1A3D1A3E1A3F1A
4017073D0D1A411A421A431A441707410D1A451A461A471A481707450D1A491A
4A1A4B1A4C1707490D1A4D1A4E1A4F1A5017074D0D1A511A521A531A54170751
0D1A551A561A571A581707550D1A591A5A1A5B1A5C1707590D1A5D1A5E1A5F1A
6017075D0D1A611A621A631A641707610D1A651A661A671A6817076501
}#{##[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 #$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 #$5 #$7] 2] [[#$6 #$9 #$A #$B #$F #$10 #$8] 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 #$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 #$5 #$7 #$6 #$9 #$A #$B #$F #$10 #$8 throw list :unknown-op "This op needs its length specified for disassembly to work" current-lambda]
150E0007010D0E011A02200C0A01140D0E011A03200C0A010A0D0E011A04200C
0A01000D0E011A05200C0A00F60D0E011A06200C0A00EC0D0E011A07200C0A00
E20D0E011A08200C0A00D80D0E011A09200C0A00CE0D0E011A0A200C0A00C40D
0E011A0B200C0A00BA0D0E011A0C200C0A00B00D0E011A0D200C0A00A60D0E01
1A0E200C0A009C0D0E011A0F200C0A00920D0E011A10200C0A00880D0E011A11
200C0A007E0D0E011A12200C0A00740D0E011A13200C0A006A0D0E011A14200C
0A00600D0E011A15200C0A00560D0E011A16200C0A004C0D0E011A17200C0A00
420D0E011A18200C0A00380D0E011A19200C0A002E0D0E011A1A200C0A00240D
0E011A1B200C0A001A0D0E011A1C200C0A00100D0E011A1D200C0A00060D1A1E
0B000802010900AB0E011A1F200C0A00380D0E011A20200C0A002E0D0E011A21
200C0A00240D0E011A22200C0A001A0D0E011A23200C0A00100D0E011A24200C
0A00060D1A1E0B000802020900650E011A25200C0A00420D0E011A26200C0A00
380D0E011A27200C0A002E0D0E011A28200C0A00240D0E011A29200C0A001A0D
0E011A2A200C0A00100D0E011A2B200C0A00060D1A1E0B000802030900150E2C
0E2D1A2E1A2F0E000E300400040404011601
} 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]
0E000E010E020E030401020804020E020E040401040207050D0E051A06220B00
0F0E071A080E052604010900050E0501
} 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 [quasiquote [$set/val [unquote [disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]]] [#$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 [$det/val [unquote [disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]]] [#$8 [quasiquote [$def/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]]]]]]] [#$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]]]]]]] [#$10 [quasiquote [$set/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 $set/val disassemble/maybe-quote literals #$6 $push/val/ext bit-or bit-shift-left #$7 $det/val #$8 $def/val/ext #$9 $jmp* bytecode-arr->offset #$A $jt* #$B $jf* #$C [$dup] #$D [$drop] #$E $get/val #$F $get/val/ext #$10 $set/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]
150E000E010E02040207030D0E031A04200B00081A050903830E031A06200B00
081A070903760E031A08200B001A1A090E0A0E000E010E020201250402040124
14140903570E031A0B200B00081A0C09034A0E031A0D200B001A1A0E0E0A0E00
0E010E020201250402040124141409032B0E031A0F200B00241A100E110E000E
120E0A0E000E010E0202012504020401040204012414140903020E031A13200B
00391A140E000E120E150E0A0E000E010E02020125040204010E160E0A0E000E
010E020202250402040102080402040204022414140902C40E031A17200B0024
1A180E110E000E120E0A0E000E010E0202012504020401040204012414140902
9B0E031A19200B00391A1A0E000E120E150E0A0E000E010E0202012504020401
0E160E0A0E000E010E0202022504020401020804020402040224141409025D0E
031A1B200B00161A1C0E1D0E010E0202012504022414140902420E031A1E200B
00161A1F0E1D0E010E0202012504022414140902270E031A20200B00161A210E
1D0E010E02020125040224141409020C0E031A22200B00081A230901FF0E031A
24200B00081A250901F20E031A26200B00241A270E110E000E120E0A0E000E01
0E0202012504020401040204012414140901C90E031A28200B00391A290E000E
120E150E0A0E000E010E02020125040204010E160E0A0E000E010E0202022504
020401020804020402040224141409018B0E031A2A200B00391A2B0E000E120E
150E0A0E000E010E02020125040204010E160E0A0E000E010E02020225040204
01020804020402040224141409014D0E031A2C200B00081A2D0901400E031A2E
200B00081A2F0901330E031A30200B00081A310901260E031A32200B00081A33
0901190E031A34200B00081A3509010C0E031A36200B00081A370900FF0E031A
38200B00081A390900F20E031A3A200B00081A3B0900E50E031A3C200B00161A
3D0E1D0E010E0202012504022414140900CA0E031A3E200B00241A3F0E110E00
0E120E0A0E000E010E0202012504020401040204012414140900A10E031A4020
0B00081A410900940E031A42200B00081A430900870E031A44200B00081A4509
007A0E031A46200B00081A4709006D0E031A48200B00081A490900600E031A4A
200B00081A4B0900530E031A4C200B00081A4D0900460E031A4E200B00081A4F
0900390E031A50200B00081A5109002C0E031A52200B00081A5309001F0E031A
54200B00081A550900120E031A56200B00081A570900051A581601
} 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]
2407000D240900280D0E010E020E030E010E040403140E001405000D0E010E05
0E060E030E01040204012505010E010E070E0304011E0AFFD20D0E080E000401
01
} 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 " - "]
150E000E01040107020D240900780D1A030E040E020401200B0007240900190E
050E061A071A080E000E0104010E090400040404010D0E040E0204011A03200B
0007240900150E050E061A071A0A0E020E090400040404010D0E0211070B0D0E
0C0E0D0E0E0E0F0E100E0B1104010206040204011A110E0B12040304010D0E02
1205020E020AFF891601
} 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]
150E000E01040107020D0E021A03200C0A00100D0E021A04200C0A00060D1A05
0B00100E060E070E01040104010900260E021A08200B000C0E060E0104010900
150E090E0A1A0B1A0C0E010E0D0400040404011601
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D1A241A251A261A271707240D1A281A291A2A1A2B
1707280D1A2C1A2D1A2E1A2F17072C01
}#{##[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]
0E0005010D0E020E03040101
} backend compile* expr current-closure]
0E0007010D2407020D1A031A041A051A061719001E0E0705000D0E080E090E0A
0400040205020D0E0105000D0E02011601
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A0807090D0E0A1A
080E041A0B0E000404070C0D1A0D1A0E1A0F1A1017070D0D1A111A121A131A14
17071101
}#{##[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*]
150E0007010D240900640D1A020E030E010401200B0007240900150E040E051A
061A070E000E080400040404010D0E030E0104011A02200B0007240900150E04
0E051A061A090E010E080400040404010D0E0111070A0D0E0B0E0C0E0D0E000E
0C040204020D0E011205010E010AFF9D1601
} 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]
0E000B00072409000A15240D131605000D0E010E020E0004020D0E030E020E00
040201
} 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]
0E0024040107010D150E0207030D240900AF0D1A040E050E030401200B000724
0900150E060E071A081A090E020E0A0400040404010D0E050E0304011A04200B
0007240900150E060E071A081A0B0E030E0A0400040404010D0E0311070C0D15
0E050E0C0401070D0D0E0D1A04200B00090E01010900430E0D1A0E200B00260E
0F0E011A100E110E120E130E140E011A10040204011A150E0C04030401040309
00180E0D1A16200B000F0E0F0E010E0C1B040309000424160D0E031205030E03
0AFF52160D0E010101
} 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"]
0E000B0007240900150E010E021A031A040E000E050400040404010D2409003E
0D0E060E0004010C0A00140D1A070E080E000401200C0A00060D1A090B000724
0900150E010E021A031A0A0E000E050400040404010D0E001205000E000AFFC3
0D0E0B0B0007240900150E010E021A031A0C0E0B0E0504000404040101
} 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"]
0E00040007010D0E020E0304000E04040207050D0E00040007060D0E070E081A
090E0A0E0B0E04040104011A0C0E0D0E0B0E05040104011A0E0E0F0E080E060E
01261A1004021A1104020406040101
} 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
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171807140D1A181A191A1A1A1B1807180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231807200D1A241A251A261A271707240D1A281A291A2A1A2B
1807280D1A2C1A2D1A2E1A2F18072C0D1A301A311A321A331707300D1A341A35
1A361A371807340D1A381A391A3A1A3B1807380D1A3C1A3D1A3E1A3F17073C0D
1A401A411A421A431807400D1A441A451A461A471707440D1A481A491A4A1A4B
18074801
}#{##[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 [#nil] [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 [#nil] #@[source: [[cons folded-fun folded-args]]] #{##[folded-fun folded-args]
0E000E011401
} apply constant-fold/resolve]
1A000E010E020401200B005D0E021107030D1A040E03200B00090E0201090004
240D0E050E0212040107060D0E070E0304010C0B000C0D0E080E060E0904020B
001F1A0A1A0B1A0C1A0D171900100E0E0E0F0E0304010E060402160900080E03
0E06140900050E0201
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A1317071001
}#{##[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]
0E000E011204010B00110E020E01110E030402241409004E1A040E050E011104
01200B0038150E020E01110E03040207060D1A040E050E060401200B00120E06
0E070E01120E0304021409000C0E070E01120E0304021609000C0E070E01120E
03040201
} 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]
0E000E010E02040207030D0E040E031204010B00090E03110900081A050E0314
01
} 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]
0E00241407010D0E021207030D15020007040D240900310D0E050E060E040402
0B00090E031109000C0E070E03110E0804020E011405010D0E031205030D0201
0E040305040E040E091E0AFFCD0D24160D0E0A0B00130E0B0E030E0804020E01
1405010900260E030B00200E0C0E0D1A0E0E0F1A100E091A1104030E020E1204
0004040401090004240D0E130E0104010101
} 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
}]
0E000E01110E0204020B000F0E030E01110E0204020900060E011107040D150E
050E04040107060D0E061A07200B00080E010901640E061A08200B00150E090E
0A0E040E011204020E02040209014A0E061A0B200B0133150E04070C0D0E0C0E
0D200B00080E0109011C0E0C0E0E200B000E0E0F0E010E0204020901090E0C0E
10200B00150E110E010E020E0402011C020004060900EF0E0C0E12200C0A0010
0D0E0C0E13200C0A00060D1A140B00150E110E010E020E0402011B0200040609
00C40E0C0E15200C0A00100D0E0C0E16200C0A00060D1A140B00150E110E010E
020E0402021C020104060900990E0C0E17200B00150E110E010E020E0402031C
0200040609007F0E0C0E18200C0A00100D0E0C0E19200C0A00060D1A140B0015
0E110E010E020E0402041B020704060900540E0C0E1A200C0A00100D0E0C0E1B
200C0A00060D1A140B00150E1C0E040E0F0E01120E02040204020900290E1D0E
041A1E04020B000F0E1F0E040E011204020900120E200E011A211A221A231A24
170402160900120E200E011A211A251A231A261704021601
} 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
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A1717071401
}#{##[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
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1807080D1A0C1A0D1A0E1A0F18070C0D1A101A111A121A1318071001
}#{##[otherwise deftest l #@[source: [#nil]] #{##[]
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
}]
1B07000D1A011A021A031A041807010D1A051A021A031A061807050D1A071A08
1A091A0A1807070D1A0B1A0C1A0D1A0E18070B0D1A0F1A101A111A1218070F0D
1A131A141A151A161707130D1A171A181A191A1A1707170D1A1B1A1C1A1D1A1E
17071B0D1A1F1A201A211A2217071F0D1A231A241A251A261707230D1A271A28
1A291A2A1707270D1A2B1A2C1A2D1A2E17072B0D1A2F1A301A311A3217072F0D
1A331A341A351A361707330D1A371A381A391A3A1707370D1A3B1A3C1A3D1A3E
17073B0D1A3F1A401A411A4217073F0D1A431A441A451A461707430D1A471A48
1A491A4A1707470D1A4B1A4C1A4D1A4E17074B0D1A4F1A501A511A5217074F0D
1A531A541A551A561707530D1A571A581A591A5A18075701
}#{##[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]
0E00040007010D0E021A030E021A040E010E0504030E060E010E070402040301
} 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]
0E001107010D0E020E0104011A03200B0007240900150E040E051A061A070E01
0E080400040404010D0E00121107090D0E0A0E000401070B0D1A0C0E01020024
141424141A0D1A0E0E010E09241414140E0F0E101A110E011A1202010E012414
1414241414142414040214140E0B241414141401
} 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!]
0E00040007010D1A020E010E03121124141424141A040E011A051A060E012414
141A071A081A090E0312112414141414241414141A0A0E011A0B241414141A0C
0E03111A0D0E01241414241414140E0E0E0F1A100E0124141424140402141414
14142414141401
} 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
}]
1A001A011A021A031807000D1A041A051A061A071807040D1A081A091A0A1A0B
1807080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171807140D1A181A191A1A1A1B1807180D1A1C1A1D1A1E1A1F18071C0D
1A201A211A221A231807200D1A241A251A261A271707240D1A281A291A2A1A2B
1807280D1A2C1A2D1A2E1A2F17072C0D1A301A311A321A3318073001
}#{##[tree/new module/cache module/store module/loader module/add-loader [f] #@[source: [[set! module/loader [cons f module/loader]]]] #{##[f module/loader]
0E000E0114050101
} module/save-state [#nil] #@[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]
0E000E011A02040205030D0E000E011A040402050501
} 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*]
0E000E01040107020D0E031A040E02040207040D150E050E04040107060D2409
00A30D1A070E080E060401200B0007240900190E090E0A1A0B1A0C0E050E0404
010E0D0400040404010D0E080E0604011A07200B0007240900150E090E0A1A0B
1A0E0E060E0D0400040404010D0E0611070F0D0E100B00120E110E010E120E0F
040104020900090E120E0F040107130D1A140E131A150E021A160E120E0F0401
241414241414142414141407170D0E180E190E1A0E170E19040204020D0E0612
05060E060AFF5E1601
} 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
0D2407050D240900530D0E0112111A06200B00291A020E070E0104011A030E04
2414140E011124141414140E051405050D0E011212050109001C1A020E01111A
030E042414140E011124141414140E051405050D0E011205010E010AFFAE0D0E
080E090E0504011401
} 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]
0E000E010E02040207030D0E030B00270E0415240D13161A050E020E060E070E
030401240402141404020D0E080E0204010900042401
} 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]
150E0007010D240900760D1A020E030E010401200B0007240900150E040E051A
061A070E000E080400040404010D0E030E0104011A02200B0007240900150E04
0E051A061A090E010E080400040404010D0E0111070A0D0E0A0E0B0401070C0D
0E0C0B00140E0D0E0E0E0B0E0C04030D0E0C01090004240D0E011205010E010A
FF8B160D240101
} 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]
150E000E01040107020D0E021A03200B00080E010900420E021A04200B00290E
050E0104010C0A001C0D0E060E0104010C0A00110D0E070E0104010C0A00060D
1A080900140E090E0A1A0B0E01240E0C0400040404011601
} 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]
0E001A010E02040207010D0E030E0104011A04200B0007240900150E050E061A
071A080E010E090400040404010D0E010101
} 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]
0E000E010E02040207030D0E040E030E0204020B0007240900240E050E061A07
0E080E020E0104020B00081A090900051A0A240E0B0400040404010D0E0C0E03
0E02040201
}]
0E0024040107010D0E0024040107020D2407030D1A041A051A061A071707040D
1A081A091A0A1A0B1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A13
1707100D1A141A151A161A171807140D1A181A191A1A1A1B1807180D1A1C1A1D
1A1E1A1F18071C0D1A201A211A221A231807200D1A241A251A261A271707240D
1A281A291A2A1A2B1807280D1A2C1A2D1A2E1A2F18072C0D1A301A311A321A33
1807300D1A341A351A361A371807340D1A381A391A3A1A3B1707380D1A3C1A3D
1A3E1A3F17073C0D1A401A411A421A431707400D1A441A451A461A471707440D
1A481A491A4A1A4B1707480D1A4C1A4D1A4E1A4F17074C0D1A501A511A521A53
1707500D1A541A551A561A5717075401
}#{##[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?]
0E000E01040107020D0E030E020E000E04040104020B00071C090048150E0207
050D0E051A06200B000E0E070E010E04040209002E0E051A08200B000E0E090E
010E04040209001B0E051A0A200B000E0E0B0E010E0404020900080E010E0420
1601
} 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
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D1A241A251A261A271707240D1A281A291A2A1A2B
1707280D1A2C1A2D1A2E1A2F17072C0D1A301A311A321A331707300D1A341A35
1A361A371707340D1A381A391A3A1A3B1707380D1A3C1A3D1A3E1A3F17073C0D
1A401A411A421A431707400D1A441A451A461A471707440D1A481A491A4A1A4B
1707480D1A4C1A4D1A4E1A4F17074C0D1A501A511A521A531707500D1A541A55
1A561A571707540D1A581A591A5A1A5B1707580D1A5C1A5D1A5E1A5F17075C0D
1A601A611A621A631707600D1A641A651A661A671707640D1A681A691A6A1A6B
1707680D1A6C1A6D1A6E1A6F17076C0D1A701A711A721A7317077001
}#{##[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
}]
1A001A011A021A031707000D1A041A051A061A071807040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C01
}#{##[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
}]
1A0007010D1A0007020D1A031A041A051A061707030D1A071A081A091A0A1807
070D1A0B1A0C1A0D1A0E17070B0D1A0F1A101A111A1218070F0D1A131A141A15
1A161707130D1A171A181A191A1A1707170D1A1B1A1C1A1D1A1E17071B0D1A1F
1A201A211A2218071F0D1A231A241A251A2617072301
}#{##[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]
0E000B00A70E000E01200B002A0E020E030E020E040E050C0A000D0D02000C0A
00060D1A0604011A07040204011A0804020900750E090E000401070A0D0E0B0E
0A0401070C0D0E020E030E020E040E050C0A000D0D02000C0A00060D1A060401
1A0D0E0E0E000401040304011A0F0E0C02101E0B000C0E0E0E0A04010900051A
101A080E110E120E0004010E040E050C0A000D0D02000C0A00060D1A06040102
0125040204050900042401
} stacktrace [#nil] #@[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]
150E0007010D0E010200200B000C0E020E03040109003C0E010201200B000C0E
040E03040109002B0E010202200B00100E050E060E03040104010900160E0102
03200B000C0E070E0304010900050E031601
} 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 " - "]
0E000E01040107020D0E030E01040107040D0E050E060E0404011A070E020403
01
} 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*]]
0E000B0007240900070E0105000D0E020B000724090007020005020D0E030B00
07240900071A0405030D0E050E060E001A0704020E020E020E032524040401
} gensym/counter gensym [prefix] #@[source: [[inc! gensym/counter] [string->symbol [cat prefix "ΓεnΣym-" gensym/counter]]]] #{##[gensym/counter string->symbol cat prefix "ΓεnΣym-"]
0E0002012505000D0E010E020E031A040E000403040101
} current-closure root-closure]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D1A241A251A261A271707240D020007280D1A291A
2A1A2B1A2C1707290D0E2D0400072E01
}#{##[random/seed random/seed-initialize! [#nil] #@[source: [[set! random/seed [bit-xor [time] [time/milliseconds]]]]] #{##[bit-xor time time/milliseconds random/seed]
0E000E0104000E0204000402050301
} random/rng! [#nil] #@[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]
1A000E011A02272505010D0E030E040E050E011A060402021004020E050E070E
01021004021A060402040201
} 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]
0E00050101
} [#nil] #@[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
}]
020007000D1A011A021A031A041707010D1A051A061A071A081707050D1A091A
0A1A0B1A0C1707090D1A001A0D1A0E1A0F1707000D1A101A111A121A13170710
0D0E01040001
}#{##[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]
0E0002010E01250207040205010D0E020E030C0A00210D0E040E050E012A0B00
0802070900080E0102082504020C0A00060D1A060E07040201
} ansi/disabled ansi-fg-reset #f]
15020007000D0E010E020E030E040E050E010E0604021A0704021A081A091A0A
1A0B1704021A0704020E0C0C0A000D0D0E0D0C0A00060D1A0E04021601
} 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]
0E0002010E01250207040205010D0E020E030C0A00190D0E040E050E060E0102
07040204020C0A00060D1A070E030C0A00130D0E040E080E0104020C0A00060D
1A070E09040301
} colored-list join ansi/disabled ansi-reset #f]
020007000D0E010E020E030E040E0504021A0604021A071A081A091A0A170402
070B0D0E040E0C0E0B1A0604020E0D0C0A000D0D0E0E0C0A00060D1A0F040201
} 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]
0E000B000724090007021405000D0E011A0204010D15020007030D240900120D
0E011A0404010D02010E030305030E030E001E0AFFEC0D24160D0E011A020401
0D0E010E05040101
}]
1C07000D1A0107020D1A0307040D1A0507060D0E071A081A091A0A1A0B1A0C1A
0D1A0E1A0F1A101A111A121A131A141A151A161A17041007180D1A0107020D0E
071A191A1A1A1B1A1C1A1D1A1E1A1F1A20040807210D1A221A231A241A251707
220D1A261A271A281A291707260D1A2A1A271A2B1A2C17072A0D1A2D1A271A2E
1A2F17072D0D1A301A271A311A321707300D1A331A271A341A351707330D1A36
1A271A371A381707360D1A391A271A3A1A3B1707390D1A3C1A271A3D1A3E1707
3C0D1A3F1A271A401A4117073F0D1A421A271A431A441707420D1A451A271A46
1A471707450D1A481A271A491A4A1707480D1A4B1A271A4C1A4D17074B0D1A4E
1A271A4F1A5017074E0D1A511A271A521A531707510D1A541A271A551A561707
540D1A571A271A581A591707570D1A5A1A271A5B1A5C17075A0D1A5D1A5E1A5F
1A6017075D01
}#{##[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]
0E0002001E0B000802FF0900300E010E020E00040207030D0E030230210C0B00
090D0E0302391F0B00110E040E020E0002012604020900050E0001
} 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]
0E000E0104012A0B00080E020902A3150E030E010E000E010401020126040207
040D0E040230200C0A00600D0E040231200C0A00560D0E040232200C0A004C0D
0E040233200C0A00420D0E040234200C0A00380D0E040235200C0A002E0D0E04
0236200C0A00240D0E040237200C0A001A0D0E040238200C0A00100D0E040239
200C0A00060D1A050B006B0E060E010E000E010401020126040207070D0E080E
0102010E07250E000E010401040307090D0E0A0E021A0B0E0C0E09040104030D
02300E030E0902000402200B00100E0A0E021A0D1A0E0403090004240D0E0F0E
020E080E01020002010E0725040304020901BE0E04023F200B00240E0F0E0A0E
021A101B04030E080E0102000E000E010401020126040304020901950E040258
200B00250E0F0E0A0E021A111A1204030E080E0102000E000E01040102012604
03040209016B0E040278200B00250E0F0E0A0E021A111A1304030E080E010200
0E000E010401020126040304020901410E040264200B00250E0F0E0A0E021A11
1A1404030E080E0102000E000E010401020126040304020901170E04026F200B
00250E0F0E0A0E021A111A1504030E080E0102000E000E010401020126040304
020900ED0E040262200B00250E0F0E0A0E021A111A1604030E080E0102000E00
0E010401020126040304020900C30E04023C200B00250E0F0E0A0E021A171A18
04030E080E0102000E000E010401020126040304020900990E04025E200B0025
0E0F0E0A0E021A171A1904030E080E0102000E000E0104010201260403040209
006F0E04023E200B00250E0F0E0A0E021A171A1A04030E080E0102000E000E01
0401020126040304020900450E04022E200B002B0E0F0E0A0E021A1B0E1C0E02
1A0B040204030E080E0102000E000E010401020126040304020900150E1D0E1E
1A1F1A200E010E210400040404011601
} 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]
150E000E011A02040207030D0E031A04200B001C0E050E011A060E070E080E00
0E011A060402040204030900890E031A09200B001C0E050E011A060E070E0A0E
000E011A060402040204030900680E031A0B200B001C0E050E011A060E070E0C
0E000E011A060402040204030900470E031A0D200B001C0E050E011A060E070E
0E0E000E011A060402040204030900260E031A0F200B001C0E050E011A060E07
0E100E000E011A060402040204030900050E011601
} :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]
0E000E011A0204020B00850E030E011A040E05150E000E011A06040207070D0E
071A08200B00080E0909001E0E071A0A200B00080E0B0900110E071A0C200B00
080E0D09000424160E000E011A0404020E000E011A0E04020C0B000C0D0E000E
011A0F04020B00110E000E011A02040202022609000B0E000E011A0204020E00
0E011A100402040404030900050E0101
} 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]
150E000E01040107020D0E021A03200B00160E040E051A060E070E0104010402
04010900330E021A08200B00080E010900260E021A09200B000C0E0A0E010401
0900150E0B0E0C1A0D1A0E0E010E0F0400040404011601
} 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
0E070E011A08040207090D0E0911070A0D0E0912110C0A000D0D1A0B0C0A0006
0D1A0C070D0D1A0B0E0A200B00330E0E0E0F1A1002FF04030D0E110E120E130E
0F1A1004021B04030D0E140E0D0E150E130E0F1A100402040104020900A8150E
160E0A040107170D0E17120B00180E020E031A041A180E0A0E06040004040401
090004240D0E190E171104010B0007240900150E020E031A041A1A0E0A0E0604
00040404010D0E1B0E171104010B00460E171102001E0C0A00150D0E17110E1C
0E120401210C0A00060D1A0C0B00180E020E031A041A1D0E0A0E060400040404
01090004240D0E110E120E17111B0403090004240D0E140E0D0E150E17110401
04021601
} 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]
0E000E011A020E030E0404010402040107050D0E0402012505040D0E061A070E
050E08040301
} let* append map]
0E000E0104010B0007240900150E020E031A041A050E010E060400040404010D
2407070D15020007080D240900850D150E090E010E080402070A0D0E0A027B20
0B002E0E0B0E071104010B00180E020E031A0C1A0D0E010E0604000404040109
0004240D0E080E0714050709003C0E0A027D200B00330E0B0E071104010B0007
240900150E020E031A0C1A0E0E010E060400040404010D0E07110E08140E0712
14050709000424160D02010E080305080E080E0F0E0104011E0AFF750D24160D
0E0B0E071104010B00180E020E031A0C1A0D0E010E0604000404040109000424
0D2407100D0E0F0E01040107110D0E120E130E140E15040104011C040207160D
0E171A180E190E1604010402071A0D150E07071B0D240900A20D1A1C0E1D0E1B
0401200B0007240900150E020E031A041A1E0E070E060400040404010D0E1D0E
1B04011A1C200B0007240900150E020E031A041A1F0E1B0E060400040404010D
0E1B1107200D0E210E010E20120201250E11040307220D1A230E22200B000724
09000A0E220E101405100D0E240E210E0102010E2011250E201204030E160E1A
040307250D0E250E101405100D0E201105110D0E1B12051B0E1B0AFF5F160D0E
110200220B001A0E210E0102000E11040307220D0E220E10140510090004240D
15020007080D240900390D0E260E160E0804020B0007240900210E020E031A0C
1A270E030E010E280E150E08040204020E060400040404010D02010E08030508
0E080E190E1604011E0AFFC10D24160D0E10120B000B1A290E10140900180E00
0E101104010B00090E10110900081A2A0E101407250D0200072B0D1A2C1A2D1A
2E1A2F17072C0D0E150B00191A300E310E320E150E2C04020E25241404021409
00050E2501
} 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
}]
0E001A011A021A031C1A041C1A05241A061A07040A07080D1A091A0A1A0B1A0C
1707090D1A0D1A0E1A0F1A1017070D0D1A111A121A131A141707110D1A151A16
1A171A181707150D0E001A191A1A1A1B1A1C1A1D1A1E1A1F1A201A211A20040A
07220D1A231A241A251A261707230D1A271A281A291A2A1707270D1A2B1A2C1A
2D1A2E17072B0D1A2F1A301A311A3217072F0D1A331A341A351A361707330D1A
371A381A391A3A1707370D1A3B1A3C1A3D1A3E17073B0D1A3F1A401A411A4217
073F0D1A431A441A451A461707430D1A471A481A491A4A1807470D1A4B1A4C1A
4D1A4E18074B0D1A4F1A501A511A5218074F0D1A531A541A551A561807530D1A
571A581A591A5A18075701
}#{##[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]
0E000E010E020401040107030D15020007040D2409001C0D0E050E030E040E06
0E020E04040204030D02010E040305040E040E010E0204011E0AFFDE0D24160D
0E0301
} 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 [#nil] #@[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
}]
0E000E010E020401040107030D0E040E051A061A071A081A0917040201
} throw list :type-error "Expected a :string or :list"]
150E000E01040107020D0E021A03200B000F1A041A051A061A07170900250E02
1A08200B000F1A041A091A0A1A0B170900110E0C0E0D1A0E1A0F0E0104030401
1601
} 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]
0E000E011A02040207030D0E030200210B00170E040E0102010E03250E050E01
040104030900050E0101
} 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]
0E000E011A02040207030D0E030200210B00100E040E0102000E030403090005
0E0101
} 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=]
1A0007010D0E020B000724090007020007020D0E022A0B000A1A030501090004
240D240900260D0E040E0502300E060E02020104022504010E01040205010D0E
070E020201040205020E0802000E0204020AFFD50D0E0101
} 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=]
1A0007010D0E020B000724090007020007020D0E022A0B000A1A030501090004
240D240900260D0E040E0502300E060E02020704022504010E01040205010D0E
070E020203040205020E0802000E0204020AFFD50D0E0101
} 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=]
1A0007010D0E020B000724090007020007020D0E022A0B000A1A030501090004
240D0E0202001E0B00180E040E051A061A070E020E0804000404040109000424
0D240900250D0E090E0A0E0B0E0C0E02020F040204020E01040205010D0E0D0E
020204040205020E0E02000E0204020AFFD60D0E0101
} 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]
0E000B0007240900071A0105000D0E020E0304010B00072409000B0E040E0304
0105030D0E020E0004010B0007240900150E050E061A071A080E000E09040004
0404010D2409000E0D0E0A0E000E03040205030E0B0E0304010E0C1E0AFFEC0D
0E0B0E0304010E0C220B001B0E0D0E030E0B0E0304010E0C260E0B0E03040104
030900050E0301
} 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]
0E000B0007240900071A0105000D0E020E0304010B00072409000B0E040E0304
0105030D0E020E0004010B0007240900150E050E061A071A080E000E09040004
0404010D2409000E0D0E0A0E030E00040205030E0B0E0304010E0C1E0AFFEC0D
0E0B0E0304010E0C220B00100E0D0E0302000E0C04030900050E0301
} 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]
0E000B0007240900071A0105000D0E020E0304010B00072409000B0E040E0304
0105030D0E020E0004010B0007240900150E050E061A071A080E000E09040004
0404010D240900100D0E0A0E000E030E00040305030E0B0E0304010E0C1E0AFF
EA0D0E0B0E0304010E0C220B0033150E0B0E0304010E0C26020228070D0D0E0B
0E0304010E0C260E0D26070E0D0E0F0E030E0E0E0E0E0C250403160900050E03
01
} 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]
0E000E011A02040207030D0E030200210B00160E040E0102000E030201250E05
2504030900050E0101
} 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]
0E000E01040107020D020007030D2407040D2409001E0D0E050E010E0302010E
032504030E041405040D0E0302012505030E030E021E0AFFE00D0E060E040401
01
} 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]
0E000B000724090007020005000D0E010E020E030E00040307040D0E04020021
0B00220E050E020E000E0404030E060E020E030E040E070E0304012504031409
00130E050E020E000E070E0204010403241401
} 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
00040404010D150E090E080401070A0D0E0A0200200B000C0E0B0E0104010900
0D0E0C0E010E08020004031601
} 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
}]
1A001A011A021A031707000D1A041A051A061A071707040D1A081A091A0A1A0B
1707080D1A0C1A0D1A0E1A0F17070C0D1A101A111A121A131707100D1A141A15
1A161A171707140D1A181A191A1A1A1B1707180D1A1C1A1D1A1E1A1F17071C0D
1A201A211A221A231707200D1A241A251A261A271707240D1A281A291A2A1A2B
1707280D1A2C1A2D1A2E1A2F17072C0D0E301A311A321A331A341A351A361A37
1A381A391A3A1A3B1A3C1A3D1A3E1A3F1A40041007410D1A421A431A441A4517
07420D1A461A471A481A491707460D1A4A1A4B1A4C1A4D17074A0D0E4A074E0D
1A4F1A501A511A5217074F0D1A531A541A551A561707530D1A571A581A591A5A
1707570D1A5B1A5C1A5D1A5E17075B0D1A5F1A601A611A6217075F0D1A631A64
1A651A661707630D1A671A681A691A6A1707670D1A6B1A6C1A6D1A6E17076B0D
1A6F1A701A711A7217076F0D1A731A741A751A761707730D1A771A781A791A7A
1707770D1A7B1A7C1A7D1A7E17077B0D1A7F1A801A811A8217077F0D1A831A84
1A851A8617078301
}#{##[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! [#nil] [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 [#nil] [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! [#nil] [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
