Ben / Nujel

#{
25v lognand v l v #@[documentation: "Returns the Nand of its arguments" source: ["Returns the Nand of its arguments" [lognot [apply logand l]]]] v #{
10s logand
10s l
08i 2 v apply
08i 1 v lognot
01
}
0Es lognand
0D
25v bit-set? v [α i] v #@[documentation: "Returns #t if bit I is set in Α" source: ["Returns #t if bit I is set in Α" [typecheck/only α :int] [typecheck/only i :int] [not [zero? [logand α [ash 1 i]]]]]] v #{
10s α
08i 1 v type-of
05v :int
20
0Bo 7
24
09o 30
05v :type-error
05v "Expected a value of type :int"
10s α
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s i
08i 1 v type-of
05v :int
20
0Bo 7
24
09o 30
05v :type-error
05v "Expected a value of type :int"
10s i
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
02i 0
10s α
02i 1
10s i
08i 2 v ash
08i 2 v logand
20
0Bo 10
05v #f
09o 7
05v #t
01
}
0Es bit-set?
0D
25v bit-set?! v [i] v #@[documentation: "Returns a function that checks if bit I is set in the provided number" source: ["Returns a function that checks if bit I is set in the provided number" [typecheck/only i :int] [def mask [ash 1 i]] [fn [α] [not [zero? [logand α mask]]]]]] v #{
10s i
08i 1 v type-of
05v :int
20
0Bo 7
24
09o 30
05v :type-error
05v "Expected a value of type :int"
10s i
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
02i 1
10s i
08i 2 v ash
0Es mask
0D
25v 'anonymous v [α] v #@[source: [[not [zero? [logand α mask]]]]] v #{
02i 0
10s α
10s mask
08i 2 v logand
20
0Bo 10
05v #f
09o 7
05v #t
01
}
01
}
0Es bit-set?!
0D
25v bit-clear?! v [i] v #@[documentation: "Returns a function that checks if bit I is clear in the provided number" source: ["Returns a function that checks if bit I is clear in the provided number" [typecheck/only i :int] [def mask [ash 1 i]] [fn [α] [zero? [logand α mask]]]]] v #{
10s i
08i 1 v type-of
05v :int
20
0Bo 7
24
09o 30
05v :type-error
05v "Expected a value of type :int"
10s i
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
02i 1
10s i
08i 2 v ash
0Es mask
0D
25v 'anonymous v [α] v #@[source: [[zero? [logand α mask]]]] v #{
02i 0
10s α
10s mask
08i 2 v logand
20
01
}
01
}
0Es bit-clear?!
01
}#{
25v array/2d/allocate v [width height] v #@[source: [[tree/new :data [-> [array/allocate [* width height]] [array/fill! 0]] :width width :height height]]] v #{
05v :data
10s width
10s height
08i 2 v *
08i 1 v array/allocate
02i 0
08i 2 v array/fill!
05v :width
10s width
05v :height
10s height
08i 6 v tree/new
01
}
0Es array/2d/allocate
0D
25v array/2d/fill! v [data v] v #@[source: [[array/fill! [tree/ref data :data] v] data]] v #{
10s data
05v :data
08i 2 v tree/ref
10s v
08i 2 v array/fill!
0D
10s data
01
}
0Es array/2d/fill!
0D
25v array/2d/ref v [data x y oob-val] v #@[source: [[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]]]]]]] v #{
10s x
10s data
05v :width
08i 2 v tree/ref
21
0C
0Ao 55
0D
10s y
10s data
05v :height
08i 2 v tree/ref
21
0C
0Ao 32
0D
10s x
02i 0
1E
0C
0Ao 20
0D
10s y
02i 0
1E
0C
0Ao 8
0D
05v #f
0Bo 10
10s oob-val
09o 52
10s data
05v :data
08i 2 v tree/ref
10s x
10s y
10s data
05v :width
08i 2 v tree/ref
08i 2 v *
08i 2 v +
08i 2 v array/ref
01
}
0Es array/2d/ref
0D
25v array/2d/set! v [data x y val] v #@[source: [[if [or [>= x [tree/ref data :width]] [>= y [tree/ref data :height]] [< x 0] [< y 0]] [throw [list :out-of-bounds "Trying to set an array out of bounds" data [current-lambda]]] [array/set! [tree/ref data :data] [+ x [* y [tree/ref data :width]]] val]] data]] v #{
10s x
10s data
05v :width
08i 2 v tree/ref
21
0C
0Ao 55
0D
10s y
10s data
05v :height
08i 2 v tree/ref
21
0C
0Ao 32
0D
10s x
02i 0
1E
0C
0Ao 20
0D
10s y
02i 0
1E
0C
0Ao 8
0D
05v #f
0Bo 33
05v :out-of-bounds
05v "Trying to set an array out of bounds"
10s data
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 56
10s data
05v :data
08i 2 v tree/ref
10s x
10s y
10s data
05v :width
08i 2 v tree/ref
08i 2 v *
08i 2 v +
10s val
08i 3 v array/set!
0D
10s data
01
}
0Es array/2d/set!
0D
25v array/2d/print v [data] v #@[source: [[for [y 0 [tree/ref data :height]] [for [x 0 [tree/ref data :width]] [display [cat [array/2d/ref data x y] " "]]] [newline]] data]] v #{
15
02i 0
0Es y
0D
10s data
05v :height
08i 2 v tree/ref
0Es ΓεnΣym-22
0D
02i 0
1B
1C
10s y
10s ΓεnΣym-22
1E
0Bo 115
0D
15
02i 0
0Es x
0D
10s data
05v :width
08i 2 v tree/ref
0Es ΓεnΣym-23
0D
02i 0
1B
1C
10s x
10s ΓεnΣym-23
1E
0Bo 50
0D
10s data
10s x
10s y
08i 3 v array/2d/ref
05v " "
08i 2 v cat
08i 1 v print
0D
02i 1
10s x
03
0Fs x
09o -57
16
0D
08i 0 v newline
0D
02i 1
10s y
03
0Fs y
09o -122
16
0D
10s data
01
}
0Es array/2d/print
01
}#{
25v array/+= v [a i v] 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]]]]] v #{
10s a
10s i
10s v
10s a
10s i
08i 2 v array/ref
08i 2 v +
08i 3 v array/set!
01
}
0Es array/+=
0D
25v array/++ v [a i] v #@[documentation: "Increment position I in A and return A" source: ["Increment position I in A and return A" [array/+= a i 1]]] v #{
10s a
10s i
02i 1
08i 3 v array/+=
01
}
0Es array/++
0D
25v array/fill! v [a v] v #@[documentation: "Fills array a with value v" source: ["Fills array a with value v" [def len [array/length a]] [for [i 0 len] [array/set! a i v]] a]] v #{
10s a
08i 1 v array/length
0Es len
0D
15
02i 0
0Es i
0D
10s len
0Es ΓεnΣym-11
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-11
1E
0Bo 36
0D
10s a
10s i
10s v
08i 3 v array/set!
0D
02i 1
10s i
03
0Fs i
09o -43
16
0D
10s a
01
}
0Es array/fill!
0D
25v array/append v [a b] v #@[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]]]] [for [i 0 [array/length a]] [array/set! ret i [array/ref a i]]] [for [i [array/length a] [array/length ret]] [array/set! ret i [array/ref b [- i [array/length a]]]]] ret]] v #{
10s a
08i 1 v array?
0C
0Bo 13
0D
10s b
08i 1 v array?
0Bo 7
24
09o 27
05v :type-error
05v "array/append expects two arrays as its arguments"
24
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s a
08i 1 v array/length
10s b
08i 1 v array/length
08i 2 v +
08i 1 v array/allocate
0Es ret
0D
15
02i 0
0Es i
0D
10s a
08i 1 v array/length
0Es ΓεnΣym-12
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-12
1E
0Bo 45
0D
10s ret
10s i
10s a
10s i
08i 2 v array/ref
08i 3 v array/set!
0D
02i 1
10s i
03
0Fs i
09o -52
16
0D
15
10s a
08i 1 v array/length
0Es i
0D
10s ret
08i 1 v array/length
0Es ΓεnΣym-13
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-13
1E
0Bo 59
0D
10s ret
10s i
10s b
10s i
10s a
08i 1 v array/length
08i 2 v -
08i 2 v array/ref
08i 3 v array/set!
0D
02i 1
10s i
03
0Fs i
09o -66
16
0D
10s ret
01
}
0Es array/append
0D
25v array/dup v [a] v #@[documentation: "Duplicate Array A" source: ["Duplicate Array A" [def ret [array/allocate [array/length a]]] [for [i 0 [array/length a]] [array/set! ret i [array/ref a i]]] ret]] v #{
10s a
08i 1 v array/length
08i 1 v array/allocate
0Es ret
0D
15
02i 0
0Es i
0D
10s a
08i 1 v array/length
0Es ΓεnΣym-14
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-14
1E
0Bo 45
0D
10s ret
10s i
10s a
10s i
08i 2 v array/ref
08i 3 v array/set!
0D
02i 1
10s i
03
0Fs i
09o -52
16
0D
10s ret
01
}
0Es array/dup
0D
25v array/reduce v [arr fun α] v #@[documentation: "Reduce an array, [reduce] should be preferred" source: ["Reduce an array, [reduce] should be preferred" [def len [array/length arr]] [for [i 0 len] [set! α [fun α [array/ref arr i]]]] α]] v #{
10s arr
08i 1 v array/length
0Es len
0D
15
02i 0
0Es i
0D
10s len
0Es ΓεnΣym-15
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-15
1E
0Bo 46
0D
10s fun
10s α
10s arr
10s i
08i 2 v array/ref
1Ai 2
0Fs α
0D
02i 1
10s i
03
0Fs i
09o -53
16
0D
10s α
01
}
0Es array/reduce
0D
25v array/map v [arr fun] v #@[documentation: "Map an array, [map] should be preferred" source: ["Map an array, [map] should be preferred" [def len [array/length arr]] [for [i 0 len] [array/set! arr i [fun [array/ref arr i]]]] arr]] v #{
10s arr
08i 1 v array/length
0Es len
0D
15
02i 0
0Es i
0D
10s len
0Es ΓεnΣym-16
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-16
1E
0Bo 51
0D
10s arr
10s i
10s fun
10s arr
10s i
08i 2 v array/ref
1Ai 1
08i 3 v array/set!
0D
02i 1
10s i
03
0Fs i
09o -58
16
0D
10s arr
01
}
0Es array/map
0D
25v array/filter v [arr pred] v #@[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]] [for [ai 0 len] [when [pred [array/ref arr ai]] [array/set! ret ri [array/ref arr ai]] [++ ri]]] [array/length! ret ri]]] v #{
02i 0
0Es ri
0D
10s arr
08i 1 v array/length
0Es len
0D
10s len
08i 1 v array/allocate
0Es ret
0D
15
02i 0
0Es ai
0D
10s len
0Es ΓεnΣym-17
0D
02i 0
1B
1C
10s ai
10s ΓεnΣym-17
1E
0Bo 87
0D
10s pred
10s arr
10s ai
08i 2 v array/ref
1Ai 1
0Bo 48
10s ret
10s ri
10s arr
10s ai
08i 2 v array/ref
08i 3 v array/set!
0D
02i 1
10s ri
08i 2 v +
0Fs ri
09o 4
24
0D
02i 1
10s ai
03
0Fs ai
09o -94
16
0D
10s ret
10s ri
08i 2 v array/length!
01
}
0Es array/filter
0D
25v array/equal? v [a b] v #@[source: [[if [or [not [array? a]] [not [array? b]] [!= [array/length a] [array/length b]]] #f [let [[ret #t]] [for [i 0 [array/length a]] [when-not [equal? [array/ref a i] [array/ref b i]] [set! ret #f] [set! i [array/length a]]]] ret]]]] v #{
10s a
08i 1 v array?
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 64
0D
10s b
08i 1 v array?
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 36
0D
10s a
08i 1 v array/length
10s b
08i 1 v array/length
08i 2 v !=
0C
0Ao 8
0D
05v #f
0Bo 10
05v #f
09o 134
15
05v #t
0Es ret
0D
15
02i 0
0Es i
0D
10s a
08i 1 v array/length
0Es ΓεnΣym-18
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-18
1E
0Bo 79
0D
10s a
10s i
08i 2 v array/ref
10s b
10s i
08i 2 v array/ref
08i 2 v equal?
0Bo 7
24
09o 25
05v #f
0Fs ret
0D
10s a
08i 1 v array/length
0Fs i
0D
02i 1
10s i
03
0Fs i
09o -86
16
0D
10s ret
16
01
}
0Es array/equal?
0D
25v array/push v [arr val] v #@[documentation: "Append VAL to ARR" source: ["Append VAL to ARR" [-> arr [array/length! [+ 1 [array/length arr]]] [array/set! [- [array/length arr] 1] val]]]] v #{
10s arr
02i 1
10s arr
08i 1 v array/length
08i 2 v +
08i 2 v array/length!
10s arr
08i 1 v array/length
02i 1
08i 2 v -
10s val
08i 3 v array/set!
01
}
0Es array/push
0D
25v array/swap v [arr i j] v #@[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]]]] v #{
10s arr
10s i
08i 2 v array/ref
0Es tmp
0D
10s arr
10s i
10s arr
10s j
08i 2 v array/ref
08i 3 v array/set!
10s j
10s tmp
08i 3 v array/set!
01
}
0Es array/swap
0D
25v array/heapify v [arr n at] v #@[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 [+ [ash at 1] 1]] [def r [+ [ash 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]]]] arr]] v #{
10s at
0Es top
0D
05v #t
0Es looping
0D
02i 0
1B
1C
10s looping
0Bo 216
0D
10s at
02i 1
08i 2 v ash
02i 1
08i 2 v +
0Es l
0D
10s at
02i 1
08i 2 v ash
02i 2
08i 2 v +
0Es r
0D
10s l
10s n
1E
0C
0Bo 31
0D
10s arr
10s l
08i 2 v array/ref
10s arr
10s top
08i 2 v array/ref
22
0Bo 14
10s l
0Fs top
09o 4
24
0D
10s r
10s n
1E
0C
0Bo 31
0D
10s arr
10s r
08i 2 v array/ref
10s arr
10s top
08i 2 v array/ref
22
0Bo 14
10s r
0Fs top
09o 4
24
0D
10s top
10s at
20
0Bo 14
05v #f
0Fs looping
09o 29
10s arr
10s at
10s top
08i 3 v array/swap
0D
10s top
0Fs at
09o -218
0D
10s arr
01
}
0Es array/heapify
0D
25v array/make-heap v [arr] v #@[source: [[def l [array/length arr]] [def l2 [/ l 2]] [while [>= l2 0] [array/heapify arr l l2] [-- l2]] arr]] v #{
10s arr
08i 1 v array/length
0Es l
0D
10s l
02i 2
08i 2 v /
0Es l2
0D
02i 0
1B
1C
10s l2
02i 0
21
0Bo 40
0D
10s arr
10s l
10s l2
08i 3 v array/heapify
0D
02i -1
10s l2
08i 2 v +
0Fs l2
09o -45
0D
10s arr
01
}
0Es array/make-heap
0D
25v array/heap-sort v [arr] v #@[source: [[array/make-heap arr] [def l [array/length arr]] [while [> l 0] [-- l] [array/swap arr 0 l] [array/heapify arr l 0]] arr]] v #{
10s arr
08i 1 v array/make-heap
0D
10s arr
08i 1 v array/length
0Es l
0D
02i 0
1B
1C
10s l
02i 0
22
0Bo 54
0D
02i -1
10s l
08i 2 v +
0Fs l
0D
10s arr
02i 0
10s l
08i 3 v array/swap
0D
10s arr
10s l
02i 0
08i 3 v array/heapify
09o -59
0D
10s arr
01
}
0Es array/heap-sort
0D
10s array/heap-sort
0Es array/sort
0D
25v array/cut v [arr start end] v #@[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]]]] [for [i start end] [array/set! ret [- i start] [array/ref arr i]]] ret]] v #{
02i 0
10s start
08i 2 v max
0Fs start
0D
10s arr
08i 1 v array/length
10s end
08i 2 v min
0Fs end
0D
02i 0
10s end
10s start
08i 2 v -
08i 2 v max
08i 1 v array/allocate
0Es ret
0D
15
10s start
0Es i
0D
10s end
0Es ΓεnΣym-19
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-19
1E
0Bo 54
0D
10s ret
10s i
10s start
08i 2 v -
10s arr
10s i
08i 2 v array/ref
08i 3 v array/set!
0D
02i 1
10s i
03
0Fs i
09o -61
16
0D
10s ret
01
}
0Es array/cut
01
}#{
05v :e
0Es avl/empty
0D
25v avl/empty? v [n] v #@[source: [[== :e n]]] v #{
05v :e
10s n
20
01
}
0Es avl/empty?
0D
25v avl/default-cmp v [x y] v #@[source: [[if [< x y] -1 [if [> x y] 1 0]]]] v #{
10s x
10s y
1E
0Bo 8
02i -1
09o 22
10s x
10s y
22
0Bo 8
02i 1
09o 5
02i 0
01
}
0Es avl/default-cmp
0D
25v avl/typecheck v [r k] v #@[source: [[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]]]]]] v #{
10s r
08i 1 v avl/root
08i 1 v avl/empty?
0C
0Ao 74
0D
10s k
08i 1 v type-of
10s r
08i 1 v avl/root
08i 1 v avl/key
08i 1 v type-of
20
0C
0Ao 40
0D
05v :type-error
05v "AVL trees can only contains keys of a single type"
10s k
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0C
0Ao 8
0D
05v #f
01
}
0Es avl/typecheck
0D
25v avl/tree v [cmp] v #@[source: [[array/new avl/empty [or cmp avl/default-cmp]]]] v #{
10s avl/empty
10s cmp
0C
0Ao 17
0D
10s avl/default-cmp
0C
0Ao 8
0D
05v #f
08i 2 v array/new
01
}
0Es avl/tree
0D
25v avl/height v [n] v #@[source: [[if [avl/empty? n] 0 [array/ref n 0]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 8
02i 0
09o 14
10s n
02i 0
08i 2 v array/ref
01
}
0Es avl/height
0D
25v avl/key v [n] v #@[source: [[array/ref n 1]]] v #{
10s n
02i 1
08i 2 v array/ref
01
}
0Es avl/key
0D
25v avl/left v [n] v #@[source: [[array/ref n 2]]] v #{
10s n
02i 2
08i 2 v array/ref
01
}
0Es avl/left
0D
25v avl/right v [n] v #@[source: [[array/ref n 3]]] v #{
10s n
02i 3
08i 2 v array/ref
01
}
0Es avl/right
0D
25v avl/root v [r] v #@[source: [[array/ref r 0]]] v #{
10s r
02i 0
08i 2 v array/ref
01
}
0Es avl/root
0D
25v avl/cmp v [r] v #@[source: [[array/ref r 1]]] v #{
10s r
02i 1
08i 2 v array/ref
01
}
0Es avl/cmp
0D
25v avl/min-node v [n] v #@[source: [[if [avl/empty? n] avl/empty [let [[l [avl/left n]]] [if [avl/empty? l] n [avl/min-mode l]]]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 10
10s avl/empty
09o 48
15
10s n
08i 1 v avl/left
0Es l
0D
10s l
08i 1 v avl/empty?
0Bo 10
10s n
09o 13
10s avl/min-mode
10s l
1Ai 1
16
01
}
0Es avl/min-node
0D
25v avl/update-left v [n l] v #@[source: [[array/set! [array/dup n] 2 l]]] v #{
10s n
08i 1 v array/dup
02i 2
10s l
08i 3 v array/set!
01
}
0Es avl/update-left
0D
25v avl/update-right v [n r] v #@[source: [[array/set! [array/dup n] 3 r]]] v #{
10s n
08i 1 v array/dup
02i 3
10s r
08i 3 v array/set!
01
}
0Es avl/update-right
0D
25v avl/update-key v [n k] v #@[source: [[array/set! [array/dup n] 1 k]]] v #{
10s n
08i 1 v array/dup
02i 1
10s k
08i 3 v array/set!
01
}
0Es avl/update-key
0D
25v avl/update-root v [t r] v #@[source: [[array/set! [array/dup t] 0 r]]] v #{
10s t
08i 1 v array/dup
02i 0
10s r
08i 3 v array/set!
01
}
0Es avl/update-root
0D
25v avl/update-height v [n] v #@[source: [[array/set! [array/dup n] 0 [+ 1 [max [avl/height [avl/left n]] [avl/height [avl/right n]]]]]]] v #{
10s n
08i 1 v array/dup
02i 0
02i 1
10s n
08i 1 v avl/left
08i 1 v avl/height
10s n
08i 1 v avl/right
08i 1 v avl/height
08i 2 v max
08i 2 v +
08i 3 v array/set!
01
}
0Es avl/update-height
0D
25v avl/rotate-right v [y] v #@[source: [[let [[x [avl/left y]]] [avl/update-height [avl/update-right x [avl/update-height [avl/update-left y [avl/right x]]]]]]]] v #{
15
10s y
08i 1 v avl/left
0Es x
0D
10s x
10s y
10s x
08i 1 v avl/right
08i 2 v avl/update-left
08i 1 v avl/update-height
08i 2 v avl/update-right
08i 1 v avl/update-height
16
01
}
0Es avl/rotate-right
0D
25v avl/rotate-left v [x] v #@[source: [[let [[y [avl/right x]]] [avl/update-height [avl/update-left y [avl/update-height [avl/update-right x [avl/left y]]]]]]]] v #{
15
10s x
08i 1 v avl/right
0Es y
0D
10s y
10s x
10s y
08i 1 v avl/left
08i 2 v avl/update-right
08i 1 v avl/update-height
08i 2 v avl/update-left
08i 1 v avl/update-height
16
01
}
0Es avl/rotate-left
0D
25v avl/balance v [n] v #@[source: [[if [avl/empty? n] 0 [- [avl/height [avl/left n]] [avl/height [avl/right n]]]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 8
02i 0
09o 36
10s n
08i 1 v avl/left
08i 1 v avl/height
10s n
08i 1 v avl/right
08i 1 v avl/height
08i 2 v -
01
}
0Es avl/balance
0D
25v avl/insert-rebalance v [n cmp v] v #@[source: [[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]]]]] v #{
15
10s n
08i 1 v avl/balance
0Es b
0D
10s b
02i 1
22
0Bo 118
15
10s cmp
10s v
10s n
08i 1 v avl/left
08i 1 v avl/key
1Ai 2
0Es ΓεnΣym-29
0D
10s ΓεnΣym-29
02i -1
20
0Bo 15
10s n
08i 1 v avl/rotate-right
09o 62
10s ΓεnΣym-29
02i 1
20
0Bo 34
10s n
10s n
08i 1 v avl/left
08i 1 v avl/rotate-left
08i 2 v avl/update-left
08i 1 v avl/rotate-right
09o 21
10s ΓεnΣym-29
02i 0
20
0Bo 10
10s n
09o 4
24
16
09o 143
10s b
02i -1
1E
0Bo 118
15
10s cmp
10s v
10s n
08i 1 v avl/right
08i 1 v avl/key
1Ai 2
0Es ΓεnΣym-30
0D
10s ΓεnΣym-30
02i 1
20
0Bo 15
10s n
08i 1 v avl/rotate-left
09o 62
10s ΓεnΣym-30
02i -1
20
0Bo 34
10s n
10s n
08i 1 v avl/right
08i 1 v avl/rotate-right
08i 2 v avl/update-right
08i 1 v avl/rotate-left
09o 21
10s ΓεnΣym-30
02i 0
20
0Bo 10
10s n
09o 4
24
16
09o 18
05v #t
0Bo 10
10s n
09o 4
24
16
01
}
0Es avl/insert-rebalance
0D
25v avl/node-insert v [n cmp v] v #@[source: [[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]]]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 25
02i 1
10s v
10s avl/empty
10s avl/empty
08i 4 v array/new
09o 180
15
10s cmp
10s v
10s n
08i 1 v avl/key
1Ai 2
0Es ΓεnΣym-31
0D
10s ΓεnΣym-31
02i -1
20
0Bo 55
10s n
10s n
08i 1 v avl/left
10s cmp
10s v
08i 3 v avl/node-insert
08i 2 v avl/update-left
08i 1 v avl/update-height
10s cmp
10s v
08i 3 v avl/insert-rebalance
09o 92
10s ΓεnΣym-31
02i 1
20
0Bo 55
10s n
10s n
08i 1 v avl/right
10s cmp
10s v
08i 3 v avl/node-insert
08i 2 v avl/update-right
08i 1 v avl/update-height
10s cmp
10s v
08i 3 v avl/insert-rebalance
09o 30
10s ΓεnΣym-31
02i 0
20
0Bo 19
10s n
10s v
08i 2 v avl/update-key
09o 4
24
16
01
}
0Es avl/node-insert
0D
25v avl/insert v [t v] v #@[documentation: "Insert key V into tree T.  If a node with an equivalent key already exists, its key is updated to V" source: ["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]]]] v #{
10s t
10s v
08i 2 v avl/typecheck
0D
10s t
10s t
08i 1 v avl/root
10s t
08i 1 v avl/cmp
10s v
08i 3 v avl/node-insert
08i 2 v avl/update-root
01
}
0Es avl/insert
0D
25v avl/node-get v [n cmp v] v #@[source: [[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]]]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 7
24
09o 122
15
10s cmp
10s v
10s n
08i 1 v avl/key
1Ai 2
0Es ΓεnΣym-32
0D
10s ΓεnΣym-32
02i 0
20
0Bo 15
10s n
08i 1 v avl/key
09o 74
10s ΓεnΣym-32
02i -1
20
0Bo 28
10s n
08i 1 v avl/left
10s cmp
10s v
08i 3 v avl/node-get
09o 39
10s ΓεnΣym-32
02i 1
20
0Bo 28
10s n
08i 1 v avl/right
10s cmp
10s v
08i 3 v avl/node-get
09o 4
24
16
01
}
0Es avl/node-get
0D
25v avl/get v [t v] v #@[documentation: "Retrieve the key V from tree T, or #nil if V is not in it" source: ["Retrieve the key V from tree T, or #nil if V is not in it" [if [or [avl/empty? [avl/root t]] [!= [type-of v] [type-of [avl/key [avl/root t]]]]] #nil [avl/node-get [avl/root t] [avl/cmp t] v]]]] v #{
10s t
08i 1 v avl/root
08i 1 v avl/empty?
0C
0Ao 46
0D
10s v
08i 1 v type-of
10s t
08i 1 v avl/root
08i 1 v avl/key
08i 1 v type-of
08i 2 v !=
0C
0Ao 8
0D
05v #f
0Bo 7
24
09o 30
10s t
08i 1 v avl/root
10s t
08i 1 v avl/cmp
10s v
08i 3 v avl/node-get
01
}
0Es avl/get
0D
25v avl/from-list v [l cmp] v #@[documentation: "Create a new avl tree using the keys in L and the comparison function CMP" source: ["Create a new avl tree using the keys in L and the comparison function CMP" [list/reduce l avl/insert [avl/tree cmp]]]] v #{
10s l
10s avl/insert
10s cmp
08i 1 v avl/tree
08i 3 v list/reduce
01
}
0Es avl/from-list
0D
25v avl/remove-rebalance v [n] v #@[source: [[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]]]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 10
10s n
09o 188
15
10s n
08i 1 v avl/balance
0Es b
0D
10s n
08i 1 v avl/left
0Es l
0D
10s n
08i 1 v avl/right
0Es r
0D
10s b
02i 1
22
0Bo 56
10s l
08i 1 v avl/balance
02i 0
21
0Bo 15
10s n
08i 1 v avl/rotate-right
09o 26
10s n
10s l
08i 1 v avl/rotate-left
08i 2 v avl/update-left
08i 1 v avl/rotate-right
09o 81
10s b
02i -1
1E
0Bo 56
10s r
08i 1 v avl/balance
02i 0
1F
0Bo 15
10s n
08i 1 v avl/rotate-left
09o 26
10s n
10s r
08i 1 v avl/rotate-right
08i 2 v avl/update-right
08i 1 v avl/rotate-left
09o 18
05v #t
0Bo 10
10s n
09o 4
24
16
01
}
0Es avl/remove-rebalance
0D
25v avl/node-remove v [n cmp v] v #@[source: [[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]]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 10
10s n
09o 301
15
15
10s cmp
10s v
10s n
08i 1 v avl/key
1Ai 2
0Es ΓεnΣym-33
0D
10s ΓεnΣym-33
02i -1
20
0Bo 37
10s n
10s n
08i 1 v avl/left
10s cmp
10s v
08i 3 v avl/node-remove
08i 2 v avl/update-left
09o 201
10s ΓεnΣym-33
02i 1
20
0Bo 37
10s n
10s n
08i 1 v avl/right
10s cmp
10s v
08i 3 v avl/node-remove
08i 2 v avl/update-right
09o 157
10s ΓεnΣym-33
02i 0
20
0Bo 146
10s n
08i 1 v avl/left
08i 1 v avl/empty?
0Bo 15
10s n
08i 1 v avl/right
09o 114
10s n
08i 1 v avl/right
08i 1 v avl/empty?
0Bo 15
10s n
08i 1 v avl/left
09o 85
05v #t
0Bo 77
15
10s n
08i 1 v avl/right
08i 1 v avl/min-node
08i 1 v avl/key
0Es k
0D
10s n
08i 1 v avl/right
10s n
08i 1 v avl/right
10s cmp
10s v
08i 3 v avl/node-remove
08i 2 v avl/update-right
10s k
08i 2 v avl/update-key
16
09o 4
24
09o 4
24
16
0Es root
0D
10s root
08i 1 v avl/update-height
0Fs root
0D
10s root
08i 1 v avl/remove-rebalance
16
01
}
0Es avl/node-remove
0D
25v avl/remove v [t v] v #@[documentation: "Remove the key V from tree T if it is contained within it" source: ["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]]]] v #{
10s t
10s t
08i 1 v avl/root
10s t
08i 1 v avl/cmp
10s v
08i 3 v avl/node-remove
08i 2 v avl/update-root
01
}
0Es avl/remove
0D
25v avl/equal-node? v [a b] v #@[source: [[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]]]]]] v #{
10s a
08i 1 v avl/empty?
0Bo 15
10s b
08i 1 v avl/empty?
09o 82
10s a
08i 1 v avl/key
10s b
08i 1 v avl/key
08i 2 v equal?
0C
0Bo 55
0D
10s a
08i 1 v avl/left
10s b
08i 1 v avl/left
08i 2 v avl/equal-node?
0C
0Bo 27
0D
10s a
08i 1 v avl/right
10s b
08i 1 v avl/right
08i 2 v avl/equal-node?
01
}
0Es avl/equal-node?
0D
25v avl/equal? v [a b] v #@[documentation: "Test if two avl trees are equal" source: ["Test if two avl trees are equal" [avl/equal-node? [avl/root a] [avl/root b]]]] v #{
10s a
08i 1 v avl/root
10s b
08i 1 v avl/root
08i 2 v avl/equal-node?
01
}
0Es avl/equal?
0D
25v avl/reduce-node v [node o s] v #@[source: [[if [avl/empty? node] s [o [avl/key node] [avl/reduce-node [avl/right node] o [avl/reduce-node [avl/left node] o s]]]]]] v #{
10s node
08i 1 v avl/empty?
0Bo 10
10s s
09o 58
10s o
10s node
08i 1 v avl/key
10s node
08i 1 v avl/right
10s o
10s node
08i 1 v avl/left
10s o
10s s
08i 3 v avl/reduce-node
08i 3 v avl/reduce-node
1Ai 2
01
}
0Es avl/reduce-node
0D
25v avl/reduce v [t o s] v #@[documentation: "Reduce T in-order with a reducer O taking a key and the result of the reductions of one subtree" source: ["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]]] v #{
10s t
08i 1 v avl/root
10s o
10s s
08i 3 v avl/reduce-node
01
}
0Es avl/reduce
0D
25v avl/reduce-node-bin v [n o s] v #@[source: [[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]]]]] v #{
10s n
08i 1 v avl/empty?
0Bo 10
10s s
09o 68
10s o
10s o
10s n
08i 1 v avl/key
10s n
08i 1 v avl/left
10s o
10s s
08i 3 v avl/reduce-node-bin
1Ai 2
10s n
08i 1 v avl/right
10s o
10s s
08i 3 v avl/reduce-node-bin
1Ai 2
01
}
0Es avl/reduce-node-bin
0D
25v avl/reduce-bin v [t o s] v #@[documentation: "Reduce T with a reducer O taking a key and the result of the reductions of both subtrees" source: ["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]]] v #{
10s t
08i 1 v avl/root
10s o
10s s
08i 3 v avl/reduce-node-bin
01
}
0Es avl/reduce-bin
0D
25v avl/map v [t f] v #@[documentation: "Create a new avl tree by mapping each key in T using F, using the same comparison function as T" source: ["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]]]]] v #{
10s t
25v 'anonymous v [x acc] v #@[source: [[avl/insert acc [f x]]]] v #{
10s acc
10s f
10s x
1Ai 1
08i 2 v avl/insert
01
}
10s t
08i 1 v avl/cmp
08i 1 v avl/tree
08i 3 v avl/reduce
01
}
0Es avl/map
0D
25v avl/map-to v [t f cmp] v #@[documentation: "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" source: ["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]]]] v #{
10s t
25v 'anonymous v [x acc] v #@[source: [[avl/insert acc [f x]]]] v #{
10s acc
10s f
10s x
1Ai 1
08i 2 v avl/insert
01
}
10s cmp
08i 1 v avl/tree
08i 3 v avl/reduce
01
}
0Es avl/map-to
0D
25v avl/to-list v [t] v #@[source: [[avl/reduce t cons #nil]]] v #{
10s t
10s cons
24
08i 3 v avl/reduce
01
}
0Es avl/to-list
01
}#{
25v sum v [c] v #@[documentation: "Return the sum of every value in collection C" source: ["Return the sum of every value in collection C" [reduce c + 0]]] v #{
10s c
10s +
02i 0
08i 3 v reduce
01
}
0Es sum
0D
25v join v [l glue] v #@[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]]]] v #{
10s glue
0Bo 7
24
09o 11
05v ""
0Fs glue
0D
10s l
0Bo 29
10s l
25v 'anonymous v [a b] v #@[source: [[if a [cat a glue b] b]]] v #{
10s a
0Bo 23
10s a
10s glue
10s b
08i 3 v cat
09o 7
10s b
01
}
24
08i 3 v reduce
09o 7
05v ""
01
}
0Es join
0D
25v for-each v [l f] v #@[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]]] v #{
10s l
25v 'anonymous v [a b] v #@[source: [[f b]]] v #{
10s f
10s b
1Ai 1
01
}
24
08i 3 v reduce
01
}
0Es for-each
0D
25v count v [l p] v #@[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]]]] v #{
10s p
0Bo 30
10s l
25v 'anonymous v [a b] v #@[source: [[+ a [if [p b] 1 0]]]] v #{
10s a
10s p
10s b
1Ai 1
0Bo 8
02i 1
09o 5
02i 0
08i 2 v +
01
}
02i 0
08i 3 v reduce
09o 27
10s l
25v 'anonymous v [a b] v #@[source: [[+ a 1]]] v #{
10s a
02i 1
08i 2 v +
01
}
02i 0
08i 3 v reduce
01
}
0Es count
0D
25v min v l v #@[documentation: "Returns the minimum value of its arguments, or collection" source: ["Returns the minimum value of its arguments, or collection" [reduce [if [cdr l] l [car l]] [fn [a b] [if [< a b] a b]]]]] v #{
10s l
12
0Bo 10
10s l
09o 8
10s l
11
25v 'anonymous v [a b] v #@[source: [[if [< a b] a b]]] v #{
10s a
10s b
1E
0Bo 10
10s a
09o 7
10s b
01
}
08i 2 v reduce
01
}
0Es min
0D
25v max v l v #@[documentation: "Returns the minimum value of its arguments, or collection" source: ["Returns the minimum value of its arguments, or collection" [reduce [if [cdr l] l [car l]] [fn [a b] [if [> a b] a b]]]]] v #{
10s l
12
0Bo 10
10s l
09o 8
10s l
11
25v 'anonymous v [a b] v #@[source: [[if [> a b] a b]]] v #{
10s a
10s b
22
0Bo 10
10s a
09o 7
10s b
01
}
08i 2 v reduce
01
}
0Es max
0D
25v delete v [l e] v #@[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]]]]]] v #{
10s l
25v 'anonymous v [a] v #@[source: [[not [== a e]]]] v #{
10s a
10s e
20
0Bo 10
05v #f
09o 7
05v #t
01
}
08i 2 v filter
01
}
0Es delete
0D
25v remove v [l p] v #@[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]]]]]] v #{
10s l
25v 'anonymous v [a] v #@[source: [[not [p a]]]] v #{
10s p
10s a
1Ai 1
0Bo 10
05v #f
09o 7
05v #t
01
}
08i 2 v filter
01
}
0Es remove
0D
25v flatten/λ v [a b] v #@[source: [[cond [[collection? b] [append [reduce b flatten/λ #nil] a]] [#t [cons b a]]]]] v #{
10s b
08i 1 v collection?
0Bo 29
10s b
10s flatten/λ
24
08i 3 v reduce
10s a
08i 2 v append
09o 23
05v #t
0Bo 15
10s b
10s a
14
09o 4
24
01
}
0Es flatten/λ
0D
25v flatten v [l] v #@[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]]]]] v #{
10s l
08i 1 v collection?
0Bo 25
10s l
10s flatten/λ
24
08i 3 v reduce
08i 1 v nreverse
09o 7
10s l
01
}
0Es flatten
01
}#{
25v ref v [l i] v #@[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 use ref with a collection" l [current-lambda]]]]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-43
0D
10s ΓεnΣym-43
05v :nil
20
0Bo 7
24
09o 142
10s ΓεnΣym-43
05v :tree
20
0Bo 19
10s l
10s i
08i 2 v tree/ref
09o 114
10s ΓεnΣym-43
05v :string
20
0Bo 19
10s l
10s i
08i 2 v char-at
09o 86
10s ΓεnΣym-43
05v :array
20
0Bo 19
10s l
10s i
08i 2 v array/ref
09o 58
10s ΓεnΣym-43
05v :pair
20
0Bo 19
10s l
10s i
08i 2 v list/ref
09o 30
05v :type-error
05v "You can only use ref with a collection"
10s l
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es ref
0D
25v filter v [l p] v #@[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 use filter with a collection" l [current-lambda]]]]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-44
0D
10s ΓεnΣym-44
05v :nil
20
0Bo 7
24
09o 114
10s ΓεnΣym-44
05v :tree
20
0Bo 19
10s l
10s p
08i 2 v tree/filter
09o 86
10s ΓεnΣym-44
05v :pair
20
0Bo 19
10s l
10s p
08i 2 v list/filter
09o 58
10s ΓεnΣym-44
05v :array
20
0Bo 19
10s l
10s p
08i 2 v array/filter
09o 30
05v :type-error
05v "You can only use filter with a collection"
10s l
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es filter
0D
25v reduce v [l f α] v #@[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 [f α l]]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-45
0D
10s ΓεnΣym-45
05v :nil
20
0Bo 10
10s α
09o 113
10s ΓεnΣym-45
05v :tree
20
0Bo 23
10s l
10s f
10s α
08i 3 v tree/reduce
09o 81
10s ΓεnΣym-45
05v :pair
20
0Bo 23
10s l
10s f
10s α
08i 3 v list/reduce
09o 49
10s ΓεnΣym-45
05v :array
20
0Bo 23
10s l
10s f
10s α
08i 3 v array/reduce
09o 17
10s f
10s α
10s l
1Ai 2
16
01
}
0Es reduce
0D
25v length v [α] v #@[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]]]]]]] v #{
15
10s α
08i 1 v type-of
0Es ΓεnΣym-46
0D
10s ΓεnΣym-46
05v :nil
20
0Bo 8
02i 0
09o 126
10s ΓεnΣym-46
05v :array
20
0Bo 15
10s α
08i 1 v array/length
09o 102
10s ΓεnΣym-46
05v :pair
20
0Bo 15
10s α
08i 1 v list/length
09o 78
10s ΓεnΣym-46
05v :string
20
0Bo 15
10s α
08i 1 v string/length
09o 54
10s ΓεnΣym-46
05v :tree
20
0Bo 15
10s α
08i 1 v tree/size
09o 30
05v :type-error
05v "You can only use length with a collection"
10s α
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es length
0D
25v map v [l f] v #@[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]]]]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-47
0D
10s ΓεnΣym-47
05v :nil
20
0Bo 7
24
09o 86
10s ΓεnΣym-47
05v :pair
20
0Bo 19
10s l
10s f
08i 2 v list/map
09o 58
10s ΓεnΣym-47
05v :array
20
0Bo 19
10s l
10s f
08i 2 v array/map
09o 30
05v :type-error
05v "You can only use map with a collection"
10s l
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es map
0D
25v sort v [l] v #@[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]]]]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-48
0D
10s ΓεnΣym-48
05v :nil
20
0Bo 7
24
09o 78
10s ΓεnΣym-48
05v :pair
20
0Bo 15
10s l
08i 1 v list/sort/merge
09o 54
10s ΓεnΣym-48
05v :array
20
0Bo 15
10s l
08i 1 v array/heap-sort
09o 30
05v :type-error
05v "You can only use sort with a collection"
10s l
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es sort
0D
25v member v [l m] v #@[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]]]]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-49
0D
10s ΓεnΣym-49
05v :pair
20
0Bo 19
10s l
10s m
08i 2 v list/member
09o 30
05v :type-error
05v "You can only use member with a collection"
10s l
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es member
0D
25v cut v [l start end] v #@[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]]]]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-50
0D
10s ΓεnΣym-50
05v :array
20
0Bo 23
10s l
10s start
10s end
08i 3 v array/cut
09o 94
10s ΓεnΣym-50
05v :pair
20
0Bo 23
10s l
10s start
10s end
08i 3 v list/cut
09o 62
10s ΓεnΣym-50
05v :string
20
0Bo 23
10s l
10s start
10s end
08i 3 v string/cut
09o 30
05v :type-error
05v "You can only use member with a collection"
10s l
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es cut
0D
25v collection? v [l] v #@[source: [[case [type-of l] [[:pair :array :tree] #t] [otherwise #f]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-51
0D
10s ΓεnΣym-51
05v :pair
20
0C
0Ao 36
0D
10s ΓεnΣym-51
05v :array
20
0C
0Ao 22
0D
10s ΓεnΣym-51
05v :tree
20
0C
0Ao 8
0D
05v #f
0Bo 10
05v #t
09o 7
05v #f
16
01
}
0Es collection?
01
}#{
25v array->list v [arr] v #@[source: [[def i [- [array/length arr] 1]] [def ret #nil] [while [>= i 0] [set! ret [cons [array/ref arr i] ret]] [-- i]] [return ret]]] v #{
10s arr
08i 1 v array/length
02i 1
08i 2 v -
0Es i
0D
24
0Es ret
0D
02i 0
1B
1C
10s i
02i 0
21
0Bo 45
0D
10s arr
10s i
08i 2 v array/ref
10s ret
14
0Fs ret
0D
02i -1
10s i
08i 2 v +
0Fs i
09o -50
0D
10s ret
01
01
}
0Es array->list
0D
25v except-last-pair/iter v [list rest] v #@[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]]]]] v #{
10s list
12
08i 1 v nil?
0Bo 15
10s rest
08i 1 v reverse
09o 23
10s list
12
10s list
11
10s rest
14
08i 2 v except-last-pair/iter
01
}
0Es except-last-pair/iter
0D
25v except-last-pair v [list] v #@[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]]] v #{
10s list
24
08i 2 v except-last-pair/iter
01
}
0Es except-last-pair
0D
25v last-pair v [list] v #@[documentation: "Return the last pair of LIST" source: ["Return the last pair of LIST" [while [cdr list] [cdr! list]] list]] v #{
02i 0
1B
1C
10s list
12
0Bo 16
0D
10s list
12
0Fs list
09o -19
0D
10s list
01
}
0Es last-pair
0D
25v make-list v [number value] v #@[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 [>= [-- number] 0] [set! list [cons value list]]] list]] v #{
24
0Es list
0D
02i 0
1B
1C
02i -1
10s number
08i 2 v +
0Fs number
02i 0
21
0Bo 20
0D
10s value
10s list
14
0Fs list
09o -36
0D
10s list
01
}
0Es make-list
0D
25v range v [end start step] v #@[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]]] v #{
10s end
0Bo 7
24
09o 21
05v :arity-error
05v "[range] needs at least a specific end"
08i 2 v list
08i 1 v throw
0D
10s start
0Bo 7
24
09o 9
02i 0
0Fs start
0D
10s step
0Bo 7
24
09o 9
02i 1
0Fs step
0D
10s step
05v 0.0
21
0Bo 10
10s <
09o 7
10s >
0Es pred
0D
24
0Es ret
0D
02i 0
1B
1C
10s pred
10s start
10s end
1Ai 2
0Bo 38
0D
10s start
10s ret
14
0Fs ret
0D
10s start
10s step
08i 2 v +
0Fs start
09o -50
0D
10s ret
08i 1 v nreverse
01
}
0Es range
0D
25v list/reduce v [l o s] v #@[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" [for-in [e l] [set! s [o s e]]] s]] v #{
15
10s l
0Es ΓεnΣym-58
0D
10s ΓεnΣym-58
0Bo 59
02i 0
1B
1C
10s ΓεnΣym-58
0Bo 45
0D
10s ΓεnΣym-58
11
0Es e
0D
10s o
10s s
10s e
1Ai 2
0Fs s
0D
10s ΓεnΣym-58
12
0Fs ΓεnΣym-58
09o -47
09o 4
24
16
0D
10s s
01
}
0Es list/reduce
0D
25v list/ref v [l i] v #@[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]] [-- i] [cdr! l]] [car l]]] v #{
02i 0
1B
1C
10s l
0C
0Bo 11
0D
10s i
02i 0
22
0Bo 32
0D
02i -1
10s i
08i 2 v +
0Fs i
0D
10s l
12
0Fs l
09o -46
0D
10s l
11
01
}
0Es list/ref
0D
25v reverse v [l] v #@[documentation: "Return the list l in reverse order" source: ["Return the list l in reverse order" [def ret] [for-in [e l] [set! ret [cons e ret]]] ret]] v #{
24
0Es ret
0D
15
10s l
0Es ΓεnΣym-59
0D
10s ΓεnΣym-59
0Bo 54
02i 0
1B
1C
10s ΓεnΣym-59
0Bo 40
0D
10s ΓεnΣym-59
11
0Es e
0D
10s e
10s ret
14
0Fs ret
0D
10s ΓεnΣym-59
12
0Fs ΓεnΣym-59
09o -42
09o 4
24
16
0D
10s ret
01
}
0Es reverse
0D
25v list/length v [l] v #@[documentation: "Returns the length of list l" source: ["Returns the length of list l" [def ret 0] [for-in [e l] [++ ret]] ret]] v #{
02i 0
0Es ret
0D
15
10s l
0Es ΓεnΣym-60
0D
10s ΓεnΣym-60
0Bo 56
02i 0
1B
1C
10s ΓεnΣym-60
0Bo 42
0D
10s ΓεnΣym-60
11
0Es e
0D
02i 1
10s ret
08i 2 v +
0Fs ret
0D
10s ΓεnΣym-60
12
0Fs ΓεnΣym-60
09o -44
09o 4
24
16
0D
10s ret
01
}
0Es list/length
0D
25v list/filter v [l p] v #@[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] [for-in [e l] [when [p e] [set! ret [cons e ret]]]] [nreverse ret]]] v #{
24
0Es ret
0D
15
10s l
0Es ΓεnΣym-61
0D
10s ΓεnΣym-61
0Bo 71
02i 0
1B
1C
10s ΓεnΣym-61
0Bo 57
0D
10s ΓεnΣym-61
11
0Es e
0D
10s p
10s e
1Ai 1
0Bo 19
10s e
10s ret
14
0Fs ret
09o 4
24
0D
10s ΓεnΣym-61
12
0Fs ΓεnΣym-61
09o -59
09o 4
24
16
0D
10s ret
08i 1 v nreverse
01
}
0Es list/filter
0D
25v list/map v [l f] v #@[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] [for-in [e l] [set! ret [cons [f e] ret]]] [nreverse ret]]] v #{
24
0Es ret
0D
15
10s l
0Es ΓεnΣym-62
0D
10s ΓεnΣym-62
0Bo 60
02i 0
1B
1C
10s ΓεnΣym-62
0Bo 46
0D
10s ΓεnΣym-62
11
0Es e
0D
10s f
10s e
1Ai 1
10s ret
14
0Fs ret
0D
10s ΓεnΣym-62
12
0Fs ΓεnΣym-62
09o -48
09o 4
24
16
0D
10s ret
08i 1 v nreverse
01
}
0Es list/map
0D
25v append v [a b] v #@[documentation: "Appends two lists A and B together" source: ["Appends two lists A and B together" [def ret b] [set! a [reverse a]] [for-in [t a] [set! ret [cons t ret]]] ret]] v #{
10s b
0Es ret
0D
10s a
08i 1 v reverse
0Fs a
0D
15
10s a
0Es ΓεnΣym-63
0D
10s ΓεnΣym-63
0Bo 54
02i 0
1B
1C
10s ΓεnΣym-63
0Bo 40
0D
10s ΓεnΣym-63
11
0Es t
0D
10s t
10s ret
14
0Fs ret
0D
10s ΓεnΣym-63
12
0Fs ΓεnΣym-63
09o -42
09o 4
24
16
0D
10s ret
01
}
0Es append
0D
25v sublist v [l start end ret] v #@[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]]]]]] v #{
10s l
08i 1 v nil?
0Bo 15
10s ret
08i 1 v reverse
09o 164
10s end
05v 0.0
1E
0Bo 37
10s l
10s start
10s l
08i 1 v length
10s end
08i 2 v +
08i 3 v sublist
09o 118
02i 0
10s end
20
0Bo 15
10s ret
08i 1 v reverse
09o 96
10s start
02i 0
22
0Bo 39
10s l
12
02i -1
10s start
08i 2 v +
02i -1
10s end
08i 2 v +
24
08i 4 v sublist
09o 50
10s end
02i 0
22
0Bo 39
10s l
12
02i 0
02i -1
10s end
08i 2 v +
10s l
11
10s ret
14
08i 4 v sublist
09o 4
24
01
}
0Es sublist
0D
25v list-head v [l k] v #@[documentation: "Returns the first k elements of list l" source: ["Returns the first k elements of list l" [sublist l 0 k]]] v #{
10s l
02i 0
10s k
08i 3 v sublist
01
}
0Es list-head
0D
25v list-tail v [l k] v #@[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]]]] v #{
10s l
10s k
10s l
08i 1 v length
08i 3 v sublist
01
}
0Es list-tail
0D
25v list/member v [l m] v #@[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]]]]] v #{
10s l
08i 1 v nil?
0Bo 10
05v #f
09o 48
10s l
11
10s m
20
0Bo 10
10s l
09o 28
05v #t
0Bo 20
10s l
12
10s m
08i 2 v list/member
09o 4
24
01
}
0Es list/member
0D
25v getf v [l key] v #@[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]]]]] v #{
10s l
08i 1 v nil?
0Bo 7
24
09o 50
10s key
10s l
11
20
0Bo 12
10s l
12
11
09o 28
05v #t
0Bo 20
10s l
12
10s key
08i 2 v getf
09o 4
24
01
}
0Es getf
0D
25v list/sort/bubble v [l] v #@[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]]]]]] v #{
10s l
0Bo 125
10s l
11
0Es top
0D
24
0Es next
0D
10s l
12
0Fs l
0D
02i 0
1B
1C
10s l
0Bo 70
0D
10s l
11
10s top
1F
0Bo 29
10s top
10s next
14
0Fs next
0D
10s l
11
0Fs top
09o 17
10s l
11
10s next
14
0Fs next
0D
10s l
12
0Fs l
09o -72
0D
10s top
10s next
08i 1 v list/sort/bubble
14
09o 4
24
01
}
0Es list/sort/bubble
0D
25v list/merge-sorted-lists v [l1 l2] v #@[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]]]]]]]] v #{
10s l1
08i 1 v nil?
0Bo 10
10s l2
09o 90
10s l2
08i 1 v nil?
0Bo 10
10s l1
09o 71
05v #t
0Bo 63
10s l1
11
10s l2
11
1E
0Bo 26
10s l1
11
10s l1
12
10s l2
08i 2 v list/merge-sorted-lists
14
09o 23
10s l2
11
10s l1
10s l2
12
08i 2 v list/merge-sorted-lists
14
09o 4
24
01
}
0Es list/merge-sorted-lists
0D
25v list/split-half-rec v [l acc1 acc2] v #@[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]]]]]] v #{
10s l
08i 1 v nil?
0Bo 15
10s acc1
10s acc2
14
09o 77
10s l
12
08i 1 v nil?
0Bo 21
10s l
11
10s acc1
14
10s acc2
14
09o 46
05v #t
0Bo 38
10s l
12
12
10s l
11
10s acc1
14
10s l
12
11
10s acc2
14
08i 3 v list/split-half-rec
09o 4
24
01
}
0Es list/split-half-rec
0D
25v list/split-half v [l] v #@[source: [[list/split-half-rec l #nil #nil]]] v #{
10s l
24
24
08i 3 v list/split-half-rec
01
}
0Es list/split-half
0D
25v list/sort/merge v [l] v #@[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]]]]]]] v #{
10s l
12
08i 1 v nil?
0Bo 10
10s l
09o 42
10s l
08i 1 v list/split-half
0Es parts
0D
10s parts
11
08i 1 v list/sort/merge
10s parts
12
08i 1 v list/sort/merge
08i 2 v list/merge-sorted-lists
01
}
0Es list/sort/merge
0D
10s list/sort/merge
0Es list/sort
0D
25v list/equal? v [a b] v #@[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]]]] v #{
10s a
08i 1 v pair?
0Bo 41
10s a
11
10s b
11
08i 2 v list/equal?
0C
0Bo 19
0D
10s a
12
10s b
12
08i 2 v list/equal?
09o 16
10s a
10s b
08i 2 v equal?
01
}
0Es list/equal?
0D
25v list/take v [l count] v #@[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]]]]]] v #{
10s count
02i 0
1F
0Bo 7
24
09o 30
10s l
11
10s l
12
10s count
02i 1
08i 2 v -
08i 2 v list/take
14
01
}
0Es list/take
0D
25v list/drop v [l count] v #@[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]]]]] v #{
10s count
02i 0
1F
0Bo 10
10s l
09o 24
10s l
12
10s count
02i 1
08i 2 v -
08i 2 v list/drop
01
}
0Es list/drop
0D
25v list/cut v [l start end] v #@[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]]]]] v #{
10s l
02i 0
10s start
08i 2 v max
08i 2 v list/drop
10s end
02i 0
10s start
08i 2 v max
08i 2 v -
08i 2 v list/take
01
}
0Es list/cut
0D
25v list/replace v [l search-for replace-with] v #@[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]]]]]] v #{
10s l
0Bo 10
05v #f
09o 7
05v #t
0Bo 7
24
09o 138
10s l
10s search-for
08i 2 v equal?
0Bo 10
10s replace-with
09o 115
10s l
11
10s search-for
08i 2 v equal?
0Bo 29
10s replace-with
10s l
12
10s search-for
10s replace-with
08i 3 v list/replace
14
09o 72
05v #t
0Bo 64
10s l
11
08i 1 v pair?
0Bo 24
10s l
11
10s search-for
10s replace-with
08i 3 v list/replace
09o 8
10s l
11
10s l
12
10s search-for
10s replace-with
08i 3 v list/replace
14
09o 4
24
01
}
0Es list/replace
01
}#{
25v tree/zip v [keys values] v #@[documentation: "Return a tree where KEYS point to VALUES" source: ["Return a tree where KEYS point to VALUES" [def ret [tree/new #nil]] [for-in [key keys] [tree/set! ret key [car values]] [cdr! values]] ret]] v #{
24
08i 1 v tree/new
0Es ret
0D
15
10s keys
0Es ΓεnΣym-66
0D
10s ΓεnΣym-66
0Bo 69
02i 0
1B
1C
10s ΓεnΣym-66
0Bo 55
0D
10s ΓεnΣym-66
11
0Es key
0D
10s ret
10s key
10s values
11
08i 3 v tree/set!
0D
10s values
12
0Fs values
0D
10s ΓεnΣym-66
12
0Fs ΓεnΣym-66
09o -57
09o 4
24
16
0D
10s ret
01
}
0Es tree/zip
0D
25v tree/+= v [t k v] 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]]]]]] v #{
10s t
10s k
10s v
10s t
10s k
08i 2 v tree/ref
0C
0Ao 15
0D
02i 0
0C
0Ao 8
0D
05v #f
08i 1 v int
08i 2 v +
08i 3 v tree/set!
01
}
0Es tree/+=
0D
26v tree/-= v [t k v] 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]]]]]] v #{
23s tree/+=
10s t
10s k
23s -
10s v
24
14
14
24
14
14
14
14
01
}
0Es tree/-=
0D
26v tree/++ v [t k] v #@[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]]]] v #{
23s tree/+=
10s t
10s k
02i 1
24
14
14
14
14
01
}
0Es tree/++
0D
26v tree/-- v [t k] v #@[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]]]] v #{
23s tree/-=
10s t
10s k
02i 1
24
14
14
14
14
01
}
0Es tree/--
0D
25v tree/equal? v [a b] v #@[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]]]] v #{
10s a
08i 1 v tree?
0C
0Bo 13
0D
10s b
08i 1 v tree?
0Bo 109
10s a
08i 1 v tree/key*
10s b
08i 1 v tree/key*
20
0C
0Bo 83
0D
10s a
08i 1 v tree/value*
10s b
08i 1 v tree/value*
08i 2 v equal?
0C
0Bo 55
0D
10s a
08i 1 v tree/left*
10s b
08i 1 v tree/left*
08i 2 v tree/equal?
0C
0Bo 27
0D
10s a
08i 1 v tree/right*
10s b
08i 1 v tree/right*
08i 2 v tree/equal?
09o 16
10s a
10s b
08i 2 v equal?
01
}
0Es tree/equal?
0D
25v tree/reduce v [l o s] v #@[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]]] v #{
10s l
08i 1 v tree/values
10s o
10s s
08i 3 v list/reduce
01
}
0Es tree/reduce
0D
25v tree/filter v [l f] v #@[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]] [for-in [e [tree/keys l]] [def t [tree/ref l e]] [when [f t] [tree/set! ret e t]]] ret]] v #{
24
08i 1 v tree/new
0Es ret
0D
15
10s l
08i 1 v tree/keys
0Es ΓεnΣym-67
0D
10s ΓεnΣym-67
0Bo 93
02i 0
1B
1C
10s ΓεnΣym-67
0Bo 79
0D
10s ΓεnΣym-67
11
0Es e
0D
10s l
10s e
08i 2 v tree/ref
0Es t
0D
10s f
10s t
1Ai 1
0Bo 23
10s ret
10s e
10s t
08i 3 v tree/set!
09o 4
24
0D
10s ΓεnΣym-67
12
0Fs ΓεnΣym-67
09o -81
09o 4
24
16
0D
10s ret
01
}
0Es tree/filter
01
}#{
25v val->bytecode-op v [v] v #@[source: [[def i [val->index v]] [list [int->bytecode-op [logand [>> i 16] 255]] [int->bytecode-op [logand [>> i 8] 255]] [int->bytecode-op [logand i 255]]]]] v #{
10s v
08i 1 v val->index
0Es i
0D
10s i
02i 16
08i 2 v >>
05v 255
08i 2 v logand
08i 1 v int->bytecode-op
10s i
02i 8
08i 2 v >>
05v 255
08i 2 v logand
08i 1 v int->bytecode-op
10s i
05v 255
08i 2 v logand
08i 1 v int->bytecode-op
08i 3 v list
01
}
0Es val->bytecode-op
0D
25v sym->bytecode-op v [v] v #@[source: [[def i [sym->index v]] [list [int->bytecode-op [logand [>> i 16] 255]] [int->bytecode-op [logand [>> i 8] 255]] [int->bytecode-op [logand i 255]]]]] v #{
10s v
08i 1 v sym->index
0Es i
0D
10s i
02i 16
08i 2 v >>
05v 255
08i 2 v logand
08i 1 v int->bytecode-op
10s i
02i 8
08i 2 v >>
05v 255
08i 2 v logand
08i 1 v int->bytecode-op
10s i
05v 255
08i 2 v logand
08i 1 v int->bytecode-op
08i 3 v list
01
}
0Es sym->bytecode-op
0D
25v int-fit-in-byte? v [a] v #@[source: [[and [<= a 127] [>= a -128]]]] v #{
10s a
02i 127
1F
0C
0Bo 11
0D
10s a
02i -128
21
01
}
0Es int-fit-in-byte?
0D
25v $nop v [] v #@[documentation: "- | Do nothing" source: ["- | Do nothing" '[#$0]]] v #{
05v [#$0]
01
}
0Es $nop
0D
25v $ret v [] v #@[documentation: "a - | Return top of value stack" source: ["a - | Return top of value stack" '[#$1]]] v #{
05v [#$1]
01
}
0Es $ret
0D
25v $push/int/byte v [a] v #@[documentation: "- a | Return top of value stack" source: ["- a | Return top of value stack" [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]]]] v #{
10s a
08i 1 v int-fit-in-byte?
0Bo 7
24
09o 30
05v :invalid-bc-op
05v "$push/int/byte can only push a signed 8-bit value"
10s a
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
05v #$2
10s a
08i 1 v int->bytecode-op
08i 2 v list
01
}
0Es $push/int/byte
0D
25v $push/int v [a] v #@[documentation: "- a | Return top of value stack" source: ["- a | Return top of value stack" [if [int-fit-in-byte? a] [$push/int/byte a] [$push/lval a]]]] v #{
10s a
08i 1 v int-fit-in-byte?
0Bo 15
10s a
08i 1 v $push/int/byte
09o 12
10s a
08i 1 v $push/lval
01
}
0Es $push/int
0D
25v $add/int v [] v #@[documentation: "a b - c | Adds the two topmost values and pushes the result" source: ["a b - c | Adds the two topmost values and pushes the result" '[#$3]]] v #{
05v [#$3]
01
}
0Es $add/int
0D
25v $push/lval v [v] v #@[documentation: "- v | Pushes 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 #$5 [val->bytecode-op v]]]] v #{
10s v
08i 1 v nil?
0Bo 33
05v :invalid-bc-op
05v "Can't push #nil as a normal lVal"
10s v
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
05v #$5
10s v
08i 1 v val->bytecode-op
08i 2 v list
01
}
0Es $push/lval
0D
25v $push/symbol v [v] v #@[documentation: "- v | Pushes v onto the stack" source: ["- v | Pushes v onto the stack" [list #$23 [sym->bytecode-op v]]]] v #{
05v #$23
10s v
08i 1 v sym->bytecode-op
08i 2 v list
01
}
0Es $push/symbol
0D
25v $apply/new v [arg-count fun] v #@[documentation: "arguments ... - result | Read 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]] [otherwise [list #$4 [int->bytecode-op arg-count] [val->bytecode-op fun]]]]] [2 [case fun [add/int [$add/int]] [cons [$cons]] [< [$<]] [<= [$<=]] [== [$==]] [>= [$>=]] [> [$>]] [otherwise [list #$4 [int->bytecode-op arg-count] [val->bytecode-op fun]]]]] [otherwise [list #$4 [int->bytecode-op arg-count] [val->bytecode-op fun]]]]]] v #{
15
10s arg-count
0Es ΓεnΣym-77
0D
10s ΓεnΣym-77
02i 1
20
0Bo 84
15
10s fun
0Es ΓεnΣym-78
0D
10s ΓεnΣym-78
10s car
20
0Bo 11
08i 0 v $car
09o 50
10s ΓεnΣym-78
10s cdr
20
0Bo 11
08i 0 v $cdr
09o 30
05v #$4
10s arg-count
08i 1 v int->bytecode-op
10s fun
08i 1 v val->bytecode-op
08i 3 v list
16
09o 221
10s ΓεnΣym-77
02i 2
20
0Bo 184
15
10s fun
0Es ΓεnΣym-79
0D
10s ΓεnΣym-79
10s add/int
20
0Bo 11
08i 0 v $add/int
09o 150
10s ΓεnΣym-79
10s cons
20
0Bo 11
08i 0 v $cons
09o 130
10s ΓεnΣym-79
10s <
20
0Bo 11
08i 0 v $<
09o 110
10s ΓεnΣym-79
10s <=
20
0Bo 11
08i 0 v $<=
09o 90
10s ΓεnΣym-79
10s ==
20
0Bo 11
08i 0 v $==
09o 70
10s ΓεnΣym-79
10s >=
20
0Bo 11
08i 0 v $>=
09o 50
10s ΓεnΣym-79
10s >
20
0Bo 11
08i 0 v $>
09o 30
05v #$4
10s arg-count
08i 1 v int->bytecode-op
10s fun
08i 1 v val->bytecode-op
08i 3 v list
16
09o 30
05v #$4
10s arg-count
08i 1 v int->bytecode-op
10s fun
08i 1 v val->bytecode-op
08i 3 v list
16
01
}
0Es $apply/new
0D
25v $apply v [arg-count fun] v #@[documentation: "arguments ... - result | Read 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]] [otherwise [list #$8 [int->bytecode-op arg-count] [val->bytecode-op fun]]]]] [2 [case fun [add/int [$add/int]] [cons [$cons]] [< [$<]] [<= [$<=]] [== [$==]] [>= [$>=]] [> [$>]] [otherwise [list #$8 [int->bytecode-op arg-count] [val->bytecode-op fun]]]]] [otherwise [list #$8 [int->bytecode-op arg-count] [val->bytecode-op fun]]]]]] v #{
15
10s arg-count
0Es ΓεnΣym-80
0D
10s ΓεnΣym-80
02i 1
20
0Bo 84
15
10s fun
0Es ΓεnΣym-81
0D
10s ΓεnΣym-81
10s car
20
0Bo 11
08i 0 v $car
09o 50
10s ΓεnΣym-81
10s cdr
20
0Bo 11
08i 0 v $cdr
09o 30
05v #$8
10s arg-count
08i 1 v int->bytecode-op
10s fun
08i 1 v val->bytecode-op
08i 3 v list
16
09o 221
10s ΓεnΣym-80
02i 2
20
0Bo 184
15
10s fun
0Es ΓεnΣym-82
0D
10s ΓεnΣym-82
10s add/int
20
0Bo 11
08i 0 v $add/int
09o 150
10s ΓεnΣym-82
10s cons
20
0Bo 11
08i 0 v $cons
09o 130
10s ΓεnΣym-82
10s <
20
0Bo 11
08i 0 v $<
09o 110
10s ΓεnΣym-82
10s <=
20
0Bo 11
08i 0 v $<=
09o 90
10s ΓεnΣym-82
10s ==
20
0Bo 11
08i 0 v $==
09o 70
10s ΓεnΣym-82
10s >=
20
0Bo 11
08i 0 v $>=
09o 50
10s ΓεnΣym-82
10s >
20
0Bo 11
08i 0 v $>
09o 30
05v #$8
10s arg-count
08i 1 v int->bytecode-op
10s fun
08i 1 v val->bytecode-op
08i 3 v list
16
09o 30
05v #$8
10s arg-count
08i 1 v int->bytecode-op
10s fun
08i 1 v val->bytecode-op
08i 3 v list
16
01
}
0Es $apply
0D
25v $apply/dynamic v [arg-count fun] v #@[source: [[list #$1A [int->bytecode-op arg-count]]]] v #{
05v #$1A
10s arg-count
08i 1 v int->bytecode-op
08i 2 v list
01
}
0Es $apply/dynamic
0D
25v $apply/dynamic/new v [arg-count fun] v #@[source: [[list #$7 [int->bytecode-op arg-count]]]] v #{
05v #$7
10s arg-count
08i 1 v int->bytecode-op
08i 2 v list
01
}
0Es $apply/dynamic/new
0D
25v $try/old v [target] v #@[documentation: "- | Try something, jumping to target if an exception occurs" source: [" - | Try something, jumping to target if an exception occurs" [list #$18 [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] v #{
05v #$18
05v :relocate
10s target
02i 8
02i 0
02i 0
08i 1 v int->bytecode-op
08i 5 v list
05v :relocate
10s target
02i 0
02i 1
02i 0
08i 1 v int->bytecode-op
08i 5 v list
08i 3 v list
01
}
0Es $try/old
0D
25v $try v [target] v #@[documentation: "- | Try 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]]]]] v #{
05v #$19
05v :relocate
10s target
02i 8
02i 0
02i 0
08i 1 v int->bytecode-op
08i 5 v list
05v :relocate
10s target
02i 0
02i 1
02i 0
08i 1 v int->bytecode-op
08i 5 v list
08i 3 v list
01
}
0Es $try
0D
25v $jmp v [target] v #@[source: [[list #$9 [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] v #{
05v #$9
05v :relocate
10s target
02i 8
02i 0
02i 0
08i 1 v int->bytecode-op
08i 5 v list
05v :relocate
10s target
02i 0
02i 1
02i 0
08i 1 v int->bytecode-op
08i 5 v list
08i 3 v list
01
}
0Es $jmp
0D
25v $jt v [target] v #@[source: [[list #$A [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] v #{
05v #$A
05v :relocate
10s target
02i 8
02i 0
02i 0
08i 1 v int->bytecode-op
08i 5 v list
05v :relocate
10s target
02i 0
02i 1
02i 0
08i 1 v int->bytecode-op
08i 5 v list
08i 3 v list
01
}
0Es $jt
0D
25v $jf v [target] v #@[source: [[list #$B [list :relocate target 8 0 [int->bytecode-op 0]] [list :relocate target 0 1 [int->bytecode-op 0]]]]] v #{
05v #$B
05v :relocate
10s target
02i 8
02i 0
02i 0
08i 1 v int->bytecode-op
08i 5 v list
05v :relocate
10s target
02i 0
02i 1
02i 0
08i 1 v int->bytecode-op
08i 5 v list
08i 3 v list
01
}
0Es $jf
0D
25v $dup v [] v #@[source: ['[#$C]]] v #{
05v [#$C]
01
}
0Es $dup
0D
25v $drop v [] v #@[source: ['[#$D]]] v #{
05v [#$D]
01
}
0Es $drop
0D
25v $def v [v] v #@[source: [[list #$E [sym->bytecode-op v]]]] v #{
05v #$E
10s v
08i 1 v sym->bytecode-op
08i 2 v list
01
}
0Es $def
0D
25v $set v [v] v #@[source: [[list #$F [sym->bytecode-op v]]]] v #{
05v #$F
10s v
08i 1 v sym->bytecode-op
08i 2 v list
01
}
0Es $set
0D
25v $get v [v] v #@[source: [[list #$10 [sym->bytecode-op v]]]] v #{
05v #$10
10s v
08i 1 v sym->bytecode-op
08i 2 v list
01
}
0Es $get
0D
25v $fn v [name args docs body] v #@[source: [[list #$25 [val->bytecode-op name] [val->bytecode-op args] [val->bytecode-op docs] [val->bytecode-op body]]]] v #{
05v #$25
10s name
08i 1 v val->bytecode-op
10s args
08i 1 v val->bytecode-op
10s docs
08i 1 v val->bytecode-op
10s body
08i 1 v val->bytecode-op
08i 5 v list
01
}
0Es $fn
0D
25v $macro* v [name args docs body] v #@[source: [[list #$26 [val->bytecode-op name] [val->bytecode-op args] [val->bytecode-op docs] [val->bytecode-op body]]]] v #{
05v #$26
10s name
08i 1 v val->bytecode-op
10s args
08i 1 v val->bytecode-op
10s docs
08i 1 v val->bytecode-op
10s body
08i 1 v val->bytecode-op
08i 5 v list
01
}
0Es $macro*
0D
25v $closure/push v [] v #@[source: ['[#$13]]] v #{
05v [#$13]
01
}
0Es $closure/push
0D
25v $let v [] v #@[source: ['[#$15]]] v #{
05v [#$15]
01
}
0Es $let
0D
25v $closure/pop v [] v #@[source: ['[#$16]]] v #{
05v [#$16]
01
}
0Es $closure/pop
0D
25v $roots/save v [] v #@[source: ['[#$1B]]] v #{
05v [#$1B]
01
}
0Es $roots/save
0D
25v $roots/restore v [] v #@[source: ['[#$1C]]] v #{
05v [#$1C]
01
}
0Es $roots/restore
0D
25v $< v [] v #@[source: ['[#$1E]]] v #{
05v [#$1E]
01
}
0Es $<
0D
25v $<= v [] v #@[source: ['[#$1F]]] v #{
05v [#$1F]
01
}
0Es $<=
0D
25v $== v [] v #@[source: ['[#$20]]] v #{
05v [#$20]
01
}
0Es $==
0D
25v $>= v [] v #@[source: ['[#$21]]] v #{
05v [#$21]
01
}
0Es $>=
0D
25v $> v [] v #@[source: ['[#$22]]] v #{
05v [#$22]
01
}
0Es $>
0D
25v $push/nil v [] v #@[source: ['[#$24]]] v #{
05v [#$24]
01
}
0Es $push/nil
0D
25v $car v [] v #@[source: ['[#$11]]] v #{
05v [#$11]
01
}
0Es $car
0D
25v $cdr v [] v #@[source: ['[#$12]]] v #{
05v [#$12]
01
}
0Es $cdr
0D
25v $cons v [] v #@[source: ['[#$14]]] v #{
05v [#$14]
01
}
0Es $cons
0D
25v assemble/build-sym-map v [code sym-map pos] v #@[source: [[while code [case [type-of [car code]] [:bytecode-op [tree/set! sym-map :last-op [++ pos]]] [[:symbol :keyword] [and [== [car code] :label] [tree/set! sym-map [cadr code] pos]]] [:pair [set! pos [assemble/build-sym-map [car code] sym-map pos]]]] [cdr! code]] pos]] v #{
02i 0
1B
1C
10s code
0Bo 187
0D
15
10s code
11
08i 1 v type-of
0Es ΓεnΣym-83
0D
10s ΓεnΣym-83
05v :bytecode-op
20
0Bo 34
10s sym-map
05v :last-op
02i 1
10s pos
08i 2 v +
0Fs pos
08i 3 v tree/set!
09o 113
10s ΓεnΣym-83
05v :symbol
20
0C
0Ao 22
0D
10s ΓεnΣym-83
05v :keyword
20
0C
0Ao 8
0D
05v #f
0Bo 40
10s code
11
05v :label
20
0C
0Bo 23
0D
10s sym-map
10s code
12
11
10s pos
08i 3 v tree/set!
09o 41
10s ΓεnΣym-83
05v :pair
20
0Bo 28
10s code
11
10s sym-map
10s pos
08i 3 v assemble/build-sym-map
0Fs pos
09o 4
24
16
0D
10s code
12
0Fs code
09o -189
0D
10s pos
01
}
0Es assemble/build-sym-map
0D
25v assemble/relocate-op v [code sym-map pos out] v #@[source: [[def target [tree/ref sym-map [cadr code]]] [def off [- [+ target [cadddr code]] pos]] [array/set! out [++ pos] [int->bytecode-op [logand [>> off [caddr code]] 255]]] pos]] v #{
10s sym-map
10s code
12
11
08i 2 v tree/ref
0Es target
0D
10s target
10s code
08i 1 v cadddr
08i 2 v +
10s pos
08i 2 v -
0Es off
0D
10s out
02i 1
10s pos
08i 2 v +
0Fs pos
10s off
10s code
08i 1 v caddr
08i 2 v >>
05v 255
08i 2 v logand
08i 1 v int->bytecode-op
08i 3 v array/set!
0D
10s pos
01
}
0Es assemble/relocate-op
0D
25v assemble/emit-relocated-ops v [code sym-map pos out] v #@[source: [[if [== [car code] :relocate] [set! pos [assemble/relocate-op code sym-map pos out]] [for-in [op code] [case [type-of op] [:bytecode-op [array/set! out [++ pos] op]] [:pair [set! pos [assemble/emit-relocated-ops op sym-map pos out]]]]]] pos]] v #{
10s code
11
05v :relocate
20
0Bo 31
10s code
10s sym-map
10s pos
10s out
08i 4 v assemble/relocate-op
0Fs pos
09o 160
15
10s code
0Es ΓεnΣym-84
0D
10s ΓεnΣym-84
0Bo 141
02i 0
1B
1C
10s ΓεnΣym-84
0Bo 127
0D
10s ΓεnΣym-84
11
0Es op
0D
15
10s op
08i 1 v type-of
0Es ΓεnΣym-85
0D
10s ΓεnΣym-85
05v :bytecode-op
20
0Bo 34
10s out
02i 1
10s pos
08i 2 v +
0Fs pos
10s op
08i 3 v array/set!
09o 44
10s ΓεnΣym-85
05v :pair
20
0Bo 31
10s op
10s sym-map
10s pos
10s out
08i 4 v assemble/emit-relocated-ops
0Fs pos
09o 4
24
16
0D
10s ΓεnΣym-84
12
0Fs ΓεnΣym-84
09o -129
09o 4
24
16
0D
10s pos
01
}
0Es assemble/emit-relocated-ops
0D
05v #f
0Es assemble/verbose
0D
25v assemble* v [code] v #@[documentation: "Assemble all arguments into a single :bytecode-array" source: ["Assemble all arguments into a single :bytecode-array" [def sym-map [tree/new #nil]] [and assemble/verbose [println [cat [ansi-blue "Input:\n" [str/write code]]]]] [assemble/build-sym-map code sym-map 0] [and assemble/verbose [println [cat [ansi-yellow "Symbol Map:\n" [str/write sym-map]]]]] [def out [array/allocate [tree/ref sym-map :last-op]]] [assemble/emit-relocated-ops code sym-map -1 out] [and assemble/verbose [println [cat [ansi-green "Output:\n" [str/write out]]]]] [arr->bytecode-arr out]]] v #{
24
08i 1 v tree/new
0Es sym-map
0D
10s assemble/verbose
0C
0Bo 32
0D
05v "Input:\n"
10s code
08i 1 v str/write
08i 2 v ansi-blue
08i 1 v cat
08i 1 v println
0D
10s code
10s sym-map
02i 0
08i 3 v assemble/build-sym-map
0D
10s assemble/verbose
0C
0Bo 32
0D
05v "Symbol Map:\n"
10s sym-map
08i 1 v str/write
08i 2 v ansi-yellow
08i 1 v cat
08i 1 v println
0D
10s sym-map
05v :last-op
08i 2 v tree/ref
08i 1 v array/allocate
0Es out
0D
10s code
10s sym-map
02i -1
10s out
08i 4 v assemble/emit-relocated-ops
0D
10s assemble/verbose
0C
0Bo 32
0D
05v "Output:\n"
10s out
08i 1 v str/write
08i 2 v ansi-green
08i 1 v cat
08i 1 v println
0D
10s out
08i 1 v arr->bytecode-arr
01
}
0Es assemble*
0D
25v assemble v l v #@[documentation: "Assemble all arguments into a single :bytecode-array" source: ["Assemble all arguments into a single :bytecode-array" [assemble* l]]] v #{
10s l
08i 1 v assemble*
01
}
0Es assemble
0D
26v asmrun v ops v #@[documentation: "Assemble and evaluate all bytecode arguments" source: ["Assemble and evaluate all bytecode arguments" [quasiquote [bytecode-eval [assemble [unquote-splicing ops]]]]]] v #{
23s bytecode-eval
23s assemble
10s ops
24
08i 2 v append
14
24
14
14
01
}
0Es asmrun
0D
26v asmdebug v ops v #@[documentation: "Assemble and evaluate all bytecode arguments" source: ["Assemble and evaluate all bytecode arguments" [quasiquote [bytecode-eval [assemble [unquote-splicing ops]] [environment*] #t]]]] v #{
23s bytecode-eval
23s assemble
10s ops
24
08i 2 v append
14
23s environment*
24
14
05v #t
24
14
14
14
14
01
}
0Es asmdebug
01
}#{
05v #f
0Es *bytecompile-apply-new*
0D
02i 0
0Es bytecompile/gen-label/counter
0D
25v bytecompile/gen-label v [prefix] v #@[source: [[++ bytecompile/gen-label/counter] [str->sym [cat prefix "label-" bytecompile/gen-label/counter]]]] v #{
02i 1
10s bytecompile/gen-label/counter
08i 2 v +
0Fs bytecompile/gen-label/counter
0D
10s prefix
05v "label-"
10s bytecompile/gen-label/counter
08i 3 v cat
08i 1 v str->sym
01
}
0Es bytecompile/gen-label
0D
25v bytecompile/literal v [source] v #@[source: [[case [type-of source] [[:symbol :keyword] [if [keyword? source] [$push/lval source] [$get source]]] [:int [$push/int source]] [:nil [$push/nil]] [otherwise [$push/lval source]]]]] v #{
15
10s source
08i 1 v type-of
0Es ΓεnΣym-91
0D
10s ΓεnΣym-91
05v :symbol
20
0C
0Ao 22
0D
10s ΓεnΣym-91
05v :keyword
20
0C
0Ao 8
0D
05v #f
0Bo 39
10s source
08i 1 v keyword?
0Bo 15
10s source
08i 1 v $push/lval
09o 12
10s source
08i 1 v $get
09o 56
10s ΓεnΣym-91
05v :int
20
0Bo 15
10s source
08i 1 v $push/int
09o 32
10s ΓεnΣym-91
05v :nil
20
0Bo 11
08i 0 v $push/nil
09o 12
10s source
08i 1 v $push/lval
16
01
}
0Es bytecompile/literal
0D
25v bytecompile/quote v [source] v #@[source: [[case [type-of source] [:int [$push/int source]] [:symbol [$push/symbol source]] [otherwise [$push/lval source]]]]] v #{
15
10s source
08i 1 v type-of
0Es ΓεnΣym-92
0D
10s ΓεnΣym-92
05v :int
20
0Bo 15
10s source
08i 1 v $push/int
09o 36
10s ΓεnΣym-92
05v :symbol
20
0Bo 15
10s source
08i 1 v $push/symbol
09o 12
10s source
08i 1 v $push/lval
16
01
}
0Es bytecompile/quote
0D
25v bytecompile/do/form v [source env] v #@[source: [[when source [cons [cons [bytecompile* [car source] env] [if [last? source] #nil [cons [$drop] #nil]]] [bytecompile/do/form [cdr source] env]]]]] v #{
10s source
0Bo 60
10s source
11
10s env
08i 2 v bytecompile*
10s source
12
08i 1 v nil?
0Bo 7
24
09o 10
08i 0 v $drop
24
14
14
10s source
12
10s env
08i 2 v bytecompile/do/form
14
09o 4
24
01
}
0Es bytecompile/do/form
0D
25v bytecompile/do v [source env] v #@[source: [[list [bytecompile/do/form [cdr source] env]]]] v #{
10s source
12
10s env
08i 2 v bytecompile/do/form
08i 1 v list
01
}
0Es bytecompile/do
0D
25v bytecompile/procedure v [op source env] v #@[source: [[def args [map [cdr source] bytecompile*]] [list args [if *bytecompile-apply-new* [$apply/new [length args] op] [$apply [length args] op]]]]] v #{
10s source
12
10s bytecompile*
08i 2 v map
0Es args
0D
10s args
10s *bytecompile-apply-new*
0Bo 24
10s args
08i 1 v length
10s op
08i 2 v $apply/new
09o 21
10s args
08i 1 v length
10s op
08i 2 v $apply
08i 2 v list
01
}
0Es bytecompile/procedure
0D
25v bytecompile/def v [source env] v #@[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 [cadr source]]]]] v #{
10s source
12
11
08i 1 v symbol?
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 33
0D
10s source
12
12
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 8
0D
05v #f
0Bo 29
05v :type-error
05v "[def] needs a symbol name and a value as arguments"
24
10s env
08i 4 v list
08i 1 v throw
09o 4
24
0D
10s source
08i 1 v caddr
10s env
08i 2 v bytecompile*
10s source
12
11
08i 1 v $def
08i 2 v list
01
}
0Es bytecompile/def
0D
25v bytecompile/set! v [source env] v #@[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 [cadr source]]]]] v #{
10s source
12
11
08i 1 v symbol?
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 33
0D
10s source
12
12
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 8
0D
05v #f
0Bo 29
05v :type-error
05v "[set!] needs a symbol name and a value as arguments"
24
10s env
08i 4 v list
08i 1 v throw
09o 4
24
0D
10s source
08i 1 v caddr
10s env
08i 2 v bytecompile*
10s source
12
11
08i 1 v $set
08i 2 v list
01
}
0Es bytecompile/set!
0D
25v bytecompile/if v [source env] v #@[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]]]]] v #{
15
08i 0 v bytecompile/gen-label
0Es sym-else
0D
08i 0 v bytecompile/gen-label
0Es sym-after
0D
10s source
12
11
10s env
08i 2 v bytecompile*
10s sym-else
08i 1 v $jf
10s source
08i 1 v caddr
10s env
08i 2 v bytecompile*
10s sym-after
08i 1 v $jmp
05v :label
10s sym-else
08i 2 v list
10s source
08i 1 v cadddr
10s env
08i 2 v bytecompile*
05v :label
10s sym-after
08i 2 v list
08i 7 v list
16
01
}
0Es bytecompile/if
0D
25v bytecompile/while v [source env] v #@[source: [[def sym-start [bytecompile/gen-label]] [def sym-end [bytecompile/gen-label]] [list [$push/int 0] [$roots/save] [list :label sym-start] [$roots/restore] [bytecompile* [cadr source] env] [$jf sym-end] [$drop] [bytecompile/do/form [cddr source] env] [$jmp sym-start] [list :label sym-end]]]] v #{
08i 0 v bytecompile/gen-label
0Es sym-start
0D
08i 0 v bytecompile/gen-label
0Es sym-end
0D
02i 0
08i 1 v $push/int
08i 0 v $roots/save
05v :label
10s sym-start
08i 2 v list
08i 0 v $roots/restore
10s source
12
11
10s env
08i 2 v bytecompile*
10s sym-end
08i 1 v $jf
08i 0 v $drop
10s source
12
12
10s env
08i 2 v bytecompile/do/form
10s sym-start
08i 1 v $jmp
05v :label
10s sym-end
08i 2 v list
08i 10 v list
01
}
0Es bytecompile/while
0D
25v bytecompile/procedure/arg v [source env] v #@[source: [[if [last? source] [bytecompile* [car source] env] [cons [bytecompile* [car source] env] [bytecompile/procedure/arg [cdr source] env]]]]] v #{
10s source
12
08i 1 v nil?
0Bo 20
10s source
11
10s env
08i 2 v bytecompile*
09o 32
10s source
11
10s env
08i 2 v bytecompile*
10s source
12
10s env
08i 2 v bytecompile/procedure/arg
14
01
}
0Es bytecompile/procedure/arg
0D
25v bytecompile/procedure/default v [op args env] v #@[source: [[def arg-count [length args]] [if args [list [bytecompile/procedure/arg args] [if *bytecompile-apply-new* [$apply/new arg-count op] [$apply arg-count op]]] [if *bytecompile-apply-new* [$apply/new 0 op] [$apply 0 op]]]]] v #{
10s args
08i 1 v length
0Es arg-count
0D
10s args
0Bo 56
10s args
08i 1 v bytecompile/procedure/arg
10s *bytecompile-apply-new*
0Bo 19
10s arg-count
10s op
08i 2 v $apply/new
09o 16
10s arg-count
10s op
08i 2 v $apply
08i 2 v list
09o 35
10s *bytecompile-apply-new*
0Bo 17
02i 0
10s op
08i 2 v $apply/new
09o 14
02i 0
10s op
08i 2 v $apply
01
}
0Es bytecompile/procedure/default
0D
25v bytecompile/procedure/inline? v [op] v #@[source: [[case [type-of op] [:lambda [closure/meta op :inline]] [#t #f]]]] v #{
15
10s op
08i 1 v type-of
0Es ΓεnΣym-93
0D
10s ΓεnΣym-93
05v :lambda
20
0Bo 19
10s op
05v :inline
08i 2 v closure/meta
09o 23
10s ΓεnΣym-93
05v #t
20
0Bo 10
05v #f
09o 4
24
16
01
}
0Es bytecompile/procedure/inline?
0D
25v bytecompile/procedure/inline v [op args env] v #@[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 [closure/meta op :source] env]] [def arg-name [car [tree/ref [closure op] :arguments]]] [if args [bytecompile* [list/replace form arg-name [car args]] env] [bytecompile* form env]]]] v #{
10s args
08i 1 v length
0Es arg-count
0D
10s arg-count
02i 1
22
0Bo 33
05v :compiler-error
05v "For now only monadic functions can be inlined"
10s op
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
10s op
05v :source
08i 2 v closure/meta
10s env
08i 2 v macroexpand/do
0Es form
0D
10s op
08i 1 v closure
05v :arguments
08i 2 v tree/ref
11
0Es arg-name
0D
10s args
0Bo 33
10s form
10s arg-name
10s args
11
08i 3 v list/replace
10s env
08i 2 v bytecompile*
09o 16
10s form
10s env
08i 2 v bytecompile*
01
}
0Es bytecompile/procedure/inline
0D
25v bytecompile/procedure v [op args env] v #@[source: [[if [bytecompile/procedure/inline? op] [bytecompile/procedure/inline op args env] [bytecompile/procedure/default op args env]]]] v #{
10s op
08i 1 v bytecompile/procedure/inline?
0Bo 23
10s op
10s args
10s env
08i 3 v bytecompile/procedure/inline
09o 20
10s op
10s args
10s env
08i 3 v bytecompile/procedure/default
01
}
0Es bytecompile/procedure
0D
25v bytecompile/procedure/dynamic v [op args env] v #@[source: [[def arg-count [length args]] [list [bytecompile* op env] [when args [bytecompile/procedure/arg args]] [if *bytecompile-apply-new* [$apply/dynamic/new arg-count] [$apply/dynamic arg-count]]]]] v #{
10s args
08i 1 v length
0Es arg-count
0D
10s op
10s env
08i 2 v bytecompile*
10s args
0Bo 15
10s args
08i 1 v bytecompile/procedure/arg
09o 4
24
10s *bytecompile-apply-new*
0Bo 16
10s $apply/dynamic/new
10s arg-count
1Ai 1
09o 12
10s arg-count
08i 1 v $apply/dynamic
08i 3 v list
01
}
0Es bytecompile/procedure/dynamic
0D
25v bytecompile/and/rec v [source env label-end] v #@[source: [[list [bytecompile* [car source] env] [when [cdr source] [list [$dup] [$jf label-end] [$drop] [bytecompile/and/rec [cdr source] env label-end]]]]]] v #{
10s source
11
10s env
08i 2 v bytecompile*
10s source
12
0Bo 48
08i 0 v $dup
10s label-end
08i 1 v $jf
08i 0 v $drop
10s source
12
10s env
10s label-end
08i 3 v bytecompile/and/rec
08i 4 v list
09o 4
24
08i 2 v list
01
}
0Es bytecompile/and/rec
0D
25v bytecompile/and v [source env] v #@[source: [[def label-end [bytecompile/gen-label]] [list [bytecompile/and/rec [cdr source] env label-end] [list :label label-end]]]] v #{
08i 0 v bytecompile/gen-label
0Es label-end
0D
10s source
12
10s env
10s label-end
08i 3 v bytecompile/and/rec
05v :label
10s label-end
08i 2 v list
08i 2 v list
01
}
0Es bytecompile/and
0D
25v bytecompile/or/rec v [source env label-end] v #@[source: [[when source [list [bytecompile* [car source] env] [$dup] [$jt label-end] [$drop] [bytecompile/or/rec [cdr source] env label-end]]]]] v #{
10s source
0Bo 62
10s source
11
10s env
08i 2 v bytecompile*
08i 0 v $dup
10s label-end
08i 1 v $jt
08i 0 v $drop
10s source
12
10s env
10s label-end
08i 3 v bytecompile/or/rec
08i 5 v list
09o 4
24
01
}
0Es bytecompile/or/rec
0D
25v bytecompile/or v [source env] v #@[source: [[def label-end [bytecompile/gen-label]] [list [bytecompile/or/rec [cdr source] env label-end] [$push/lval #f] [list :label label-end]]]] v #{
08i 0 v bytecompile/gen-label
0Es label-end
0D
10s source
12
10s env
10s label-end
08i 3 v bytecompile/or/rec
05v #f
08i 1 v $push/lval
05v :label
10s label-end
08i 2 v list
08i 3 v list
01
}
0Es bytecompile/or
0D
25v bytecompile/string v [source env] v #@[source: [[bytecompile/procedure cat source env]]] v #{
10s cat
10s source
10s env
08i 3 v bytecompile/procedure
01
}
0Es bytecompile/string
0D
25v bytecompile/array v [source env] v #@[source: [[bytecompile/procedure array/ref source env]]] v #{
10s array/ref
10s source
10s env
08i 3 v bytecompile/procedure
01
}
0Es bytecompile/array
0D
25v bytecompile/tree v [source env] v #@[source: [[bytecompile/procedure tree/ref source env]]] v #{
10s tree/ref
10s source
10s env
08i 3 v bytecompile/procedure
01
}
0Es bytecompile/tree
0D
25v bytecompile/fn* v [source env] v #@[source: [[apply $fn [cdr source]]]] v #{
10s $fn
10s source
12
08i 2 v apply
01
}
0Es bytecompile/fn*
0D
25v bytecompile/macro* v [source env] v #@[source: [[apply $macro* [cdr source]]]] v #{
10s $macro*
10s source
12
08i 2 v apply
01
}
0Es bytecompile/macro*
0D
25v bytecompile/ω* v [source env] v #@[source: [[list [$let] [bytecompile/do/form [cdr source] env] [$drop] [$closure/push] [$closure/pop]]]] v #{
08i 0 v $let
10s source
12
10s env
08i 2 v bytecompile/do/form
08i 0 v $drop
08i 0 v $closure/push
08i 0 v $closure/pop
08i 5 v list
01
}
0Es bytecompile/ω*
0D
25v bytecompile/let* v [source env] v #@[source: [[list [$let] [bytecompile/do [cadr source] env] [$closure/pop]]]] v #{
08i 0 v $let
10s source
12
11
10s env
08i 2 v bytecompile/do
08i 0 v $closure/pop
08i 3 v list
01
}
0Es bytecompile/let*
0D
25v bytecompile/return v [source env] v #@[source: [[list [bytecompile* [cadr source] env] [$ret]]]] v #{
10s source
12
11
10s env
08i 2 v bytecompile*
08i 0 v $ret
08i 2 v list
01
}
0Es bytecompile/return
0D
25v bytecompile/try v [source env] v #@[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]]]] v #{
08i 0 v bytecompile/gen-label
0Es end-sym
0D
10s source
12
11
10s env
08i 2 v bytecompile*
10s end-sym
08i 1 v $try
10s source
12
12
10s env
08i 2 v bytecompile/do/form
08i 0 v $closure/pop
05v :label
10s end-sym
08i 2 v list
08i 5 v list
01
}
0Es bytecompile/try
0D
25v bytecompile* v [source env] v #@[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] [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]] [ω* [bytecompile/ω* source env]] [try [bytecompile/try source env]] [return [bytecompile/return source env]] '[bytecompile/quote [cadr source]] [otherwise [bytecompile/procedure op [cdr source] env]]]] [[:pair :symbol] [bytecompile/procedure/dynamic op [cdr source] env]] [:string [bytecompile/string source env]] [:array [bytecompile/array source env]] [:tree [bytecompile/tree source env]] [otherwise [bytecompile/literal source]]]]] v #{
10s source
11
10s env
08i 2 v resolves?
0Bo 20
10s source
11
10s env
08i 2 v resolve
09o 8
10s source
11
0Es op
0D
15
10s op
08i 1 v type-of
0Es ΓεnΣym-94
0D
10s ΓεnΣym-94
05v :lambda
20
0C
0Ao 22
0D
10s ΓεnΣym-94
05v :native-function
20
0C
0Ao 8
0D
05v #f
0Bo 425
15
10s op
0Es ΓεnΣym-95
0D
10s ΓεnΣym-95
10s do
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/do
09o 383
10s ΓεnΣym-95
10s let*
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/let*
09o 355
10s ΓεnΣym-95
10s def
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/def
09o 327
10s ΓεnΣym-95
10s set!
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/set!
09o 299
10s ΓεnΣym-95
10s if
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/if
09o 271
10s ΓεnΣym-95
10s while
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/while
09o 243
10s ΓεnΣym-95
10s and
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/and
09o 215
10s ΓεnΣym-95
10s or
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/or
09o 187
10s ΓεnΣym-95
10s fn*
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/fn*
09o 159
10s ΓεnΣym-95
10s macro*
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/macro*
09o 131
10s ΓεnΣym-95
10s ω*
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/ω*
09o 103
10s ΓεnΣym-95
10s try
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/try
09o 75
10s ΓεnΣym-95
10s return
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/return
09o 47
10s ΓεnΣym-95
10s quote
20
0Bo 17
10s source
12
11
08i 1 v bytecompile/quote
09o 21
10s op
10s source
12
10s env
08i 3 v bytecompile/procedure
16
09o 152
10s ΓεnΣym-94
05v :pair
20
0C
0Ao 22
0D
10s ΓεnΣym-94
05v :symbol
20
0C
0Ao 8
0D
05v #f
0Bo 24
10s op
10s source
12
10s env
08i 3 v bytecompile/procedure/dynamic
09o 96
10s ΓεnΣym-94
05v :string
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/string
09o 68
10s ΓεnΣym-94
05v :array
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/array
09o 40
10s ΓεnΣym-94
05v :tree
20
0Bo 19
10s source
10s env
08i 2 v bytecompile/tree
09o 12
10s source
08i 1 v bytecompile/literal
16
01
}
0Es bytecompile*
0D
25v bytecompile v [form environment] v #@[source: [[list [bytecompile* form environment] [$ret]]]] v #{
10s form
10s environment
08i 2 v bytecompile*
08i 0 v $ret
08i 2 v list
01
}
0Es bytecompile
01
}#{
25v load/forms v [source environment] v #@[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" [for-in [form source] [-> [macroexpand form environment] bytecompile assemble* [bytecode-eval environment]]]]] v #{
15
10s source
0Es ΓεnΣym-99
0D
10s ΓεnΣym-99
0Bo 73
02i 0
1B
1C
10s ΓεnΣym-99
0Bo 59
0D
10s ΓεnΣym-99
11
0Es form
0D
10s form
10s environment
08i 2 v macroexpand
08i 1 v bytecompile
08i 1 v assemble*
10s environment
08i 2 v bytecode-eval
0D
10s ΓεnΣym-99
12
0Fs ΓεnΣym-99
09o -61
09o 4
24
16
01
}
0Es load/forms
0D
25v macroexpand/forms v [source-raw environment] v #@[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 [ω]]] [load/forms source-raw environment] [macroexpand source-raw environment]]] v #{
10s environment
0Bo 7
24
09o 12
15
24
0D
13
16
0Fs environment
0D
10s source-raw
10s environment
08i 2 v load/forms
0D
10s source-raw
10s environment
08i 2 v macroexpand
01
}
0Es macroexpand/forms
0D
25v compile/debug v [expr] v #@[source: [[-> [macroexpand expr] bytecompile assemble* disassemble]]] v #{
10s expr
08i 1 v macroexpand
08i 1 v bytecompile
08i 1 v assemble*
08i 1 v disassemble
01
}
0Es compile/debug
0D
25v compile* v [source environment] v #@[documentation: "Compile SOURCE so it can be evaluated/applied" source: ["Compile SOURCE so it can be evaluated/applied" [-> [macroexpand source environment] bytecompile assemble*]]] v #{
10s source
10s environment
08i 2 v macroexpand
08i 1 v bytecompile
08i 1 v assemble*
01
}
0Es compile*
0D
25v compile/do* v [source environment] v #@[source: [[compile* [cons do source] environment]]] v #{
10s do
10s source
14
10s environment
08i 2 v compile*
01
}
0Es compile/do*
0D
26v compile v [source] v #@[documentation: "Compile SOURCE so it can be evaluated/applied" source: ["Compile SOURCE so it can be evaluated/applied" [quasiquote [compile* [unquote source] [current-closure]]]]] v #{
23s compile*
10s source
23s current-closure
24
14
24
14
14
14
01
}
0Es compile
0D
26v compile/do v [source] v #@[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]]]]] v #{
23s compile*
23s cons
23s do
10s source
24
14
14
14
23s current-closure
24
14
24
14
14
14
01
}
0Es compile/do
0D
25v meta/parse/body v [type args body] v #@[source: [[def meta [tree/new #nil]] [for-in [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]]] v #{
24
08i 1 v tree/new
0Es meta
0D
15
10s body
0Es ΓεnΣym-100
0D
10s ΓεnΣym-100
0Bo 174
02i 0
1B
1C
10s ΓεnΣym-100
0Bo 160
0D
10s ΓεnΣym-100
11
0Es v
0D
15
10s v
08i 1 v type-of
0Es ΓεnΣym-101
0D
10s ΓεnΣym-101
05v :pair
20
0Bo 11
10s meta
01
09o 100
10s ΓεnΣym-101
05v :string
20
0Bo 55
10s meta
05v :documentation
10s meta
05v :documentation
08i 2 v tree/ref
08i 1 v string
05v "\n"
10s v
08i 3 v cat
08i 1 v trim
08i 3 v tree/set!
09o 36
10s ΓεnΣym-101
05v :keyword
20
0Bo 23
10s meta
10s v
05v #t
08i 3 v tree/set!
09o 4
24
16
0D
10s ΓεnΣym-100
12
0Fs ΓεnΣym-100
09o -162
09o 4
24
16
0D
10s meta
01
01
}
0Es meta/parse/body
0D
26v defmacro v [name args . body] v #@[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]]]]]]]] v #{
23s def
10s name
23s macro*
10s name
10s args
05v :macro
10s args
10s body
08i 3 v meta/parse/body
05v :source
10s body
08i 3 v tree/set!
10s body
08i 0 v current-closure
08i 2 v compile/do*
24
14
14
14
14
14
24
14
14
14
01
}
0Es defmacro
0D
26v fn v [args . body] v #@[documentation: "Define an anonymous function" source: ["Define an anonymous function" [quasiquote [fn* 'anonymous [unquote args] [unquote [tree/set! [meta/parse/body :lambda args body] :source body]] [unquote [compile/do* body [current-closure]]]]]]] v #{
23s fn*
23s quote
23s anonymous
24
14
14
10s args
05v :lambda
10s args
10s body
08i 3 v meta/parse/body
05v :source
10s body
08i 3 v tree/set!
10s body
08i 0 v current-closure
08i 2 v compile/do*
24
14
14
14
14
14
01
}
0Es fn
0D
26v defn v [name args . body] v #@[documentation: "Define a new function" source: ["Define a new function" [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]]]]]]]] v #{
23s def
10s name
23s fn*
10s name
10s args
05v :lambda
10s args
10s body
08i 3 v meta/parse/body
05v :source
10s body
08i 3 v tree/set!
10s body
08i 0 v current-closure
08i 2 v compile/do*
24
14
14
14
14
14
24
14
14
14
01
}
0Es defn
0D
26v ω v body v #@[documentation: "Defines and returns new object after evaluating body within" source: ["Defines and returns new object after evaluating body within" [macroexpand [cons 'ω* body]]]] v #{
23s ω*
10s body
14
08i 1 v macroexpand
01
}
0Es ω
0D
10s ω
0Es defobj
0D
25v eval-in v [closure expr] v #@[documentation: "Compile and the immediatly evaluate the result\nMostly used by lRun()" source: ["Compile and the immediatly evaluate the result" "" "Mostly used by lRun()" [try display/error [-> [compile* expr closure] [bytecode-eval closure]]]]] v #{
10s display/error
19o 26
10s expr
10s closure
08i 2 v compile*
10s closure
08i 2 v bytecode-eval
16
01
}
0Es eval-in
0D
25v eval-in/trace v [closure expr] v #@[documentation: "Compile and the immediatly evaluate the result\nmostly used by lRun()" source: ["Compile and the immediatly evaluate the result" "" "mostly used by lRun()" [try display/error [def bc [compile* expr closure]] [println [str/write bc]] [bytecode-eval bc closure]]]] v #{
10s display/error
19o 50
10s expr
10s closure
08i 2 v compile*
0Es bc
0D
10s bc
08i 1 v str/write
08i 1 v println
0D
10s bc
10s closure
08i 2 v bytecode-eval
16
01
}
0Es eval-in/trace
0D
26v eval v [expr] v #@[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]]]]] v #{
23s eval-in
23s current-closure
24
14
10s expr
24
14
14
14
01
}
0Es eval
0D
26v typecheck/only v [v t] v #@[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]]]]]]] v #{
23s when-not
23s ==
23s type-of
10s v
24
14
14
10s t
24
14
14
14
23s throw
23s list
05v :type-error
05v "Expected a value of type "
10s t
08i 2 v cat
10s v
23s current-lambda
24
14
24
14
14
14
14
14
24
14
14
24
14
14
14
01
}
0Es typecheck/only
01
}#{
25v disassemble/length v [op] v #@[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 #$1B #$1C #$1E #$1F #$20 #$21 #$22 #$24] 1] [[#$2 #$7 #$1A] 2] [[#$9 #$A #$B #$18 #$19] 3] [[#$5 #$E #$F #$10 #$23] 4] [[#$4 #$8] 5] [[#$25 #$26] 13] [otherwise [throw [list :unknown-op "This op needs its length specified for disassembly to work" op [current-lambda]]]]]]] v #{
15
10s op
0Es ΓεnΣym-106
0D
10s ΓεnΣym-106
05v #$0
20
0C
0Ao 260
0D
10s ΓεnΣym-106
05v #$1
20
0C
0Ao 246
0D
10s ΓεnΣym-106
05v #$3
20
0C
0Ao 232
0D
10s ΓεnΣym-106
05v #$C
20
0C
0Ao 218
0D
10s ΓεnΣym-106
05v #$D
20
0C
0Ao 204
0D
10s ΓεnΣym-106
05v #$11
20
0C
0Ao 190
0D
10s ΓεnΣym-106
05v #$12
20
0C
0Ao 176
0D
10s ΓεnΣym-106
05v #$13
20
0C
0Ao 162
0D
10s ΓεnΣym-106
05v #$14
20
0C
0Ao 148
0D
10s ΓεnΣym-106
05v #$15
20
0C
0Ao 134
0D
10s ΓεnΣym-106
05v #$16
20
0C
0Ao 120
0D
10s ΓεnΣym-106
05v #$1B
20
0C
0Ao 106
0D
10s ΓεnΣym-106
05v #$1C
20
0C
0Ao 92
0D
10s ΓεnΣym-106
05v #$1E
20
0C
0Ao 78
0D
10s ΓεnΣym-106
05v #$1F
20
0C
0Ao 64
0D
10s ΓεnΣym-106
05v #$20
20
0C
0Ao 50
0D
10s ΓεnΣym-106
05v #$21
20
0C
0Ao 36
0D
10s ΓεnΣym-106
05v #$22
20
0C
0Ao 22
0D
10s ΓεnΣym-106
05v #$24
20
0C
0Ao 8
0D
05v #f
0Bo 8
02i 1
09o 328
10s ΓεnΣym-106
05v #$2
20
0C
0Ao 36
0D
10s ΓεnΣym-106
05v #$7
20
0C
0Ao 22
0D
10s ΓεnΣym-106
05v #$1A
20
0C
0Ao 8
0D
05v #f
0Bo 8
02i 2
09o 274
10s ΓεnΣym-106
05v #$9
20
0C
0Ao 64
0D
10s ΓεnΣym-106
05v #$A
20
0C
0Ao 50
0D
10s ΓεnΣym-106
05v #$B
20
0C
0Ao 36
0D
10s ΓεnΣym-106
05v #$18
20
0C
0Ao 22
0D
10s ΓεnΣym-106
05v #$19
20
0C
0Ao 8
0D
05v #f
0Bo 8
02i 3
09o 192
10s ΓεnΣym-106
05v #$5
20
0C
0Ao 64
0D
10s ΓεnΣym-106
05v #$E
20
0C
0Ao 50
0D
10s ΓεnΣym-106
05v #$F
20
0C
0Ao 36
0D
10s ΓεnΣym-106
05v #$10
20
0C
0Ao 22
0D
10s ΓεnΣym-106
05v #$23
20
0C
0Ao 8
0D
05v #f
0Bo 8
02i 4
09o 110
10s ΓεnΣym-106
05v #$4
20
0C
0Ao 22
0D
10s ΓεnΣym-106
05v #$8
20
0C
0Ao 8
0D
05v #f
0Bo 8
02i 5
09o 70
10s ΓεnΣym-106
05v #$25
20
0C
0Ao 22
0D
10s ΓεnΣym-106
05v #$26
20
0C
0Ao 8
0D
05v #f
0Bo 8
02i 13
09o 30
05v :unknown-op
05v "This op needs its length specified for disassembly to work"
10s op
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es disassemble/length
0D
25v bytecode/nil-catcher v [error] v #@[source: [[if [== [car error] :type-error] #nil [throw error]]]] v #{
10s error
11
05v :type-error
20
0Bo 7
24
09o 12
10s error
08i 1 v throw
01
}
0Es bytecode/nil-catcher
0D
25v bytecode-op->val v [a b c] v #@[documentation: "Turn three bytecode ops representing an encoded value into an actual value" source: ["Turn three bytecode ops representing an encoded value into an actual value" [index->val [logior [ash [bytecode-op->int a] 16] [ash [bytecode-op->int b] 8] [bytecode-op->int c]]]]] v #{
10s a
08i 1 v bytecode-op->int
02i 16
08i 2 v ash
10s b
08i 1 v bytecode-op->int
02i 8
08i 2 v ash
10s c
08i 1 v bytecode-op->int
08i 3 v logior
08i 1 v index->val
01
}
0Es bytecode-op->val
0D
25v bytecode-arr->val v [a i] v #@[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]]]]]] v #{
10s bytecode/nil-catcher
19o 62
10s a
10s i
08i 2 v ref
10s a
02i 1
10s i
08i 2 v +
08i 2 v ref
10s a
02i 2
10s i
08i 2 v +
08i 2 v ref
08i 3 v bytecode-op->val
16
01
}
0Es bytecode-arr->val
0D
25v bytecode-op->sym v [a b c] v #@[documentation: "Turn three bytecode ops representing an encoded symbol into an actual symbol" source: ["Turn three bytecode ops representing an encoded symbol into an actual symbol" [index->sym [logior [ash [bytecode-op->int a] 16] [ash [bytecode-op->int b] 8] [bytecode-op->int c]]]]] v #{
10s a
08i 1 v bytecode-op->int
02i 16
08i 2 v ash
10s b
08i 1 v bytecode-op->int
02i 8
08i 2 v ash
10s c
08i 1 v bytecode-op->int
08i 3 v logior
08i 1 v index->sym
01
}
0Es bytecode-op->sym
0D
25v bytecode-arr->sym v [a i] v #@[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]]]]]] v #{
10s bytecode/nil-catcher
19o 62
10s a
10s i
08i 2 v ref
10s a
02i 1
10s i
08i 2 v +
08i 2 v ref
10s a
02i 2
10s i
08i 2 v +
08i 2 v ref
08i 3 v bytecode-op->sym
16
01
}
0Es bytecode-arr->sym
0D
25v bytecode-op->offset v [a b] v #@[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 [logior [ash [bytecode-op->int a] 8] [bytecode-op->int b]]] [if-not [> t 32768] t [- [- 65536 t]]]]] v #{
10s a
08i 1 v bytecode-op->int
02i 8
08i 2 v ash
10s b
08i 1 v bytecode-op->int
08i 2 v logior
0Es t
0D
10s t
05v 32768
22
0Bo 24
05v 65536
10s t
08i 2 v -
08i 1 v -
09o 7
10s t
01
}
0Es bytecode-op->offset
0D
25v bytecode-arr->offset v [a i] v #@[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]]]]] v #{
10s a
10s i
08i 2 v ref
10s a
02i 1
10s i
08i 2 v +
08i 2 v ref
08i 2 v bytecode-op->offset
01
}
0Es bytecode-arr->offset
0D
25v disassemble/op v [a i] v #@[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/new [unquote [bytecode-op->int [ref a [+ i 1]]]] [unquote [bytecode-arr->val a [+ i 2]]]]]] [#$5 [quasiquote [$push/lval [unquote [bytecode-arr->val a [+ i 1]]]]]] [#$7 [quasiquote [$apply/dynamic/new [unquote [bytecode-op->int [ref a [+ i 1]]]]]]] [#$8 [quasiquote [$apply [unquote [bytecode-op->int [ref a [+ i 1]]]] [unquote [bytecode-arr->val a [+ i 2]]]]]] [#$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 [$def [unquote [bytecode-arr->sym a [+ i 1]]]]]] [#$F [quasiquote [$set [unquote [bytecode-arr->sym a [+ i 1]]]]]] [#$10 [quasiquote [$get [unquote [bytecode-arr->sym a [+ i 1]]]]]] [#$11 '[$car]] [#$12 '[$cdr]] [#$13 '[$closure/push]] [#$14 '[$cons]] [#$15 '[$let]] [#$16 '[$closure/pop]] [#$18 [quasiquote [$try/old [unquote [bytecode-arr->offset a [+ i 1]]]]]] [#$19 [quasiquote [$try [unquote [bytecode-arr->offset a [+ i 1]]]]]] [#$1A [quasiquote [$apply/dynamic [unquote [bytecode-op->int [ref a [+ i 1]]]]]]] [#$1B [quasiquote [$roots/push]]] [#$1C [quasiquote [$roots/pop]]] [#$1E [quasiquote [$<]]] [#$1F [quasiquote [$<=]]] [#$20 [quasiquote [$==]]] [#$21 [quasiquote [$>=]]] [#$22 [quasiquote [$>]]] [#$23 [quasiquote [$push/symbol [unquote [bytecode-arr->sym a [+ i 1]]]]]] [#$24 [quasiquote [$push/nil]]] [#$25 [quasiquote [$fn [unquote [bytecode-arr->val a [+ i 1]]] [unquote [bytecode-arr->val a [+ i 4]]] [unquote [bytecode-arr->val a [+ i 7]]] [unquote [bytecode-arr->val a [+ i 10]]]]]] [#$26 [quasiquote [$macro* [unquote [bytecode-arr->val a [+ i 1]]] [unquote [bytecode-arr->val a [+ i 4]]] [unquote [bytecode-arr->val a [+ i 7]]] [unquote [bytecode-arr->val a [+ i 10]]]]]] [otherwise :unknown-op]]]] v #{
15
10s a
10s i
08i 2 v ref
0Es ΓεnΣym-107
0D
10s ΓεnΣym-107
05v #$0
20
0Bo 10
05v [$nop]
09o 1272
10s ΓεnΣym-107
05v #$1
20
0Bo 10
05v [$ret]
09o 1253
10s ΓεnΣym-107
05v #$2
20
0Bo 38
23s $push/int/byte
10s a
10s i
02i 1
08i 2 v +
08i 2 v ref
08i 1 v bytecode-op->int
24
14
14
09o 1206
10s ΓεnΣym-107
05v #$3
20
0Bo 10
05v [$add/int]
09o 1187
10s ΓεnΣym-107
05v #$4
20
0Bo 59
23s $apply/new
10s a
10s i
02i 1
08i 2 v +
08i 2 v ref
08i 1 v bytecode-op->int
10s a
10s i
02i 2
08i 2 v +
08i 2 v bytecode-arr->val
24
14
14
14
09o 1119
10s ΓεnΣym-107
05v #$5
20
0Bo 33
23s $push/lval
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->val
24
14
14
09o 1077
10s ΓεnΣym-107
05v #$7
20
0Bo 38
23s $apply/dynamic/new
10s a
10s i
02i 1
08i 2 v +
08i 2 v ref
08i 1 v bytecode-op->int
24
14
14
09o 1030
10s ΓεnΣym-107
05v #$8
20
0Bo 59
23s $apply
10s a
10s i
02i 1
08i 2 v +
08i 2 v ref
08i 1 v bytecode-op->int
10s a
10s i
02i 2
08i 2 v +
08i 2 v bytecode-arr->val
24
14
14
14
09o 962
10s ΓεnΣym-107
05v #$9
20
0Bo 33
23s $jmp*
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->offset
24
14
14
09o 920
10s ΓεnΣym-107
05v #$A
20
0Bo 33
23s $jt*
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->offset
24
14
14
09o 878
10s ΓεnΣym-107
05v #$B
20
0Bo 33
23s $jf*
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->offset
24
14
14
09o 836
10s ΓεnΣym-107
05v #$C
20
0Bo 10
05v [$dup]
09o 817
10s ΓεnΣym-107
05v #$D
20
0Bo 10
05v [$drop]
09o 798
10s ΓεnΣym-107
05v #$E
20
0Bo 33
23s $def
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->sym
24
14
14
09o 756
10s ΓεnΣym-107
05v #$F
20
0Bo 33
23s $set
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->sym
24
14
14
09o 714
10s ΓεnΣym-107
05v #$10
20
0Bo 33
23s $get
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->sym
24
14
14
09o 672
10s ΓεnΣym-107
05v #$11
20
0Bo 10
05v [$car]
09o 653
10s ΓεnΣym-107
05v #$12
20
0Bo 10
05v [$cdr]
09o 634
10s ΓεnΣym-107
05v #$13
20
0Bo 10
05v [$closure/push]
09o 615
10s ΓεnΣym-107
05v #$14
20
0Bo 10
05v [$cons]
09o 596
10s ΓεnΣym-107
05v #$15
20
0Bo 10
05v [$let]
09o 577
10s ΓεnΣym-107
05v #$16
20
0Bo 10
05v [$closure/pop]
09o 558
10s ΓεnΣym-107
05v #$18
20
0Bo 33
23s $try/old
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->offset
24
14
14
09o 516
10s ΓεnΣym-107
05v #$19
20
0Bo 33
23s $try
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->offset
24
14
14
09o 474
10s ΓεnΣym-107
05v #$1A
20
0Bo 38
23s $apply/dynamic
10s a
10s i
02i 1
08i 2 v +
08i 2 v ref
08i 1 v bytecode-op->int
24
14
14
09o 427
10s ΓεnΣym-107
05v #$1B
20
0Bo 12
23s $roots/push
24
14
09o 406
10s ΓεnΣym-107
05v #$1C
20
0Bo 12
23s $roots/pop
24
14
09o 385
10s ΓεnΣym-107
05v #$1E
20
0Bo 12
23s $<
24
14
09o 364
10s ΓεnΣym-107
05v #$1F
20
0Bo 12
23s $<=
24
14
09o 343
10s ΓεnΣym-107
05v #$20
20
0Bo 12
23s $==
24
14
09o 322
10s ΓεnΣym-107
05v #$21
20
0Bo 12
23s $>=
24
14
09o 301
10s ΓεnΣym-107
05v #$22
20
0Bo 12
23s $>
24
14
09o 280
10s ΓεnΣym-107
05v #$23
20
0Bo 33
23s $push/symbol
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->sym
24
14
14
09o 238
10s ΓεnΣym-107
05v #$24
20
0Bo 12
23s $push/nil
24
14
09o 217
10s ΓεnΣym-107
05v #$25
20
0Bo 96
23s $fn
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->val
10s a
10s i
02i 4
08i 2 v +
08i 2 v bytecode-arr->val
10s a
10s i
02i 7
08i 2 v +
08i 2 v bytecode-arr->val
10s a
10s i
02i 10
08i 2 v +
08i 2 v bytecode-arr->val
24
14
14
14
14
14
09o 112
10s ΓεnΣym-107
05v #$26
20
0Bo 96
23s $macro*
10s a
10s i
02i 1
08i 2 v +
08i 2 v bytecode-arr->val
10s a
10s i
02i 4
08i 2 v +
08i 2 v bytecode-arr->val
10s a
10s i
02i 7
08i 2 v +
08i 2 v bytecode-arr->val
10s a
10s i
02i 10
08i 2 v +
08i 2 v bytecode-arr->val
24
14
14
14
14
14
09o 7
05v :unknown-op
16
01
}
0Es disassemble/op
0D
25v disassemble/array v [a i] v #@[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]] [set! ret [cons [cons i [disassemble/op a i]] ret]] [set! i [+ i [disassemble/length [ref a i]]]]] [nreverse ret]]] v #{
24
0Es ret
0D
02i 0
1B
1C
10s i
10s a
08i 1 v array/length
1E
0Bo 66
0D
10s i
10s a
10s i
08i 2 v disassemble/op
14
10s ret
14
0Fs ret
0D
10s i
10s a
10s i
08i 2 v ref
08i 1 v disassemble/length
08i 2 v +
0Fs i
09o -78
0D
10s ret
08i 1 v nreverse
01
}
0Es disassemble/array
0D
25v disassemble/bytecode-array v [code] v #@[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]]] v #{
10s code
08i 1 v bytecode-arr->arr
02i 0
08i 2 v disassemble/array
01
}
0Es disassemble/bytecode-array
0D
25v disassemble/print v [bc] v #@[source: [[for-in [a [disassemble/bytecode-array bc]] [println [cat [ansi-blue [string/pad-start [string [car a]] 6]] " - " [cdr a]]]]]] v #{
15
10s bc
08i 1 v disassemble/bytecode-array
0Es ΓεnΣym-108
0D
10s ΓεnΣym-108
0Bo 82
02i 0
1B
1C
10s ΓεnΣym-108
0Bo 68
0D
10s ΓεnΣym-108
11
0Es a
0D
10s a
11
08i 1 v string
02i 6
08i 2 v string/pad-start
08i 1 v ansi-blue
05v " - "
10s a
12
08i 3 v cat
08i 1 v println
0D
10s ΓεnΣym-108
12
0Fs ΓεnΣym-108
09o -70
09o 4
24
16
01
}
0Es disassemble/print
0D
25v disassemble v [bc] v #@[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 [ref [closure bc] :code]]] [:bytecode-array [disassemble/print bc]] [otherwise [throw [list :type-error "Can't disassemble that" bc [current-lambda]]]]]]] v #{
15
10s bc
08i 1 v type-of
0Es ΓεnΣym-109
0D
10s ΓεnΣym-109
05v :lambda
20
0C
0Ao 22
0D
10s ΓεnΣym-109
05v :macro
20
0C
0Ao 8
0D
05v #f
0Bo 29
10s bc
08i 1 v closure
05v :code
08i 2 v ref
08i 1 v disassemble/print
09o 54
10s ΓεnΣym-109
05v :bytecode-array
20
0Bo 15
10s bc
08i 1 v disassemble/print
09o 30
05v :type-error
05v "Can't disassemble that"
10s bc
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es disassemble
01
}#{
25v macroexpand/do/args v [args env] v #@[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]]]]] v #{
10s args
12
08i 1 v nil?
0Bo 22
10s args
11
10s env
08i 2 v macroexpand*
24
14
09o 102
10s args
11
08i 1 v pair?
0Bo 75
15
10s args
11
10s env
08i 2 v macroexpand*
0Es ocar
0D
10s ocar
08i 1 v pair?
0Bo 25
10s ocar
10s args
12
10s env
08i 2 v macroexpand/do/args
14
09o 17
10s args
12
10s env
08i 2 v macroexpand/do/args
16
09o 17
10s args
12
10s env
08i 2 v macroexpand/do/args
01
}
0Es macroexpand/do/args
0D
25v macroexpand/do v [source env] v #@[source: [[def args [macroexpand/do/args source env]] [if [last? args] [car args] [cons 'do args]]]] v #{
10s source
10s env
08i 2 v macroexpand/do/args
0Es args
0D
10s args
12
08i 1 v nil?
0Bo 11
10s args
11
09o 12
23s do
10s args
14
01
}
0Es macroexpand/do
0D
25v macroexpand/form v [source env op arity implicit-do? no-expand-bitmap] v #@[source: [[def ret [cons op #nil]] [def l [cdr source]] [for [i 0 arity] [set! ret [cons [if [bit-set? 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]]]] v #{
10s op
24
14
0Es ret
0D
10s source
12
0Es l
0D
15
02i 0
0Es i
0D
10s arity
0Es ΓεnΣym-113
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-113
1E
0Bo 76
0D
10s no-expand-bitmap
10s i
08i 2 v bit-set?
0Bo 11
10s l
11
09o 17
10s l
11
10s env
08i 2 v macroexpand*
10s ret
14
0Fs ret
0D
10s l
12
0Fs l
0D
02i 1
10s i
03
0Fs i
09o -83
16
0D
10s implicit-do?
0Bo 28
10s l
10s env
08i 2 v macroexpand/do
10s ret
14
0Fs ret
09o 54
10s l
0Bo 46
05v :arity-error
05v "form contains more than "
10s arity
05v " arguments"
08i 3 v cat
10s source
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
10s ret
08i 1 v nreverse
01
01
}
0Es macroexpand/form
0D
25v macroexpand/fold v [op source env] v #@[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]]]]] v #{
10s source
12
0Bo 106
10s source
12
12
0Bo 56
10s op
10s op
10s source
08i 1 v except-last-pair
10s env
08i 3 v macroexpand/fold
10s source
08i 1 v last-pair
11
10s env
08i 2 v macroexpand*
08i 3 v list
09o 41
10s op
10s source
11
10s env
08i 2 v macroexpand*
10s source
12
11
10s env
08i 2 v macroexpand*
08i 3 v list
09o 26
10s op
10s source
11
10s env
08i 2 v macroexpand*
08i 2 v list
01
}
0Es macroexpand/fold
0D
25v macroexpand* v [source env] v #@[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] [:native-function [case op [[+ - * / %] [macroexpand/fold op [cdr 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]]] 'source [otherwise [map source [fn [α] [macroexpand* α env]]]]]] [:macro [macroexpand* [macro-apply op [cdr source]] env]] [otherwise [map source [fn [α] [macroexpand* α env]]]]]]] v #{
10s source
11
10s env
08i 2 v resolves?
0Bo 20
10s source
11
10s env
08i 2 v resolve
09o 8
10s source
11
0Es op
0D
15
10s op
08i 1 v type-of
0Es ΓεnΣym-114
0D
10s ΓεnΣym-114
05v :nil
20
0Bo 10
10s source
09o 582
10s ΓεnΣym-114
05v :native-function
20
0Bo 510
15
10s op
0Es ΓεnΣym-115
0D
10s ΓεnΣym-115
10s +
20
0C
0Ao 64
0D
10s ΓεnΣym-115
10s -
20
0C
0Ao 50
0D
10s ΓεnΣym-115
10s *
20
0C
0Ao 36
0D
10s ΓεnΣym-115
10s /
20
0C
0Ao 22
0D
10s ΓεnΣym-115
10s %
20
0C
0Ao 8
0D
05v #f
0Bo 20
10s op
10s source
12
08i 2 v macroexpand/fold
09o 402
10s ΓεnΣym-115
10s do
20
0Bo 19
10s source
10s env
08i 2 v macroexpand/do
09o 374
10s ΓεnΣym-115
10s return
20
0Bo 31
10s source
10s env
10s op
02i 1
05v #f
02i 0
08i 6 v macroexpand/form
09o 334
10s ΓεnΣym-115
10s try
20
0C
0Ao 22
0D
10s ΓεnΣym-115
10s while
20
0C
0Ao 8
0D
05v #f
0Bo 31
10s source
10s env
10s op
02i 1
05v #t
02i 0
08i 6 v macroexpand/form
09o 271
10s ΓεnΣym-115
10s def
20
0C
0Ao 22
0D
10s ΓεnΣym-115
10s set!
20
0C
0Ao 8
0D
05v #f
0Bo 31
10s source
10s env
10s op
02i 2
05v #f
02i 1
08i 6 v macroexpand/form
09o 208
10s ΓεnΣym-115
10s if
20
0Bo 31
10s source
10s env
10s op
02i 3
05v #f
02i 0
08i 6 v macroexpand/form
09o 168
10s ΓεnΣym-115
10s fn*
20
0C
0Ao 22
0D
10s ΓεnΣym-115
10s macro*
20
0C
0Ao 8
0D
05v #f
0Bo 31
10s source
10s env
10s op
02i 4
05v #t
02i 7
08i 6 v macroexpand/form
09o 105
10s ΓεnΣym-115
10s let*
20
0C
0Ao 22
0D
10s ΓεnΣym-115
10s environment*
20
0C
0Ao 8
0D
05v #f
0Bo 29
10s op
10s source
12
10s env
08i 2 v macroexpand/do
08i 2 v list
09o 44
10s ΓεnΣym-115
10s quote
20
0Bo 10
10s source
09o 25
10s source
25v 'anonymous v [α] v #@[source: [[macroexpand* α env]]] v #{
10s α
10s env
08i 2 v macroexpand*
01
}
08i 2 v map
16
09o 63
10s ΓεnΣym-114
05v :macro
20
0Bo 29
10s op
10s source
12
08i 2 v macro-apply
10s env
08i 2 v macroexpand*
09o 25
10s source
25v 'anonymous v [α] v #@[source: [[macroexpand* α env]]] v #{
10s α
10s env
08i 2 v macroexpand*
01
}
08i 2 v map
16
01
}
0Es macroexpand*
0D
25v macroexpand v [source env] v #@[documentation: "Macroexpand the forms in source" source: ["Macroexpand the forms in source" [macroexpand* source [or env [current-closure]]]]] v #{
10s source
10s env
0C
0Ao 18
0D
08i 0 v current-closure
0C
0Ao 8
0D
05v #f
08i 2 v macroexpand*
01
}
0Es macroexpand
01
}#{
24
0Es yield-queue
0D
25v yield v [pred fun] v #@[documentation: "Evaluates FUN once PRED is true" source: ["Evaluates FUN once PRED is true" [set! yield-queue [cons [cons pred fun] yield-queue]] #t]] v #{
10s pred
10s fun
14
10s yield-queue
14
0Fs yield-queue
0D
05v #t
01
}
0Es yield
0D
25v yield-run v [] v #@[documentation: "Executes pending coroutines if their predicate evaluates to #t" source: ["Executes pending coroutines if their predicate evaluates to #t" [def old yield-queue] [set! yield-queue #nil] [for-in [cur old] [if [[car cur]] [[cdr cur]] [set! yield-queue [cons cur yield-queue]]]]]] v #{
10s yield-queue
0Es old
0D
24
0Fs yield-queue
0D
15
10s old
0Es ΓεnΣym-118
0D
10s ΓεnΣym-118
0Bo 74
02i 0
1B
1C
10s ΓεnΣym-118
0Bo 60
0D
10s ΓεnΣym-118
11
0Es cur
0D
10s cur
11
1Ai 0
0Bo 13
10s cur
12
1Ai 0
09o 16
10s cur
10s yield-queue
14
0Fs yield-queue
0D
10s ΓεnΣym-118
12
0Fs ΓεnΣym-118
09o -62
09o 4
24
16
01
}
0Es yield-run
0D
25v timeout v [milliseconds] v #@[documentation: "Returns a function that evaluates to true once MILLISECONDS have passed" source: ["Returns a function that evaluates to true once MILLISECONDS have passed" [def goal [+ [time/milliseconds] milliseconds]] [fn [] [> [time/milliseconds] goal]]]] v #{
08i 0 v time/milliseconds
10s milliseconds
08i 2 v +
0Es goal
0D
25v 'anonymous v [] v #@[source: [[> [time/milliseconds] goal]]] v #{
08i 0 v time/milliseconds
10s goal
22
01
}
01
}
0Es timeout
0D
25v event-bind v [event id handler] v #@[documentation: "Bind handler to be evaluated when event-name fires, overwriting whichever handler has been associated with id before." source: ["Bind handler to be evaluated when event-name fires, overwriting whichever handler has been associated with id before." [tree/set! event id handler]]] v #{
10s event
10s id
10s handler
08i 3 v tree/set!
01
}
0Es event-bind
0D
26v event-clear v [event] v #@[documentation: "Clears all event handlers for event-name" source: ["Clears all event handlers for event-name" [quasiquote [set! [unquote event] [tree/new #nil]]]]] v #{
23s set!
10s event
23s tree/new
24
24
14
14
24
14
14
14
01
}
0Es event-clear
0D
25v event-fire v [event val] v #@[documentation: "Applies ...val to all event handlers associated with event-name" source: ["Applies ...val to all event handlers associated with event-name" [for-in [h [tree/values event]] [h val]]]] v #{
15
10s event
08i 1 v tree/values
0Es ΓεnΣym-119
0D
10s ΓεnΣym-119
0Bo 51
02i 0
1B
1C
10s ΓεnΣym-119
0Bo 37
0D
10s ΓεnΣym-119
11
0Es h
0D
10s h
10s val
1Ai 1
0D
10s ΓεnΣym-119
12
0Fs ΓεnΣym-119
09o -39
09o 4
24
16
01
}
0Es event-fire
01
}#{
25v let/arg v [arg] v #@[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]]]]]]] v #{
10s arg
0Bo 116
10s arg
08i 1 v pair?
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 37
0D
10s arg
11
08i 1 v symbol?
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 8
0D
05v #f
0Bo 28
05v :invalid-let-form
05v "Please fix the structure of the let form"
10s arg
08i 3 v list
08i 1 v throw
09o 4
24
0D
23s def
10s arg
11
10s arg
12
11
24
14
14
14
09o 4
24
01
}
0Es let/arg
0D
25v let/args v [args] v #@[source: [[if-not args #nil [cons [let/arg [car args]] [let/args [cdr args]]]]]] v #{
10s args
0Bo 27
10s args
11
08i 1 v let/arg
10s args
12
08i 1 v let/args
14
09o 4
24
01
}
0Es let/args
0D
26v let v [bindings . body] v #@[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]]]]]] v #{
23s let*
23s do
10s bindings
08i 1 v let/args
10s body
24
08i 2 v append
08i 2 v append
14
24
14
14
01
}
0Es let
0D
26v if-let v [binding then else] v #@[source: [[quasiquote [let* [def [unquote [car binding]] [unquote [cadr binding]]] [if [unquote [car binding]] [unquote then] [unquote else]]]]]] v #{
23s let*
23s def
10s binding
11
10s binding
12
11
24
14
14
14
23s if
10s binding
11
10s then
10s else
24
14
14
14
14
24
14
14
14
01
}
0Es if-let
0D
26v when-let v [binding . body] v #@[source: [[quasiquote [if-let [unquote binding] [unquote [cons 'do body]] #nil]]]] v #{
23s if-let
10s binding
23s do
10s body
14
24
24
14
14
14
14
01
}
0Es when-let
01
}#{
05v #t
0Es otherwise
0D
26v comment v body v #@[documentation: "Does nothing" source: ["Does nothing" #nil]] v #{
24
01
}
0Es comment
0D
26v += v [val inc] v #@[source: [[quasiquote [set! [unquote val] [+ [unquote val] [unquote inc]]]]]] v #{
23s set!
10s val
23s +
10s val
10s inc
24
14
14
14
24
14
14
14
01
}
0Es +=
0D
26v cdr! v [l] v #@[documentation: "[set! l [cdr l]]" source: ["[set! l [cdr l]]" [quasiquote [set! [unquote l] [cdr [unquote l]]]]]] v #{
23s set!
10s l
23s cdr
10s l
24
14
14
24
14
14
14
01
}
0Es cdr!
0D
25v not v [v] v #@[documentation: "Return true if V is false" source: [:inline "Return true if V is false" [if v #f #t]] inline: #t] v #{
10s v
0Bo 10
05v #f
09o 7
05v #t
01
}
0Es not
0D
25v identity v [α] v #@[documentation: "Returns its argument" source: [:inline "Returns its argument" α] inline: #t] v #{
10s α
01
}
0Es identity
0D
25v list v arguments v #@[documentation: "Return ARGUMENTS as a list" source: ["Return ARGUMENTS as a list" arguments]] v #{
10s arguments
01
}
0Es list
0D
25v default v [arg default-value] v #@[documentation: "Returns ARG or DEFAULT-VALUE if ARG is #nil" source: ["Returns ARG or DEFAULT-VALUE if ARG is #nil" [if arg arg default-value]]] v #{
10s arg
0Bo 10
10s arg
09o 7
10s default-value
01
}
0Es default
0D
25v caar v [p] v #@[documentation: "[car [car p]]" source: [:inline "[car [car p]]" [car [car p]]] inline: #t] v #{
10s p
11
11
01
}
0Es caar
0D
25v cadr v [p] v #@[documentation: "[car [cdr p]]" source: [:inline "[car [cdr p]]" [car [cdr p]]] inline: #t] v #{
10s p
12
11
01
}
0Es cadr
0D
25v cdar v [p] v #@[documentation: "[cdr [car p]]" source: [:inline "[cdr [car p]]" [cdr [car p]]] inline: #t] v #{
10s p
11
12
01
}
0Es cdar
0D
25v cddr v [p] v #@[documentation: "[cdr [cdr p]]" source: [:inline "[cdr [cdr p]]" [cdr [cdr p]]] inline: #t] v #{
10s p
12
12
01
}
0Es cddr
0D
25v cadar v [p] v #@[documentation: "[cdr [car p]]" source: ["[cdr [car p]]" [car [cdr [car p]]]]] v #{
10s p
11
12
11
01
}
0Es cadar
0D
25v caddr v [p] v #@[documentation: "[car [cdr [cdr p]]]" source: ["[car [cdr [cdr p]]]" [car [cdr [cdr p]]]]] v #{
10s p
12
12
11
01
}
0Es caddr
0D
25v cdddr v [p] v #@[documentation: "[cdr [cdr [cdr p]]]" source: ["[cdr [cdr [cdr p]]]" [cdr [cdr [cdr p]]]]] v #{
10s p
12
12
12
01
}
0Es cdddr
0D
25v cadddr v [p] v #@[documentation: "[car [cdr [cdr [cdr p]]]]" source: ["[car [cdr [cdr [cdr p]]]]" [car [cdr [cdr [cdr p]]]]]] v #{
10s p
12
12
12
11
01
}
0Es cadddr
0D
25v cddddr v [p] v #@[documentation: "[car [cdr [cdr [cdr p]]]]" source: ["[car [cdr [cdr [cdr p]]]]" [cdr [cdr [cdr [cdr p]]]]]] v #{
10s p
12
12
12
12
01
}
0Es cddddr
0D
25v caddddr v [p] v #@[documentation: "[car [cdr [cdr [cdr p]]]]" source: ["[car [cdr [cdr [cdr p]]]]" [car [cdr [cdr [cdr [cdr p]]]]]]] v #{
10s p
12
12
12
12
11
01
}
0Es caddddr
0D
25v cdddddr v [p] v #@[documentation: "[cdr [cdr [cdr [cdr p]]]]" source: ["[cdr [cdr [cdr [cdr p]]]]" [cdr [cdr [cdr [cdr [cdr p]]]]]]] v #{
10s p
12
12
12
12
12
01
}
0Es cdddddr
0D
25v keyword->string v [α] v #@[source: [[when-not [keyword? α] [throw [list :type-error "[keyword->string] can only be called on keywords" α [current-lambda]]]] [sym->str [keyword->symbol α]]]] v #{
10s α
08i 1 v keyword?
0Bo 7
24
09o 30
05v :type-error
05v "[keyword->string] can only be called on keywords"
10s α
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s α
08i 1 v keyword->symbol
08i 1 v sym->str
01
}
0Es keyword->string
0D
25v string->keyword v [α] v #@[source: [[when-not [string? α] [throw [list :type-error "[string->keyword] can only be called on strings" α [current-lambda]]]] [symbol->keyword [str->sym α]]]] v #{
10s α
08i 1 v string?
0Bo 7
24
09o 30
05v :type-error
05v "[string->keyword] can only be called on strings"
10s α
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s α
08i 1 v str->sym
08i 1 v symbol->keyword
01
}
0Es string->keyword
0D
26v exception v [type description value] v #@[source: [[quasiquote [throw [list [unquote type] [unquote description] [unquote value] [current-lambda]]]]]] v #{
23s throw
23s list
10s type
10s description
10s value
23s current-lambda
24
14
24
14
14
14
14
14
24
14
14
01
}
0Es exception
01
}#{
26v if-not v [pred then else] v #@[source: [[quasiquote [if [unquote pred] [unquote else] [unquote then]]]]] v #{
23s if
10s pred
10s else
10s then
24
14
14
14
14
01
}
0Es if-not
0D
26v when-not v [pred . body] v #@[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]]]]]] v #{
23s if
10s pred
24
23s do
10s body
24
08i 2 v append
14
24
14
14
14
14
01
}
0Es when-not
0D
26v when v [pred . body] v #@[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]]]] v #{
23s if
10s pred
23s do
10s body
24
08i 2 v append
14
24
24
14
14
14
14
01
}
0Es when
0D
25v case/clauses/multiple v [key-sym cases] v #@[source: [[when cases [cons [list '== key-sym [car cases]] [case/clauses/multiple key-sym [cdr cases]]]]]] v #{
10s cases
0Bo 39
23s ==
10s key-sym
10s cases
11
08i 3 v list
10s key-sym
10s cases
12
08i 2 v case/clauses/multiple
14
09o 4
24
01
}
0Es case/clauses/multiple
0D
25v case/clauses v [key-sym clauses] v #@[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]]]]]]] v #{
10s clauses
0Bo 197
10s clauses
11
11
23s otherwise
20
0Bo 17
23s do
10s clauses
11
12
14
09o 166
23s if
10s clauses
11
11
08i 1 v pair?
0Bo 99
10s clauses
11
11
11
23s quote
20
0C
0Bo 35
0D
10s clauses
11
11
12
12
08i 1 v nil?
0C
0Bo 17
0D
10s clauses
11
11
12
11
08i 1 v symbol?
0Bo 25
23s ==
10s key-sym
10s clauses
11
11
08i 3 v list
09o 23
23s or
10s key-sym
10s clauses
11
11
08i 2 v case/clauses/multiple
14
09o 22
23s ==
10s key-sym
10s clauses
11
11
08i 3 v list
23s do
10s clauses
11
12
14
10s key-sym
10s clauses
12
08i 2 v case/clauses
08i 4 v list
09o 4
24
01
}
0Es case/clauses
0D
26v case v [key-form . clauses] v #@[source: [[def key-sym [gensym]] [list 'let* [list 'def key-sym key-form] [case/clauses key-sym clauses]]]] v #{
08i 0 v gensym
0Es key-sym
0D
23s let*
23s def
10s key-sym
10s key-form
08i 3 v list
10s key-sym
10s clauses
08i 2 v case/clauses
08i 3 v list
01
}
0Es case
0D
26v cond v body v #@[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]]]]]] v #{
10s body
0C
0Bo 10
0D
10s body
11
11
0Bo 46
23s if
10s body
11
11
23s do
10s body
11
12
14
10s cond
10s body
12
08i 2 v macro-apply
08i 4 v list
09o 4
24
01
}
0Es cond
0D
26v for v [for-loop . body] v #@[documentation: "For loops, [for [name start stop] body]" source: ["For loops, [for [name start stop] body]" [def symbol-name [car for-loop]] [def loop-start [cadr for-loop]] [def loop-stop [caddr for-loop]] [def stop-var [gensym]] [def dir 1] [when [cadddr for-loop] [set! dir [cadddr for-loop]]] [when-not [symbol? symbol-name] [throw [list :invalid-for "Expected a symbol name within the for loop" symbol-name]]] [when-not loop-start [throw [list :invalid-for "Expected a start value at the second position" for-loop]]] [when-not loop-stop [throw [list :invalid-for "Expected a stop value at the third position" for-loop]]] [def pred [if [> dir 0] < >]] [quasiquote [let [[[unquote symbol-name] [unquote loop-start]] [[unquote stop-var] [unquote loop-stop]]] [while [[unquote pred] [unquote symbol-name] [unquote stop-var]] [unquote-splicing body] [set! [unquote symbol-name] [add/int [unquote dir] [unquote symbol-name]]]]]]]] v #{
10s for-loop
11
0Es symbol-name
0D
10s for-loop
12
11
0Es loop-start
0D
10s for-loop
08i 1 v caddr
0Es loop-stop
0D
08i 0 v gensym
0Es stop-var
0D
02i 1
0Es dir
0D
10s for-loop
08i 1 v cadddr
0Bo 19
10s for-loop
08i 1 v cadddr
0Fs dir
09o 4
24
0D
10s symbol-name
08i 1 v symbol?
0Bo 7
24
09o 25
05v :invalid-for
05v "Expected a symbol name within the for loop"
10s symbol-name
08i 3 v list
08i 1 v throw
0D
10s loop-start
0Bo 7
24
09o 25
05v :invalid-for
05v "Expected a start value at the second position"
10s for-loop
08i 3 v list
08i 1 v throw
0D
10s loop-stop
0Bo 7
24
09o 25
05v :invalid-for
05v "Expected a stop value at the third position"
10s for-loop
08i 3 v list
08i 1 v throw
0D
10s dir
02i 0
22
0Bo 10
10s <
09o 7
10s >
0Es pred
0D
23s let
10s symbol-name
10s loop-start
24
14
14
10s stop-var
10s loop-stop
24
14
14
24
14
14
23s while
10s pred
10s symbol-name
10s stop-var
24
14
14
14
10s body
23s set!
10s symbol-name
23s add/int
10s dir
10s symbol-name
24
14
14
14
24
14
14
14
24
14
08i 2 v append
14
14
24
14
14
14
01
}
0Es for
0D
26v for-in v [for-loop . body] v #@[documentation: "[for-in [l [list 1 2 3 4]] [println l]]" source: ["[for-in [l [list 1 2 3 4]] [println l]]" [def symbol-name [gensym]] [quasiquote [let [[[unquote symbol-name] [unquote [cadr for-loop]]]] [when [unquote symbol-name] [while [unquote symbol-name] [def [unquote [car for-loop]] [car [unquote symbol-name]]] [unquote-splicing body] [cdr! [unquote symbol-name]]]]]]]] v #{
08i 0 v gensym
0Es symbol-name
0D
23s let
10s symbol-name
10s for-loop
12
11
24
14
14
24
14
23s when
10s symbol-name
23s while
10s symbol-name
23s def
10s for-loop
11
23s car
10s symbol-name
24
14
14
24
14
14
14
10s body
23s cdr!
10s symbol-name
24
14
14
24
14
08i 2 v append
14
14
14
24
14
14
14
24
14
14
14
01
}
0Es for-in
0D
25v thread/-> v [init fun] v #@[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]]]]]]] v #{
10s fun
0Bo 80
10s fun
11
08i 1 v pair?
0Bo 40
10s fun
11
11
10s init
10s fun
12
08i 2 v thread/->
10s fun
11
12
24
08i 2 v append
14
14
09o 27
10s fun
11
10s init
10s fun
12
08i 2 v thread/->
08i 2 v list
09o 7
10s init
01
}
0Es thread/->
0D
26v -> v [init . fun] v #@[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]]]] v #{
10s init
10s fun
08i 1 v reverse
08i 2 v thread/->
01
}
0Es ->
0D
25v thread/->> v [init fun] v #@[source: [[if-not fun init [append [car fun] [cons [thread/->> init [cdr fun]] #nil]]]]] v #{
10s fun
0Bo 32
10s fun
11
10s init
10s fun
12
08i 2 v thread/->>
24
14
08i 2 v append
09o 7
10s init
01
}
0Es thread/->>
0D
26v ->> v [init . fun] v #@[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]]]] v #{
10s init
10s fun
08i 1 v reverse
08i 2 v thread/->>
01
}
0Es ->>
01
}#{
25v numeric? v [a] v #@[documentation: "Return #t if a is a number" source: ["Return #t if a is a number" [or [int? a] [float? a] [vec? a]]]] v #{
10s a
08i 1 v int?
0C
0Ao 36
0D
10s a
08i 1 v float?
0C
0Ao 22
0D
10s a
08i 1 v vec?
0C
0Ao 8
0D
05v #f
01
}
0Es numeric?
0D
25v last? v [a] v #@[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] v #{
10s a
12
08i 1 v nil?
01
}
0Es last?
0D
25v pos? v [a] v #@[documentation: "Return #t if a is positive" source: [:inline "Return #t if a is positive" [>= a 0.0]] inline: #t] v #{
10s a
05v 0.0
21
01
}
0Es pos?
0D
25v zero-neg? v [a] v #@[documentation: "Return #t if a is zero or negative" source: [:inline "Return #t if a is zero or negative" [<= a 0.0]] inline: #t] v #{
10s a
05v 0.0
1F
01
}
0Es zero-neg?
0D
25v neg? v [a] v #@[documentation: "Returns #t if a is negative" source: [:inline "Returns #t if a is negative" [< a 0.0]] inline: #t] v #{
10s a
05v 0.0
1E
01
}
0Es neg?
0D
25v odd? v [a] v #@[documentation: "Predicate that returns #t if a is odd" source: ["Predicate that returns #t if a is odd" [== [% [int a] 2] 1]]] v #{
10s a
08i 1 v int
02i 2
08i 2 v %
02i 1
20
01
}
0Es odd?
0D
25v even? v [a] v #@[documentation: "Predicate that returns #t if a is even" source: ["Predicate that returns #t if a is even" [== [mod/int [int a] 2] 0]]] v #{
10s a
08i 1 v int
02i 2
08i 2 v mod/int
02i 0
20
01
}
0Es even?
0D
25v zero? v [val] v #@[documentation: "#t if VAL is zero" source: [:inline "#t if VAL is zero" [== 0 val]] inline: #t] v #{
02i 0
10s val
20
01
}
0Es zero?
0D
25v not-zero? v [val] v #@[documentation: "#t if VAL is not zero" source: [:inline "#t if VAL is not zero" [!= 0 val]] inline: #t] v #{
02i 0
10s val
08i 2 v !=
01
}
0Es not-zero?
0D
25v equal? v [a b] v #@[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 [!= 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]]]]]] v #{
10s a
08i 1 v type-of
0Es cur-type
0D
10s cur-type
10s b
08i 1 v type-of
08i 2 v !=
0Bo 10
05v #f
09o 107
15
10s cur-type
0Es ΓεnΣym-121
0D
10s ΓεnΣym-121
05v :array
20
0Bo 19
10s a
10s b
08i 2 v array/equal?
09o 68
10s ΓεnΣym-121
05v :tree
20
0Bo 19
10s a
10s b
08i 2 v tree/equal?
09o 40
10s ΓεnΣym-121
05v :pair
20
0Bo 19
10s a
10s b
08i 2 v list/equal?
09o 12
10s a
10s b
20
16
01
}
0Es equal?
0D
25v inequal? v [a b] v #@[documentation: "High level inequality comparator" source: ["High level inequality comparator" [not [equal? a b]]]] v #{
10s a
10s b
08i 2 v equal?
0Bo 10
05v #f
09o 7
05v #t
01
}
0Es inequal?
0D
25v int? v [val] v #@[documentation: "#t if VAL is a integer" source: ["#t if VAL is a integer" [== :int [type-of val]]]] v #{
05v :int
10s val
08i 1 v type-of
20
01
}
0Es int?
0D
25v float? v [val] v #@[documentation: "#t if VAL is a floating-point number" source: ["#t if VAL is a floating-point number" [== :float [type-of val]]]] v #{
05v :float
10s val
08i 1 v type-of
20
01
}
0Es float?
0D
25v vec? v [val] v #@[documentation: "#t if VAL is a vector" source: ["#t if VAL is a vector" [== :vec [type-of val]]]] v #{
05v :vec
10s val
08i 1 v type-of
20
01
}
0Es vec?
0D
25v bool? v [val] v #@[documentation: "#t if VAL is a boolean" source: ["#t if VAL is a boolean" [== :bool [type-of val]]]] v #{
05v :bool
10s val
08i 1 v type-of
20
01
}
0Es bool?
0D
25v pair? v [val] v #@[documentation: "#t if VAL is a pair" source: ["#t if VAL is a pair" [== :pair [type-of val]]]] v #{
05v :pair
10s val
08i 1 v type-of
20
01
}
0Es pair?
0D
25v array? v [val] v #@[documentation: "#t if VAL is an array" source: ["#t if VAL is an array" [== :array [type-of val]]]] v #{
05v :array
10s val
08i 1 v type-of
20
01
}
0Es array?
0D
25v string? v [val] v #@[documentation: "#t if VAL is a string" source: ["#t if VAL is a string" [== :string [type-of val]]]] v #{
05v :string
10s val
08i 1 v type-of
20
01
}
0Es string?
0D
25v symbol? v [val] v #@[documentation: "#t if VAL is a symbol" source: ["#t if VAL is a symbol" [== :symbol [type-of val]]]] v #{
05v :symbol
10s val
08i 1 v type-of
20
01
}
0Es symbol?
0D
25v object? v [val] v #@[documentation: "#t if VAL is an object" source: ["#t if VAL is an object" [== :object [type-of val]]]] v #{
05v :object
10s val
08i 1 v type-of
20
01
}
0Es object?
0D
25v tree? v [val] v #@[documentation: "#t if VAL is an object" source: ["#t if VAL is an object" [== :tree [type-of val]]]] v #{
05v :tree
10s val
08i 1 v type-of
20
01
}
0Es tree?
0D
25v macro? v [val] v #@[documentation: "#t if VAL is an object" source: ["#t if VAL is an object" [== :macro [type-of val]]]] v #{
05v :macro
10s val
08i 1 v type-of
20
01
}
0Es macro?
0D
25v lambda? v [val] v #@[documentation: "#t if VAL is a lambda" source: ["#t if VAL is a lambda" [or [== :lambda [type-of val]]]]] v #{
05v :lambda
10s val
08i 1 v type-of
20
0C
0Ao 8
0D
05v #f
01
}
0Es lambda?
0D
25v native? v [val] v #@[documentation: "#t if VAL is a native function" source: ["#t if VAL is a native function" [== :native-function [type-of val]]]] v #{
05v :native-function
10s val
08i 1 v type-of
20
01
}
0Es native?
0D
25v procedure? v [val] v #@[documentation: "#t if VAL is a native or lisp function" source: ["#t if VAL is a native or lisp function" [or [lambda? val] [native? val]]]] v #{
10s val
08i 1 v lambda?
0C
0Ao 22
0D
10s val
08i 1 v native?
0C
0Ao 8
0D
05v #f
01
}
0Es procedure?
0D
25v bytecode-array? v [v] v #@[source: [[== :bytecode-array [type-of v]]]] v #{
05v :bytecode-array
10s v
08i 1 v type-of
20
01
}
0Es bytecode-array?
0D
25v bytecode-op? v [v] v #@[source: [[== :bytecode-op [type-of v]]]] v #{
05v :bytecode-op
10s v
08i 1 v type-of
20
01
}
0Es bytecode-op?
0D
25v in-range? v [v min max] v #@[source: [[and [>= v min] [<= v max]]]] v #{
10s v
10s min
21
0C
0Bo 13
0D
10s v
10s max
1F
01
}
0Es in-range?
01
}#{
25v quasiquote-real v [l depth] v #@[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]] l]]]]] v #{
10s l
08i 1 v nil?
0Bo 7
24
09o 346
10s l
08i 1 v pair?
0Bo 289
10s l
11
11
23s unquote-splicing
20
0Bo 80
02i 0
10s depth
20
0Bo 36
23s append
10s l
11
12
11
10s l
12
10s depth
08i 2 v quasiquote-real
08i 3 v list
09o 34
23s unquote-splicing
10s l
12
11
02i -1
10s depth
08i 2 v +
08i 2 v quasiquote-real
08i 2 v list
09o 195
10s l
11
23s unquote
20
0Bo 56
02i 0
10s depth
20
0Bo 12
10s l
12
11
09o 34
23s unquote
10s l
12
11
02i -1
10s depth
08i 2 v +
08i 2 v quasiquote-real
08i 2 v list
09o 129
10s l
11
23s quasiquote
20
0Bo 37
10s l
12
11
02i 1
10s depth
08i 2 v +
08i 2 v quasiquote-real
10s depth
08i 2 v quasiquote-real
09o 82
02i 0
10s depth
20
0Bo 43
23s cons
10s l
11
10s depth
08i 2 v quasiquote-real
10s l
12
10s depth
08i 2 v quasiquote-real
08i 3 v list
09o 32
10s l
11
10s depth
08i 2 v quasiquote-real
10s l
12
10s depth
08i 2 v quasiquote-real
14
09o 48
02i 0
10s depth
20
0C
0Bo 13
0D
10s l
08i 1 v symbol?
0Bo 20
23s quote
10s l
08i 1 v cons
14
09o 7
10s l
01
}
0Es quasiquote-real
0D
26v quasiquote v [l] v #@[source: [[quasiquote-real l 0]]] v #{
10s l
02i 0
08i 2 v quasiquote-real
01
}
0Es quasiquote
0D
25v unquote v [expr] v #@[source: [[throw [list :unquote-without-quasiquote "unquote should only occur inside a quasiquote, never evaluated directly"]]]] v #{
05v :unquote-without-quasiquote
05v "unquote should only occur inside a quasiquote, never evaluated directly"
08i 2 v list
08i 1 v throw
01
}
0Es unquote
0D
25v unquote-splicing v [expr] v #@[source: [[throw [list :unquote-splicing-without-quasiq "unquote-splicing should only occur inside a quasiquote, never evaluated directly"]]]] v #{
05v :unquote-splicing-without-quasiq
05v "unquote-splicing should only occur inside a quasiquote, never evaluated directly"
08i 2 v list
08i 1 v throw
01
}
0Es unquote-splicing
01
}#{
25v describe/closure v [c i] v #@[source: [[when c [if [== c root-closure] [cat [ansi-blue [cat [int [or i 0]] "# <root environment>"]] "\r\n"] [do [def info [closure c]] [when info [def data [ref info :data]] [def l [length data]] [cat [ansi-blue [cat [int [or i 0]] "# " [str/write c]]] " - " [if [< l 16] [str/write data] "-+- Very big tree structure -+-"] "\r\n" [describe/closure [closure/caller c] [+ [int [or i 0]] 1]]]]]]]]] v #{
10s c
0Bo 259
10s c
10s root-closure
20
0Bo 54
10s i
0C
0Ao 15
0D
02i 0
0C
0Ao 8
0D
05v #f
08i 1 v int
05v "# <root environment>"
08i 2 v cat
08i 1 v ansi-blue
05v "\r\n"
08i 2 v cat
09o 193
10s c
08i 1 v closure
0Es info
0D
10s info
0Bo 171
10s info
05v :data
08i 2 v ref
0Es data
0D
10s data
08i 1 v length
0Es l
0D
10s i
0C
0Ao 15
0D
02i 0
0C
0Ao 8
0D
05v #f
08i 1 v int
05v "# "
10s c
08i 1 v str/write
08i 3 v cat
08i 1 v ansi-blue
05v " - "
10s l
02i 16
1E
0Bo 15
10s data
08i 1 v str/write
09o 7
05v "-+- Very big tree structure -+-"
05v "\r\n"
10s c
08i 1 v closure/caller
10s i
0C
0Ao 15
0D
02i 0
0C
0Ao 8
0D
05v #f
08i 1 v int
02i 1
08i 2 v +
08i 2 v describe/closure
08i 5 v cat
09o 4
24
09o 4
24
01
}
0Es describe/closure
0D
25v stacktrace v [] v #@[source: [[display [describe/closure [closure/caller [current-lambda]]]]]] v #{
08i 0 v current-lambda
08i 1 v closure/caller
08i 1 v describe/closure
08i 1 v print
01
}
0Es stacktrace
01
}#{
25v time/seconds v [timestamp] v #@[documentation: "Return the seconds part of TIMESTAMP, defaults to current time" source: ["Return the seconds part of TIMESTAMP, defaults to current time" [% [default timestamp [time]] 60]]] v #{
10s timestamp
08i 0 v time
08i 2 v default
02i 60
08i 2 v %
01
}
0Es time/seconds
0D
25v time/minutes v [timestamp] v #@[documentation: "Return the minutes part of TIMESTAMP, defaults to current time" source: ["Return the minutes part of TIMESTAMP, defaults to current time" [% [/ [default timestamp [time]] 60] 60]]] v #{
10s timestamp
08i 0 v time
08i 2 v default
02i 60
08i 2 v /
02i 60
08i 2 v %
01
}
0Es time/minutes
0D
25v time/hours v [timestamp] v #@[documentation: "Return the hours part of TIMESTAMP, defaults to current time" source: ["Return the hours part of TIMESTAMP, defaults to current time" [% [/ [default timestamp [time]] 3600] 24]]] v #{
10s timestamp
08i 0 v time
08i 2 v default
05v 3600
08i 2 v /
02i 24
08i 2 v %
01
}
0Es time/hours
0D
25v profile-form v [raw] v #@[source: [[def start-time [time/milliseconds]] [def val [eval raw]] [def end-time [time/milliseconds]] [display [cat "Evaluating " [ansi-yellow [str/write raw]] " to " [ansi-green [str/write val]] " took " [ansi-red [cat [- end-time start-time] "ms"] "\n"]]]]] v #{
08i 0 v time/milliseconds
0Es start-time
0D
08i 0 v current-closure
10s raw
08i 2 v eval-in
0Es val
0D
08i 0 v time/milliseconds
0Es end-time
0D
05v "Evaluating "
10s raw
08i 1 v str/write
08i 1 v ansi-yellow
05v " to "
10s val
08i 1 v str/write
08i 1 v ansi-green
05v " took "
10s end-time
10s start-time
08i 2 v -
05v "ms"
08i 2 v cat
05v "\n"
08i 2 v ansi-red
08i 6 v cat
08i 1 v print
01
}
0Es profile-form
0D
26v profile v body v #@[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]]]]]]] v #{
23s profile-form
23s quote
10s body
12
08i 1 v nil?
0Bo 11
10s body
11
09o 12
23s do
10s body
14
24
14
14
24
14
14
01
}
0Es profile
01
}#{
25v hash/adler32 v [data] v #@[source: [[def a 1] [def b 0] [for [i 0 [string/length data]] [set! a [mod/int [add/int a [char-at data i]] 65521]] [set! b [mod/int [add/int a b] 65521]]] [logior a [ash b 16]]]] v #{
02i 1
0Es a
0D
02i 0
0Es b
0D
15
02i 0
0Es i
0D
10s data
08i 1 v string/length
0Es ΓεnΣym-123
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-123
1E
0Bo 73
0D
10s a
10s data
10s i
08i 2 v char-at
03
05v 65521
08i 2 v mod/int
0Fs a
0D
10s a
10s b
03
05v 65521
08i 2 v mod/int
0Fs b
0D
02i 1
10s i
03
0Fs i
09o -80
16
0D
10s a
10s b
02i 16
08i 2 v ash
08i 2 v logior
01
}
0Es hash/adler32
01
}#{
05v 3.14159
0Es PI
0D
05v 3.14159
0Es π
0D
26v ++ v [i] v #@[documentation: "Increment I by 1 and store the result in I" source: ["Increment I by 1 and store the result in I" [quasiquote [set! [unquote i] [+ 1 [unquote i]]]]]] v #{
23s set!
10s i
23s +
02i 1
10s i
24
14
14
14
24
14
14
14
01
}
0Es ++
0D
26v -- v [i] v #@[documentation: "Decrement I by 1 and store the result in I" source: ["Decrement I by 1 and store the result in I" [quasiquote [set! [unquote i] [+ -1 [unquote i]]]]]] v #{
23s set!
10s i
23s +
02i -1
10s i
24
14
14
14
24
14
14
14
01
}
0Es --
0D
25v +x v [α] v #@[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 [β] [+ α β]]]] v #{
25v 'anonymous v [β] v #@[source: [[+ α β]]] v #{
10s α
10s β
08i 2 v +
01
}
01
}
0Es +x
0D
25v >> v [val amount] v #@[documentation: "Shifts VAL by AMOUNT bits to the right" source: ["Shifts VAL by AMOUNT bits to the right" [ash val [- amount]]]] v #{
10s val
10s amount
08i 1 v -
08i 2 v ash
01
}
0Es >>
0D
25v fib v [i] v #@[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]]]]]] v #{
10s i
02i 2
1E
0Bo 10
10s i
09o 40
10s i
02i 2
08i 2 v -
08i 1 v fib
10s i
02i 1
08i 2 v -
08i 1 v fib
08i 2 v +
01
}
0Es fib
0D
25v wrap-value v [val min max] v #@[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 [% [- val min] [- max min]]]]] v #{
10s min
10s val
10s min
08i 2 v -
10s max
10s min
08i 2 v -
08i 2 v %
08i 2 v +
01
}
0Es wrap-value
0D
26v +1 v [v] v #@[source: [[quasiquote [+ 1 [unquote v]]]]] v #{
23s +
02i 1
10s v
24
14
14
14
01
}
0Es +1
0D
25v radians v [degrees] v #@[documentation: "Convert a quantity in degrees to radians" source: ["Convert a quantity in degrees to radians" [/ [* π degrees] 180.0]]] v #{
10s π
10s degrees
08i 2 v *
05v 180.0
08i 2 v /
01
}
0Es radians
01
}#{
25v display/error/wrap v [i text] v #@[source: [[case i [0 [ansi-red text]] [1 [string text]] [2 [ansi-yellow [str/write text]]] [3 [describe/closure text]] [otherwise text]]]] v #{
15
10s i
0Es ΓεnΣym-125
0D
10s ΓεnΣym-125
02i 0
20
0Bo 15
10s text
08i 1 v ansi-red
09o 78
10s ΓεnΣym-125
02i 1
20
0Bo 15
10s text
08i 1 v string
09o 56
10s ΓεnΣym-125
02i 2
20
0Bo 20
10s text
08i 1 v str/write
08i 1 v ansi-yellow
09o 29
10s ΓεnΣym-125
02i 3
20
0Bo 15
10s text
08i 1 v describe/closure
09o 7
10s text
16
01
}
0Es display/error/wrap
0D
25v display/error/iter v [error i] v #@[source: [[if error [cons [display/error/wrap i [car error]] [display/error/iter [cdr error] [+ 1 i]]] [cons "" #nil]]]] v #{
10s error
0Bo 42
10s i
10s error
11
08i 2 v display/error/wrap
10s error
12
02i 1
10s i
08i 2 v +
08i 2 v display/error/iter
14
09o 9
05v ""
24
14
01
}
0Es display/error/iter
0D
25v display/error v [error] v #@[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"]]]] v #{
10s error
02i 0
08i 2 v display/error/iter
05v "\r\n"
08i 2 v join
08i 1 v print
01
}
0Es display/error
0D
25v closure/arguments v [o] v #@[source: [[ref [closure o] :arguments]]] v #{
10s o
08i 1 v closure
05v :arguments
08i 2 v ref
01
}
0Es closure/arguments
0D
25v closure/documentation v [o] v #@[source: [[closure/meta o :documentation]]] v #{
10s o
05v :documentation
08i 2 v closure/meta
01
}
0Es closure/documentation
0D
25v describe/thing v [o] v #@[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}"]]] v #{
10s o
08i 1 v closure/documentation
0Es documentation
0D
10s o
08i 1 v closure/arguments
0Es arguments
0D
10s arguments
08i 1 v str/write
05v " - "
10s documentation
08i 3 v cat
01
}
0Es describe/thing
0D
25v describe/string v [a] v #@[documentation: "Descibe whatever value string A resolves to" source: ["Descibe whatever value string A resolves to" [describe/thing [resolve [str->sym a]]]]] v #{
10s a
08i 1 v str->sym
08i 1 v resolve
08i 1 v describe/thing
01
}
0Es describe/string
0D
25v describe v [fun] v #@[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]]]] v #{
10s fun
08i 1 v string?
0Bo 15
10s fun
08i 1 v describe/string
09o 12
10s fun
08i 1 v describe/thing
01
}
0Es describe
0D
25v symbol-table v [off len environment] v #@[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]]] v #{
10s environment
0Bo 7
24
09o 11
10s root-closure
0Fs environment
0D
10s off
0Bo 7
24
09o 9
02i 0
0Fs off
0D
10s len
0Bo 7
24
09o 11
05v 9999999
0Fs len
0D
10s environment
05v [symbol-table*]
08i 2 v eval-in
10s off
10s off
10s len
08i 2 v +
24
08i 4 v sublist
01
}
0Es symbol-table
0D
02i 0
0Es gensym/counter
0D
25v gensym v [prefix] v #@[source: [[++ gensym/counter] [str->sym [cat prefix "ΓεnΣym-" gensym/counter]]]] v #{
02i 1
10s gensym/counter
08i 2 v +
0Fs gensym/counter
0D
10s prefix
05v "ΓεnΣym-"
10s gensym/counter
08i 3 v cat
08i 1 v str->sym
01
}
0Es gensym
0D
08i 0 v current-closure
0Es root-closure
01
}#{
02i 0
0Es random/seed
0D
25v random/seed-initialize! v [] v #@[source: [[set! random/seed [logxor [time] [time/milliseconds]]]]] v #{
08i 0 v time
08i 0 v time/milliseconds
08i 2 v logxor
0Fs random/seed
01
}
0Es random/seed-initialize!
0D
25v random/rng! v [] v #@[source: [[set! random/seed [+ 12345 [* random/seed 1103515245]]] [logior [ash [logand random/seed 65535] 16] [logand [ash random/seed -16] 65535]]]] v #{
05v 12345
10s random/seed
05v 1103515245
08i 2 v *
08i 2 v +
0Fs random/seed
0D
10s random/seed
05v 65535
08i 2 v logand
02i 16
08i 2 v ash
10s random/seed
02i -16
08i 2 v ash
05v 65535
08i 2 v logand
08i 2 v logior
01
}
0Es random/rng!
0D
25v random/seed! v [new-seed] v #@[documentation: "Set a new seed value for the RNG" source: ["Set a new seed value for the RNG" [set! seed new-seed]]] v #{
10s new-seed
0Fs seed
01
}
0Es random/seed!
0D
25v random/seed v [] v #@[documentation: "Return the current RNG seed value" source: ["Return the current RNG seed value" seed]] v #{
10s seed
01
}
0Es random/seed
0D
25v random v [max] v #@[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] [% [abs [random/rng!]] max] [random/rng!]]]] v #{
10s max
08i 1 v numeric?
0Bo 25
08i 0 v random/rng!
08i 1 v abs
10s max
08i 2 v %
09o 8
08i 0 v random/rng!
01
}
0Es random
0D
08i 0 v random/seed-initialize!
01
}#{
25v tree->json v [v] v #@[documentation: "Converts a tree into a JSON encoded string, you should prefer VAL->JSON" source: ["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"] "}"]]] v #{
05v "{"
10s v
08i 1 v tree/keys
25v 'anonymous v [k] v #@[source: [[cat "\"" [keyword->string k] "\": " [val->json [tree/ref v k]]]]] v #{
05v "\""
10s k
08i 1 v keyword->string
05v "\": "
10s v
10s k
08i 2 v tree/ref
08i 1 v val->json
08i 4 v cat
01
}
08i 2 v map
05v ",\n"
08i 2 v join
05v "}"
08i 3 v cat
01
}
0Es tree->json
0D
25v val->json v [v] v #@[documentation: "Return V as a JSON encoded string" source: ["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 [str/write v]] [:symbol [cat "\"" [sym->str 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]]]]]]] v #{
15
10s v
08i 1 v type-of
0Es ΓεnΣym-127
0D
10s ΓεnΣym-127
05v :nil
20
0Bo 10
05v "null"
09o 305
10s ΓεnΣym-127
05v :int
20
0C
0Ao 22
0D
10s ΓεnΣym-127
05v :float
20
0C
0Ao 8
0D
05v #f
0Bo 15
10s v
08i 1 v string
09o 258
10s ΓεnΣym-127
05v :bool
20
0Bo 24
10s v
0Bo 10
05v "true"
09o 7
05v "false"
09o 225
10s ΓεnΣym-127
05v :array
20
0C
0Ao 22
0D
10s ΓεnΣym-127
05v :pair
20
0C
0Ao 8
0D
05v #f
0Bo 41
05v "["
10s v
10s val->json
08i 2 v map
05v ","
08i 2 v join
05v "]"
08i 3 v cat
09o 152
10s ΓεnΣym-127
05v :string
20
0Bo 15
10s v
08i 1 v str/write
09o 128
10s ΓεnΣym-127
05v :symbol
20
0Bo 28
05v "\""
10s v
08i 1 v sym->str
05v "\""
08i 3 v cat
09o 91
10s ΓεnΣym-127
05v :keyword
20
0Bo 28
05v "\""
10s v
08i 1 v keyword->string
05v "\""
08i 3 v cat
09o 54
10s ΓεnΣym-127
05v :tree
20
0Bo 15
10s v
08i 1 v tree->json
09o 30
05v :type-error
05v "Can't encode the value into JSON"
10s v
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es val->json
01
}#{
05v #f
0Es ansi/disabled
0D
05v "\e[0m"
0Es ansi-reset
0D
05v "\e[0;39m"
0Es ansi-fg-reset
0D
05v "\e[49m"
0Es ansi-bg-reset
0D
05v "\e[0;30m"
05v "\e[0;31m"
05v "\e[0;32m"
05v "\e[0;33m"
05v "\e[0;34m"
05v "\e[0;35m"
05v "\e[0;36m"
05v "\e[0;37m"
05v "\e[1;30m"
05v "\e[1;31m"
05v "\e[1;32m"
05v "\e[1;33m"
05v "\e[1;34m"
05v "\e[1;35m"
05v "\e[1;36m"
05v "\e[1;37m"
08i 16 v array/new
0Es ansi-fg
0D
05v "\e[0m"
0Es ansi-reset
0D
05v "\e[40m"
05v "\e[41m"
05v "\e[42m"
05v "\e[43m"
05v "\e[44m"
05v "\e[45m"
05v "\e[46m"
05v "\e[47m"
08i 8 v array/new
0Es ansi-bg
0D
25v ansi-wrap v [code string] v #@[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]]]] v #{
10s ansi/disabled
0C
0Ao 26
0D
10s ansi-fg
10s code
08i 2 v array/ref
0C
0Ao 8
0D
05v #f
10s string
10s ansi/disabled
0C
0Ao 17
0D
10s ansi-reset
0C
0Ao 8
0D
05v #f
08i 3 v cat
01
}
0Es ansi-wrap
0D
25v ansi-black v args v #@[documentation: "Wrap ARGS in black" source: ["Wrap ARGS in black" [ansi-wrap 0 [apply cat args]]]] v #{
02i 0
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-black
0D
25v ansi-dark-red v args v #@[documentation: "Wrap ARGS in dark red" source: ["Wrap ARGS in dark red" [ansi-wrap 1 [apply cat args]]]] v #{
02i 1
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-dark-red
0D
25v ansi-dark-green v args v #@[documentation: "Wrap ARGS in dark green" source: ["Wrap ARGS in dark green" [ansi-wrap 2 [apply cat args]]]] v #{
02i 2
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-dark-green
0D
25v ansi-brown v args v #@[documentation: "Wrap ARGS in brown" source: ["Wrap ARGS in brown" [ansi-wrap 3 [apply cat args]]]] v #{
02i 3
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-brown
0D
25v ansi-dark-blue v args v #@[documentation: "Wrap ARGS in dark blue" source: ["Wrap ARGS in dark blue" [ansi-wrap 4 [apply cat args]]]] v #{
02i 4
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-dark-blue
0D
25v ansi-purple v args v #@[documentation: "Wrap ARGS in purple" source: ["Wrap ARGS in purple" [ansi-wrap 5 [apply cat args]]]] v #{
02i 5
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-purple
0D
25v ansi-teal v args v #@[documentation: "Wrap ARGS in teal" source: ["Wrap ARGS in teal" [ansi-wrap 6 [apply cat args]]]] v #{
02i 6
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-teal
0D
25v ansi-dark-gray v args v #@[documentation: "Wrap ARGS in dark gray" source: ["Wrap ARGS in dark gray" [ansi-wrap 7 [apply cat args]]]] v #{
02i 7
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-dark-gray
0D
25v ansi-gray v args v #@[documentation: "Wrap ARGS in gray" source: ["Wrap ARGS in gray" [ansi-wrap 8 [apply cat args]]]] v #{
02i 8
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-gray
0D
25v ansi-red v args v #@[documentation: "Wrap ARGS in red" source: ["Wrap ARGS in red" [ansi-wrap 9 [apply cat args]]]] v #{
02i 9
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-red
0D
25v ansi-green v args v #@[documentation: "Wrap ARGS in green" source: ["Wrap ARGS in green" [ansi-wrap 10 [apply cat args]]]] v #{
02i 10
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-green
0D
25v ansi-yellow v args v #@[documentation: "Wrap ARGS in yellow" source: ["Wrap ARGS in yellow" [ansi-wrap 11 [apply cat args]]]] v #{
02i 11
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-yellow
0D
25v ansi-blue v args v #@[documentation: "Wrap ARGS in blue" source: ["Wrap ARGS in blue" [ansi-wrap 12 [apply cat args]]]] v #{
02i 12
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-blue
0D
25v ansi-pink v args v #@[documentation: "Wrap ARGS in pink" source: ["Wrap ARGS in pink" [ansi-wrap 13 [apply cat args]]]] v #{
02i 13
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-pink
0D
25v ansi-cyan v args v #@[documentation: "Wrap ARGS in cyan" source: ["Wrap ARGS in cyan" [ansi-wrap 14 [apply cat args]]]] v #{
02i 14
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-cyan
0D
25v ansi-white v args v #@[documentation: "Wrap ARGS in white" source: ["Wrap ARGS in white" [ansi-wrap 15 [apply cat args]]]] v #{
02i 15
10s cat
10s args
08i 2 v apply
08i 2 v ansi-wrap
01
}
0Es ansi-white
0D
25v ansi-rainbow v args v #@[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 [logand [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [if [zero? count] 7 [+ count 8]]]] a]]] ""] [or ansi/disabled ansi-fg-reset]]]]] v #{
15
02i 0
0Es count
0D
10s cat
10s args
08i 2 v apply
05v ""
08i 2 v split
25v 'anonymous v [a] v #@[source: [[set! count [logand [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [if [zero? count] 7 [+ count 8]]]] a]]] v #{
02i 1
10s count
08i 2 v +
02i 7
08i 2 v logand
0Fs count
0D
10s ansi/disabled
0C
0Ao 48
0D
10s ansi-fg
02i 0
10s count
20
0Bo 8
02i 7
09o 14
10s count
02i 8
08i 2 v +
08i 2 v array/ref
0C
0Ao 8
0D
05v #f
10s a
08i 2 v cat
01
}
08i 2 v map
05v ""
08i 2 v join
10s ansi/disabled
0C
0Ao 17
0D
10s ansi-fg-reset
0C
0Ao 8
0D
05v #f
08i 2 v cat
16
01
}
0Es ansi-rainbow
0D
25v ansi-rainbow-bg v args v #@[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 [logand [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [logxor count 7]]] [or ansi/disabled [array/ref ansi-bg count]] a]]]] [cat [join colored-list ""] [or ansi/disabled ansi-reset]]]] v #{
02i 0
0Es count
0D
10s cat
10s args
08i 2 v apply
05v ""
08i 2 v split
25v 'anonymous v [a] v #@[source: [[set! count [logand [+ 1 count] 7]] [cat [or ansi/disabled [array/ref ansi-fg [logxor count 7]]] [or ansi/disabled [array/ref ansi-bg count]] a]]] v #{
02i 1
10s count
08i 2 v +
02i 7
08i 2 v logand
0Fs count
0D
10s ansi/disabled
0C
0Ao 33
0D
10s ansi-fg
10s count
02i 7
08i 2 v logxor
08i 2 v array/ref
0C
0Ao 8
0D
05v #f
10s ansi/disabled
0C
0Ao 26
0D
10s ansi-bg
10s count
08i 2 v array/ref
0C
0Ao 8
0D
05v #f
10s a
08i 3 v cat
01
}
08i 2 v map
0Es colored-list
0D
10s colored-list
05v ""
08i 2 v join
10s ansi/disabled
0C
0Ao 17
0D
10s ansi-reset
0C
0Ao 8
0D
05v #f
08i 2 v cat
01
}
0Es ansi-rainbow-bg
0D
25v reprint-line v [text width] v #@[source: [[when-not width [set! width 20]] [print "\r"] [for [i 0 width] [print " "]] [print "\r"] [print text]]] v #{
10s width
0Bo 7
24
09o 9
02i 20
0Fs width
0D
05v "\r"
08i 1 v print
0D
15
02i 0
0Es i
0D
10s width
0Es ΓεnΣym-129
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-129
1E
0Bo 28
0D
05v " "
08i 1 v print
0D
02i 1
10s i
03
0Fs i
09o -35
16
0D
05v "\r"
08i 1 v print
0D
10s text
08i 1 v print
01
}
0Es reprint-line
01
}#{
05v :align
05v :right
05v :debug
05v #f
05v :base
05v #f
05v :width
24
05v :padding-char
05v " "
08i 10 v tree/new
0Es fmt/format-arg/default
0D
25v fmt/find-non-digit-from-right v [s i] v #@[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]]]]] v #{
10s i
02i 0
1E
0Bo 8
02i -1
09o 70
10s s
10s i
08i 2 v char-at
0Es char
0D
10s char
02i 48
21
0C
0Bo 11
0D
10s char
02i 57
1F
0Bo 26
10s s
10s i
02i 1
08i 2 v -
08i 2 v fmt/find-non-digit-from-right
09o 7
10s i
01
}
0Es fmt/find-non-digit-from-right
0D
25v fmt/parse-spec v [opts spec] v #@[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]]]]]]]] v #{
02i 0
10s spec
08i 1 v string/length
20
0Bo 10
10s opts
09o 978
15
10s spec
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 2 v char-at
0Es ΓεnΣym-138
0D
10s ΓεnΣym-138
02i 48
20
0C
0Ao 116
0D
10s ΓεnΣym-138
02i 49
20
0C
0Ao 104
0D
10s ΓεnΣym-138
02i 50
20
0C
0Ao 92
0D
10s ΓεnΣym-138
02i 51
20
0C
0Ao 80
0D
10s ΓεnΣym-138
02i 52
20
0C
0Ao 68
0D
10s ΓεnΣym-138
02i 53
20
0C
0Ao 56
0D
10s ΓεnΣym-138
02i 54
20
0C
0Ao 44
0D
10s ΓεnΣym-138
02i 55
20
0C
0Ao 32
0D
10s ΓεnΣym-138
02i 56
20
0C
0Ao 20
0D
10s ΓεnΣym-138
02i 57
20
0C
0Ao 8
0D
05v #f
0Bo 163
10s spec
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 2 v fmt/find-non-digit-from-right
0Es next-non-digit
0D
10s spec
02i 1
10s next-non-digit
08i 2 v +
10s spec
08i 1 v string/length
08i 3 v string/cut
0Es number
0D
10s opts
05v :width
10s number
08i 1 v read/single
08i 3 v tree/set!
0D
02i 48
10s number
02i 0
08i 2 v char-at
20
0Bo 23
10s opts
05v :padding-char
05v "0"
08i 3 v tree/set!
09o 4
24
0D
10s opts
10s spec
02i 0
02i 1
10s next-non-digit
08i 2 v +
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 659
10s ΓεnΣym-138
02i 63
20
0Bo 55
10s opts
05v :debug
05v #t
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 597
10s ΓεnΣym-138
02i 88
20
0Bo 55
10s opts
05v :base
05v :HEXADECIMAL
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 535
10s ΓεnΣym-138
02i 120
20
0Bo 55
10s opts
05v :base
05v :hexadecimal
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 473
10s ΓεnΣym-138
02i 100
20
0Bo 55
10s opts
05v :base
05v :decimal
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 411
10s ΓεnΣym-138
02i 111
20
0Bo 55
10s opts
05v :base
05v :octal
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 349
10s ΓεnΣym-138
02i 98
20
0Bo 55
10s opts
05v :base
05v :binary
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 287
10s ΓεnΣym-138
02i 60
20
0Bo 55
10s opts
05v :align
05v :left
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 225
10s ΓεnΣym-138
02i 94
20
0Bo 55
10s opts
05v :align
05v :center
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 163
10s ΓεnΣym-138
02i 62
20
0Bo 55
10s opts
05v :align
05v :right
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 101
10s ΓεnΣym-138
02i 46
20
0Bo 64
10s opts
05v :precision
10s opts
05v :width
08i 2 v tree/ref
08i 3 v tree/set!
10s spec
02i 0
10s spec
08i 1 v string/length
02i 1
08i 2 v -
08i 3 v string/cut
08i 2 v fmt/parse-spec
09o 30
05v :format-error
05v "Unknown form-spec option"
10s spec
08i 0 v current-closure
08i 4 v list
08i 1 v throw
16
01
}
0Es fmt/parse-spec
0D
25v fmt/debug v [opts] v #@[source: [[if-not [tree/ref opts :debug] opts [tree/set! opts :argument [list str/write [tree/ref opts :argument]]]]]] v #{
10s opts
05v :debug
08i 2 v tree/ref
0Bo 41
10s opts
05v :argument
10s str/write
10s opts
05v :argument
08i 2 v tree/ref
08i 2 v list
08i 3 v tree/set!
09o 7
10s opts
01
}
0Es fmt/debug
0D
25v fmt/number-format v [opts] v #@[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]]]] v #{
15
10s opts
05v :base
08i 2 v tree/ref
0Es ΓεnΣym-139
0D
10s ΓεnΣym-139
05v :binary
20
0Bo 41
10s opts
05v :argument
10s int->string/binary
10s opts
05v :argument
08i 2 v tree/ref
08i 2 v list
08i 3 v tree/set!
09o 207
10s ΓεnΣym-139
05v :octal
20
0Bo 41
10s opts
05v :argument
10s int->string/octal
10s opts
05v :argument
08i 2 v tree/ref
08i 2 v list
08i 3 v tree/set!
09o 157
10s ΓεnΣym-139
05v :decimal
20
0Bo 41
10s opts
05v :argument
10s int->string/decimal
10s opts
05v :argument
08i 2 v tree/ref
08i 2 v list
08i 3 v tree/set!
09o 107
10s ΓεnΣym-139
05v :hexadecimal
20
0Bo 41
10s opts
05v :argument
10s int->string/hex
10s opts
05v :argument
08i 2 v tree/ref
08i 2 v list
08i 3 v tree/set!
09o 57
10s ΓεnΣym-139
05v :HEXADECIMAL
20
0Bo 41
10s opts
05v :argument
10s int->string/HEX
10s opts
05v :argument
08i 2 v tree/ref
08i 2 v list
08i 3 v tree/set!
09o 7
10s opts
16
01
}
0Es fmt/number-format
0D
05v :binary
05v "#b"
05v :octal
05v "#o"
05v :decimal
05v "#d"
05v :hexadecimal
05v "#x"
05v :HEXADECIMAL
05v "#x"
08i 10 v tree/new
0Es fmt/number-format-prefixex
0D
25v fmt/number-format-prefix v [opts] v #@[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]]]]] v #{
10s opts
05v :debug
08i 2 v tree/ref
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 40
0D
10s opts
05v :base
08i 2 v tree/ref
0Bo 10
05v #f
09o 7
05v #t
0C
0Ao 8
0D
05v #f
0Bo 10
10s opts
09o 105
05v [:binary :octal :decimal :hexadecimal :HEXADECIMAL]
10s opts
05v :base
08i 2 v tree/ref
08i 2 v member
0Bo 63
10s opts
05v :argument
10s cat
10s fmt/number-format-prefixex
10s opts
05v :base
08i 2 v tree/ref
08i 2 v tree/ref
10s opts
05v :argument
08i 2 v tree/ref
08i 3 v list
08i 3 v tree/set!
09o 7
10s opts
05v :debug
05v #f
08i 3 v tree/set!
01
}
0Es fmt/number-format-prefix
0D
25v fmt/add-padding v [opts] v #@[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]]]]]] v #{
10s opts
05v :width
08i 2 v tree/ref
0Bo 198
10s opts
05v :argument
15
10s opts
05v :align
08i 2 v tree/ref
0Es ΓεnΣym-140
0D
10s ΓεnΣym-140
05v :right
20
0Bo 10
10s string/pad-start
09o 42
10s ΓεnΣym-140
05v :center
20
0Bo 10
10s string/pad-middle
09o 23
10s ΓεnΣym-140
05v :left
20
0Bo 10
10s string/pad-end
09o 4
24
16
10s opts
05v :argument
08i 2 v tree/ref
10s opts
05v :debug
08i 2 v tree/ref
0C
0Bo 17
0D
10s opts
05v :base
08i 2 v tree/ref
0Bo 26
10s opts
05v :width
08i 2 v tree/ref
02i 2
08i 2 v -
09o 16
10s opts
05v :width
08i 2 v tree/ref
10s opts
05v :padding-char
08i 2 v tree/ref
08i 4 v list
08i 3 v tree/set!
09o 7
10s opts
01
}
0Es fmt/add-padding
0D
25v fmt/precision v [opts] v #@[source: [[if-not [tree/ref opts :precision] opts [tree/set! opts :argument [list string/round [tree/ref opts :argument] [tree/ref opts :precision]]]]]] v #{
10s opts
05v :precision
08i 2 v tree/ref
0Bo 54
10s opts
05v :argument
10s string/round
10s opts
05v :argument
08i 2 v tree/ref
10s opts
05v :precision
08i 2 v tree/ref
08i 3 v list
08i 3 v tree/set!
09o 7
10s opts
01
}
0Es fmt/precision
0D
25v fmt/truncate v [opts] v #@[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]]]]]]] v #{
10s opts
05v :width
08i 2 v tree/ref
0Bo 63
10s opts
05v :argument
10s string/cut
10s opts
05v :argument
08i 2 v tree/ref
02i 0
02i 1
10s opts
05v :width
08i 2 v tree/ref
08i 2 v +
08i 4 v list
08i 3 v tree/set!
09o 7
10s opts
01
}
0Es fmt/truncate
0D
25v fmt/output v [opts] v #@[source: [[tree/ref opts :argument]]] v #{
10s opts
05v :argument
08i 2 v tree/ref
01
}
0Es fmt/output
0D
25v fmt/format-arg v [spec argument] v #@[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]]] v #{
10s fmt/format-arg/default
08i 1 v tree/dup
10s spec
08i 2 v fmt/parse-spec
05v :argument
10s argument
08i 3 v tree/set!
08i 1 v fmt/number-format
08i 1 v fmt/precision
08i 1 v fmt/add-padding
08i 1 v fmt/truncate
08i 1 v fmt/number-format-prefix
08i 1 v fmt/debug
08i 1 v fmt/output
01
}
0Es fmt/format-arg
0D
25v fmt/valid-argument? v [argument] v #@[source: [[or [int? argument] [symbol? argument]]]] v #{
10s argument
08i 1 v int?
0C
0Ao 22
0D
10s argument
08i 1 v symbol?
0C
0Ao 8
0D
05v #f
01
}
0Es fmt/valid-argument?
0D
25v fmt/arg-sym v [v] v #@[source: [[case [type-of v] [:int [fmt/arg-sym [cat "fmt-arg-" [string v]]]] [:symbol v] [:string [str->sym v]] [otherwise [throw [list :type-error "Invalid fmt argument name" v [current-lambda]]]]]]] v #{
15
10s v
08i 1 v type-of
0Es ΓεnΣym-141
0D
10s ΓεnΣym-141
05v :int
20
0Bo 29
05v "fmt-arg-"
10s v
08i 1 v string
08i 2 v cat
08i 1 v fmt/arg-sym
09o 73
10s ΓεnΣym-141
05v :symbol
20
0Bo 10
10s v
09o 54
10s ΓεnΣym-141
05v :string
20
0Bo 15
10s v
08i 1 v str->sym
09o 30
05v :type-error
05v "Invalid fmt argument name"
10s v
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
16
01
}
0Es fmt/arg-sym
0D
25v fmt/expr v [expr arguments-used opts] v #@[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]]]]]]] v #{
10s expr
08i 1 v string?
0Bo 7
24
09o 30
05v :format-error
05v "fmt needs a string literal as a first argument, since it is implemented as a macro"
10s expr
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s expr
05v ":"
08i 2 v split
0Es split-expr
0D
10s split-expr
11
0Es argument
0D
10s split-expr
12
11
0C
0Ao 17
0D
05v ""
0C
0Ao 8
0D
05v #f
0Es format-spec
0D
05v ""
10s argument
20
0Bo 81
10s opts
05v :expr-count
02i 1
08i 1 v -
08i 3 v tree/+=
0D
10s arguments-used
10s opts
05v :expr-count
08i 2 v tree/ref
05v #t
08i 3 v array/set!
0D
10s format-spec
10s opts
05v :expr-count
08i 2 v tree/ref
08i 1 v fmt/arg-sym
08i 2 v fmt/format-arg
09o 231
15
10s argument
08i 1 v read
0Es read-vals
0D
10s read-vals
12
0Bo 33
05v :format-error
05v "Format argument specifier contains more than a single atom"
10s argument
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
10s read-vals
11
08i 1 v fmt/valid-argument?
0Bo 7
24
09o 30
05v :format-error
05v "Format argument specifier should be either an integer or a symbol"
10s argument
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s read-vals
11
08i 1 v int?
0Bo 96
10s read-vals
11
02i 0
1E
0C
0Ao 28
0D
10s read-vals
11
10s arguments-used
08i 1 v array/length
21
0C
0Ao 8
0D
05v #f
0Bo 33
05v :format-error
05v "fmt numbered argument is out of bounds"
10s argument
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
10s arguments-used
10s read-vals
11
05v #t
08i 3 v array/set!
09o 4
24
0D
10s format-spec
10s read-vals
11
08i 1 v fmt/arg-sym
08i 2 v fmt/format-arg
16
01
}
0Es fmt/expr
0D
26v fmt v [format-string . args] v #@[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] [for [i 0 [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]]] [for-in [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]]] [for [i 0 [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 [str->sym [cat "fmt-arg-" [string fmt/args/map-fun/count]]]] [++ fmt/args/map-fun/count] [list 'def s arg]] [if args [quasiquote [let* [unquote-splicing [map args fmt/args/map-fun]] [unquote expr]]] expr]]] v #{
10s format-string
08i 1 v string?
0Bo 7
24
09o 30
05v :type-error
05v "fmt needs a string literal as a first argument, since it is implemented as a macro"
10s format-string
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
24
0Es cuts
0D
15
02i 0
0Es i
0D
10s format-string
08i 1 v string/length
0Es ΓεnΣym-142
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-142
1E
0Bo 189
0D
15
10s format-string
10s i
08i 2 v char-at
0Es ΓεnΣym-143
0D
10s ΓεnΣym-143
02i 123
20
0Bo 64
10s cuts
11
08i 1 v int?
0Bo 33
05v :format-error
05v "fmt placeholders can't be nested"
10s format-string
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
10s i
10s cuts
14
0Fs cuts
09o 82
10s ΓεnΣym-143
02i 125
20
0Bo 71
10s cuts
11
08i 1 v int?
0Bo 7
24
09o 30
05v :format-error
05v "fmt expects all brackets to be closed"
10s format-string
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s cuts
11
10s i
14
10s cuts
12
14
0Fs cuts
09o 4
24
16
0D
02i 1
10s i
03
0Fs i
09o -196
16
0D
10s cuts
11
08i 1 v int?
0Bo 33
05v :format-error
05v "fmt placeholders can't be nested"
10s format-string
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
24
0Es expr-list
0D
10s format-string
08i 1 v string/length
0Es last-pos
0D
10s args
08i 1 v length
08i 1 v array/allocate
05v #f
08i 2 v array/fill!
0Es arguments-used
0D
05v :expr-count
10s arguments-used
08i 1 v array/length
08i 2 v tree/new
0Es opts
0D
15
10s cuts
0Es ΓεnΣym-144
0D
10s ΓεnΣym-144
0Bo 168
02i 0
1B
1C
10s ΓεnΣym-144
0Bo 154
0D
10s ΓεnΣym-144
11
0Es c
0D
10s format-string
10s c
12
02i 1
08i 2 v +
10s last-pos
08i 3 v string/cut
0Es lit
0D
05v ""
10s lit
20
0Bo 7
24
09o 16
10s lit
10s expr-list
14
0Fs expr-list
0D
10s format-string
02i 1
10s c
11
08i 2 v +
10s c
12
08i 3 v string/cut
10s arguments-used
10s opts
08i 3 v fmt/expr
0Es expr
0D
10s expr
10s expr-list
14
0Fs expr-list
0D
10s c
11
0Fs last-pos
0D
10s ΓεnΣym-144
12
0Fs ΓεnΣym-144
09o -156
09o 4
24
16
0D
10s last-pos
02i 0
22
0Bo 39
10s format-string
02i 0
10s last-pos
08i 3 v string/cut
0Es lit
0D
10s lit
10s expr-list
14
0Fs expr-list
09o 4
24
0D
15
02i 0
0Es i
0D
10s arguments-used
08i 1 v array/length
0Es ΓεnΣym-145
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-145
1E
0Bo 84
0D
10s arguments-used
10s i
08i 2 v array/ref
0Bo 7
24
09o 48
05v :format-error
05v "fmt expects all arguments to be used"
10s format-string
10s args
10s i
08i 2 v list/ref
08i 2 v list
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
02i 1
10s i
03
0Fs i
09o -91
16
0D
10s expr-list
12
0Bo 15
23s cat
10s expr-list
14
09o 33
10s expr-list
11
08i 1 v string?
0Bo 11
10s expr-list
11
09o 12
23s string
10s expr-list
14
0Es expr
0D
02i 0
0Es fmt/args/map-fun/count
0D
25v fmt/args/map-fun v [arg] v #@[source: [[def s [str->sym [cat "fmt-arg-" [string fmt/args/map-fun/count]]]] [++ fmt/args/map-fun/count] [list 'def s arg]]] v #{
05v "fmt-arg-"
10s fmt/args/map-fun/count
08i 1 v string
08i 2 v cat
08i 1 v str->sym
0Es s
0D
02i 1
10s fmt/args/map-fun/count
08i 2 v +
0Fs fmt/args/map-fun/count
0D
23s def
10s s
10s arg
08i 3 v list
01
}
0Es fmt/args/map-fun
0D
10s args
0Bo 35
23s let*
10s args
10s fmt/args/map-fun
08i 2 v map
10s expr
24
14
08i 2 v append
14
09o 7
10s expr
01
}
0Es fmt
0D
26v pfmt v [format-string . args] v #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [print [fmt [unquote format-string] [unquote-splicing args]]]]]] v #{
23s print
23s fmt
10s format-string
10s args
24
08i 2 v append
14
14
24
14
14
01
}
0Es pfmt
0D
26v efmt v [format-string . args] v #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [error [fmt [unquote format-string] [unquote-splicing args]]]]]] v #{
23s error
23s fmt
10s format-string
10s args
24
08i 2 v append
14
14
24
14
14
01
}
0Es efmt
0D
26v pfmtln v [format-string . args] v #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [println [fmt [unquote format-string] [unquote-splicing args]]]]]] v #{
23s println
23s fmt
10s format-string
10s args
24
08i 2 v append
14
14
24
14
14
01
}
0Es pfmtln
0D
26v efmtln v [format-string . args] v #@[documentation: "Print a formatted string" source: ["Print a formatted string" [quasiquote [errorln [fmt [unquote format-string] [unquote-splicing args]]]]]] v #{
23s errorln
23s fmt
10s format-string
10s args
24
08i 2 v append
14
14
24
14
14
01
}
0Es efmtln
01
}#{
25v string->keyword v [α] v #@[documentation: "Return string α as a keyword" source: [:inline "Return string α as a keyword" [symbol->keyword [str->sym α]]] inline: #t] v #{
10s α
08i 1 v str->sym
08i 1 v symbol->keyword
01
}
0Es string->keyword
0D
25v string->byte-array v [a] v #@[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]]] [for [i 0 [string/length a]] [array/set! ret i [char-at a i]]] ret]] v #{
10s a
08i 1 v string/length
08i 1 v array/allocate
0Es ret
0D
15
02i 0
0Es i
0D
10s a
08i 1 v string/length
0Es ΓεnΣym-149
0D
02i 0
1B
1C
10s i
10s ΓεnΣym-149
1E
0Bo 45
0D
10s ret
10s i
10s a
10s i
08i 2 v char-at
08i 3 v array/set!
0D
02i 1
10s i
03
0Fs i
09o -52
16
0D
10s ret
01
}
0Es string->byte-array
0D
25v println v [str] v #@[documentation: "Print STR on a single line" source: ["Print STR on a single line" [print [cat str "\r\n"]]]] v #{
10s str
05v "\r\n"
08i 2 v cat
08i 1 v print
01
}
0Es println
0D
25v errorln v [str] v #@[documentation: "Print to stderr STR on a single line" source: ["Print to stderr STR on a single line" [error [cat str "\r\n"]]]] v #{
10s str
05v "\r\n"
08i 2 v cat
08i 1 v error
01
}
0Es errorln
0D
25v display v [value] v #@[documentation: "Display VALUE" source: [:inline "Display VALUE" [print value]] inline: #t] v #{
10s value
08i 1 v print
01
}
0Es display
0D
25v newline v [] v #@[documentation: "Print a single line feed character" source: ["Print a single line feed character" [display "\r\n"]]] v #{
05v "\r\n"
08i 1 v print
01
}
0Es newline
0D
25v br v [num] v #@[documentation: "Return NUM=1 linebreaks" source: ["Return NUM=1 linebreaks" [if [or [nil? num] [<= [int num] 1]] "\n" [cat "\n" [br [+ -1 num]]]]]] v #{
10s num
08i 1 v nil?
0C
0Ao 25
0D
10s num
08i 1 v int
02i 1
1F
0C
0Ao 8
0D
05v #f
0Bo 10
05v "\n"
09o 28
05v "\n"
02i -1
10s num
08i 2 v +
08i 1 v br
08i 2 v cat
01
}
0Es br
0D
25v path/ext?! v [ext] v #@[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]]]]]] v #{
15
10s ext
08i 1 v type-of
0Es ΓεnΣym-150
0D
10s ΓεnΣym-150
05v :string
20
0Bo 19
25v 'anonymous v [path] v #@[source: [[== ext [lowercase [path/extension path]]]]] v #{
10s ext
10s path
08i 1 v path/extension
08i 1 v lowercase
20
01
}
09o 53
10s ΓεnΣym-150
05v :pair
20
0Bo 19
25v 'anonymous v [path] v #@[source: [[def cext [lowercase [path/extension path]]] [reduce ext [fn [α β] [or α [== β cext]]]]]] v #{
10s path
08i 1 v path/extension
08i 1 v lowercase
0Es cext
0D
10s ext
25v 'anonymous v [α β] v #@[source: [[or α [== β cext]]]] v #{
10s α
0C
0Ao 22
0D
10s β
10s cext
20
0C
0Ao 8
0D
05v #f
01
}
08i 2 v reduce
01
}
09o 25
05v :type-error
05v "Expected a :string or :list"
10s ext
08i 3 v list
08i 1 v throw
16
01
}
0Es path/ext?!
0D
25v path/extension v [path] v #@[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]]] v #{
10s path
05v "."
08i 2 v last-index-of
0Es last-period
0D
10s last-period
02i 0
21
0Bo 35
10s path
02i 1
10s last-period
08i 2 v +
10s path
08i 1 v string/length
08i 3 v string/cut
09o 7
10s path
01
}
0Es path/extension
0D
25v path/without-extension v [path] v #@[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]]] v #{
10s path
05v "."
08i 2 v last-index-of
0Es last-period
0D
10s last-period
02i 0
21
0Bo 21
10s path
02i 0
10s last-period
08i 3 v string/cut
09o 7
10s path
01
}
0Es path/without-extension
0D
25v int->string/binary v [α] v #@[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 [logand α 1]]] ret]] [set! α [ash α -1]]] ret]] v #{
05v ""
0Es ret
0D
10s α
0Bo 7
24
09o 9
02i 0
0Es α
0D
02i 0
10s α
20
0Bo 14
05v "0"
0Fs ret
09o 4
24
0D
02i 0
1B
1C
02i 0
10s α
08i 2 v !=
0Bo 59
0D
02i 48
10s α
02i 1
08i 2 v logand
08i 2 v +
08i 1 v from-char-code
10s ret
08i 2 v cat
0Fs ret
0D
10s α
02i -1
08i 2 v ash
0Fs α
09o -68
0D
10s ret
01
}
0Es int->string/binary
0D
25v int->string/octal v [α] v #@[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 [logand α 7]]] ret]] [set! α [ash α -3]]] ret]] v #{
05v ""
0Es ret
0D
10s α
0Bo 7
24
09o 9
02i 0
0Es α
0D
02i 0
10s α
20
0Bo 14
05v "0"
0Fs ret
09o 4
24
0D
02i 0
1B
1C
02i 0
10s α
08i 2 v !=
0Bo 59
0D
02i 48
10s α
02i 7
08i 2 v logand
08i 2 v +
08i 1 v from-char-code
10s ret
08i 2 v cat
0Fs ret
0D
10s α
02i -3
08i 2 v ash
0Fs α
09o -68
0D
10s ret
01
}
0Es int->string/octal
0D
05v "0"
05v "1"
05v "2"
05v "3"
05v "4"
05v "5"
05v "6"
05v "7"
05v "8"
05v "9"
05v "A"
05v "B"
05v "C"
05v "D"
05v "E"
05v "F"
08i 16 v array/new
0Es int->string/hex/conversion-arr
0D
25v int->string/HEX v [α] v #@[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 [logand α 15]] ret]] [set! α [ash α -4]]] ret]] v #{
05v ""
0Es ret
0D
10s α
0Bo 7
24
09o 9
02i 0
0Es α
0D
02i 0
10s α
20
0Bo 14
05v "0"
0Fs ret
09o 4
24
0D
10s α
02i 0
1E
0Bo 33
05v :type-error
05v "Can't print negative numbers in hex for now"
10s α
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
02i 0
1B
1C
02i 0
10s α
08i 2 v !=
0Bo 56
0D
10s int->string/hex/conversion-arr
10s α
02i 15
08i 2 v logand
08i 2 v array/ref
10s ret
08i 2 v cat
0Fs ret
0D
10s α
02i -4
08i 2 v ash
0Fs α
09o -65
0D
10s ret
01
}
0Es int->string/HEX
0D
25v int->string/hex v [α] v #@[documentation: "Turn α into a its **hexadecimal** string representation" source: ["Turn α into a its **hexadecimal** string representation" [lowercase [int->string/HEX α]]]] v #{
10s α
08i 1 v int->string/HEX
08i 1 v lowercase
01
}
0Es int->string/hex
0D
25v int->string/decimal v [α] v #@[documentation: "Turn α into a its **decimal** string representation" source: ["Turn α into a its **decimal** string representation" [string α]]] v #{
10s α
08i 1 v string
01
}
0Es int->string/decimal
0D
10s int->string/decimal
0Es int->string
0D
25v string/pad-start v [text goal-length char] v #@[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]]] v #{
10s char
0Bo 7
24
09o 11
05v " "
0Fs char
0D
10s text
08i 1 v string?
0Bo 7
24
09o 16
10s text
08i 1 v string
0Fs text
0D
10s char
08i 1 v string?
0Bo 7
24
09o 30
05v :type-error
05v "string/pad-start needs char as a string, so that one can pad with multiple characters"
10s char
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
02i 0
1B
1C
10s text
08i 1 v string/length
10s goal-length
1E
0Bo 24
0D
10s char
10s text
08i 2 v cat
0Fs text
09o -36
0D
10s text
08i 1 v string/length
10s goal-length
22
0Bo 42
10s text
10s text
08i 1 v string/length
10s goal-length
08i 2 v -
10s text
08i 1 v string/length
08i 3 v string/cut
09o 7
10s text
01
}
0Es string/pad-start
0D
25v string/pad-end v [text goal-length char] v #@[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]]] v #{
10s char
0Bo 7
24
09o 11
05v " "
0Fs char
0D
10s text
08i 1 v string?
0Bo 7
24
09o 16
10s text
08i 1 v string
0Fs text
0D
10s char
08i 1 v string?
0Bo 7
24
09o 30
05v :type-error
05v "string/pad-start needs char as a string, so that one can pad with multiple characters"
10s char
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
02i 0
1B
1C
10s text
08i 1 v string/length
10s goal-length
1E
0Bo 24
0D
10s text
10s char
08i 2 v cat
0Fs text
09o -36
0D
10s text
08i 1 v string/length
10s goal-length
22
0Bo 21
10s text
02i 0
10s goal-length
08i 3 v string/cut
09o 7
10s text
01
}
0Es string/pad-end
0D
25v string/pad-middle v [text goal-length char] v #@[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]]] v #{
10s char
0Bo 7
24
09o 11
05v " "
0Fs char
0D
10s text
08i 1 v string?
0Bo 7
24
09o 16
10s text
08i 1 v string
0Fs text
0D
10s char
08i 1 v string?
0Bo 7
24
09o 30
05v :type-error
05v "string/pad-middle needs char as a string, so that one can pad with multiple characters"
10s char
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
02i 0
1B
1C
10s text
08i 1 v string/length
10s goal-length
1E
0Bo 28
0D
10s char
10s text
10s char
08i 3 v cat
0Fs text
09o -40
0D
10s text
08i 1 v string/length
10s goal-length
22
0Bo 96
15
10s text
08i 1 v string/length
10s goal-length
08i 2 v -
02i 2
08i 2 v /
0Es end-overflow
0D
10s text
08i 1 v string/length
10s goal-length
08i 2 v -
10s end-overflow
08i 2 v -
0Es start-overflow
0D
10s text
10s start-overflow
10s start-overflow
10s goal-length
08i 2 v +
08i 3 v string/cut
16
09o 7
10s text
01
}
0Es string/pad-middle
0D
25v string/round v [text decimal-digits] v #@[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]]] v #{
10s text
05v "."
08i 2 v last-index-of
0Es pos
0D
10s pos
02i 0
21
0Bo 37
10s text
02i 0
10s pos
02i 1
08i 2 v +
10s decimal-digits
08i 2 v +
08i 3 v string/cut
09o 7
10s text
01
}
0Es string/round
0D
25v split/empty v [str separator] v #@[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]] [++ start]] [reverse ret]]] v #{
10s str
08i 1 v string/length
0Es slen
0D
02i 0
0Es start
0D
24
0Es ret
0D
02i 0
1B
1C
10s start
10s slen
1E
0Bo 56
0D
10s str
10s start
02i 1
10s start
08i 2 v +
08i 3 v string/cut
10s ret
14
0Fs ret
0D
02i 1
10s start
08i 2 v +
0Fs start
09o -63
0D
10s ret
08i 1 v reverse
01
}
0Es split/empty
0D
25v split/string v [str separator start] v #@[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]]]] v #{
10s start
0Bo 7
24
09o 9
02i 0
0Fs start
0D
10s str
10s separator
10s start
08i 3 v index-of
0Es pos-found
0D
10s pos-found
02i 0
21
0Bo 55
10s str
10s start
10s pos-found
08i 3 v string/cut
10s str
10s separator
10s pos-found
10s separator
08i 1 v string/length
08i 2 v +
08i 3 v split/string
14
09o 27
10s str
10s start
10s str
08i 1 v string/length
08i 3 v string/cut
24
14
01
}
0Es split/string
0D
25v split v [str separator] v #@[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]]]]] v #{
10s str
08i 1 v type-of
05v :string
20
0Bo 7
24
09o 30
05v :type-error
05v "Expected a value of type :string"
10s str
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s separator
08i 1 v type-of
05v :string
20
0Bo 7
24
09o 30
05v :type-error
05v "Expected a value of type :string"
10s separator
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
15
10s separator
08i 1 v string/length
0Es ΓεnΣym-151
0D
10s ΓεnΣym-151
02i 0
20
0Bo 15
10s str
08i 1 v split/empty
09o 18
10s str
10s separator
02i 0
08i 3 v split/string
16
01
}
0Es split
0D
25v read/single v [text] v #@[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]]]] v #{
10s text
08i 1 v type-of
05v :string
20
0Bo 7
24
09o 30
05v :type-error
05v "Expected a value of type :string"
10s text
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
0D
10s text
08i 1 v read
11
01
}
0Es read/single
0D
25v read/int v [text] v #@[documentation: "Reads the first string from TEXT" source: ["Reads the first string from TEXT" [int [read/single text]]]] v #{
10s text
08i 1 v read/single
08i 1 v int
01
}
0Es read/int
0D
25v read/float v [text] v #@[documentation: "Reads the first float from TEXT" source: ["Reads the first float from TEXT" [float [read/single text]]]] v #{
10s text
08i 1 v read/single
08i 1 v float
01
}
0Es read/float
0D
25v string/length?! v [chars] v #@[source: [[fn [a] [== chars [string/length a]]]]] v #{
25v 'anonymous v [a] v #@[source: [[== chars [string/length a]]]] v #{
10s chars
10s a
08i 1 v string/length
20
01
}
01
}
0Es string/length?!
0D
25v contains-any? v [str chars] v #@[source: [[apply or [map [split chars ""] [fn [a] [>= [index-of str a] 0]]]]]] v #{
10s or
10s chars
05v ""
08i 2 v split
25v 'anonymous v [a] v #@[source: [[>= [index-of str a] 0]]] v #{
10s str
10s a
08i 2 v index-of
02i 0
21
01
}
08i 2 v map
08i 2 v apply
01
}
0Es contains-any?
0D
25v contains-all? v [str chars] v #@[source: [[apply and [map [split chars ""] [fn [a] [>= [index-of str a] 0]]]]]] v #{
10s and
10s chars
05v ""
08i 2 v split
25v 'anonymous v [a] v #@[source: [[>= [index-of str a] 0]]] v #{
10s str
10s a
08i 2 v index-of
02i 0
21
01
}
08i 2 v map
08i 2 v apply
01
}
0Es contains-all?
01
}#{
05v "Nujel"
0Es test-context
0D
25v test/reset v [] v #@[source: [[set! test-list #nil] [set! test-count 0] [test/add 4 [+ 3 1]]]] v #{
24
0Fs test-list
0D
02i 0
0Fs test-count
0D
02i 4
05v [do [+ 3 1]]
08i 2 v test/add*
01
}
0Es test/reset
0D
24
0Es test-list
0D
02i 0
0Es test-count
0D
02i 0
0Es nujel-start
0D
02i 0
0Es success-count
0D
02i 0
0Es error-count
0D
05v #t
0Es print-errors
0D
05v #f
0Es print-passes
0D
25v test/add* v [result expr] v #@[source: [[set! test-list [cons [cons result expr] test-list]] [set! test-count [+ test-count 1]]]] v #{
10s result
10s expr
14
10s test-list
14
0Fs test-list
0D
10s test-count
02i 1
08i 2 v +
0Fs test-count
01
}
0Es test/add*
0D
26v test/add v [result . expr] v #@[documentation: "Add a test where EXPR must eval to RESULT" source: ["Add a test where EXPR must eval to RESULT" [quasiquote [test/add* [unquote result] [unquote [list 'quote [cons 'do expr]]]]]]] v #{
23s test/add*
10s result
23s quote
23s do
10s expr
14
08i 2 v list
24
14
14
14
01
}
0Es test/add
0D
25v display-results v [] v #@[documentation: "Prints the result Message" source: ["Prints the result Message" [random/seed-initialize!] [efmtln "{test-context} [{System/OS} {System/Architecture}] - {} - [{} / {}] in {} ms - {}" [if [and [zero? error-count] [> test-count 0]] "Success" "Failed!"] [ansi-green success-count] [ansi-red error-count] [- [time/milliseconds] nujel-start] [if [and [zero? error-count] [> test-count 0]] [ansi-rainbow "Everything is working, very nice!"] [ansi-red "Better fix those!"]]]]] v #{
08i 0 v random/seed-initialize!
0D
15
02i 0
10s error-count
20
0C
0Bo 11
0D
10s test-count
02i 0
22
0Bo 10
05v "Success"
09o 7
05v "Failed!"
0Es fmt-arg-0
0D
10s success-count
08i 1 v ansi-green
0Es fmt-arg-1
0D
10s error-count
08i 1 v ansi-red
0Es fmt-arg-2
0D
08i 0 v time/milliseconds
10s nujel-start
08i 2 v -
0Es fmt-arg-3
0D
02i 0
10s error-count
20
0C
0Bo 11
0D
10s test-count
02i 0
22
0Bo 15
05v "Everything is working, very nice!"
08i 1 v ansi-rainbow
09o 12
05v "Better fix those!"
08i 1 v ansi-red
0Es fmt-arg-4
0D
10s test-context
05v " ["
10s System/OS
05v " "
10s System/Architecture
05v "] - "
10s fmt-arg-0
05v " - ["
10s fmt-arg-1
05v " / "
10s fmt-arg-2
05v "] in "
10s fmt-arg-3
05v " ms - "
10s fmt-arg-4
08i 15 v cat
16
08i 1 v errorln
01
}
0Es display-results
0D
25v test-success v [res-should res-is expr i] v #@[documentation: "Should be called after a test has finished successfully" source: ["Should be called after a test has finished successfully" [when print-passes [efmtln "{} == {}\r\n{}\r\n\r\n" [ansi-green [str/write res-is]] [ansi-green [str/write res-should]] [str/write expr]]] [set! success-count [+ 1 success-count]]]] v #{
10s print-passes
0Bo 94
15
10s res-is
08i 1 v str/write
08i 1 v ansi-green
0Es fmt-arg-0
0D
10s res-should
08i 1 v str/write
08i 1 v ansi-green
0Es fmt-arg-1
0D
10s expr
08i 1 v str/write
0Es fmt-arg-2
0D
10s fmt-arg-0
05v " == "
10s fmt-arg-1
05v "\r\n"
10s fmt-arg-2
05v "\r\n\r\n"
08i 6 v cat
16
08i 1 v errorln
09o 4
24
0D
02i 1
10s success-count
08i 2 v +
0Fs success-count
01
}
0Es test-success
0D
25v test-failure v [res-should res-is expr i] v #@[documentation: "Should be called if EXPR does not equal RES" source: ["Should be called if EXPR does not equal RES" [when print-errors [pfmtln "{} != {}\r\n{}\r\n\r\n" [ansi-red [str/write res-is]] [ansi-green [str/write res-should]] [str/write expr]]] [set! error-count [+ 1 error-count]]]] v #{
10s print-errors
0Bo 94
15
10s res-is
08i 1 v str/write
08i 1 v ansi-red
0Es fmt-arg-0
0D
10s res-should
08i 1 v str/write
08i 1 v ansi-green
0Es fmt-arg-1
0D
10s expr
08i 1 v str/write
0Es fmt-arg-2
0D
10s fmt-arg-0
05v " != "
10s fmt-arg-1
05v "\r\n"
10s fmt-arg-2
05v "\r\n\r\n"
08i 6 v cat
16
08i 1 v println
09o 4
24
0D
02i 1
10s error-count
08i 2 v +
0Fs error-count
01
}
0Es test-failure
0D
25v test-default v [result rawexpr i] v #@[documentation: "Tests that RAWEXPR evaluates to RESULT" source: ["Tests that RAWEXPR evaluates to RESULT" [try [fn [err] [display/error err] [test-failure result [list :exception-caught err] rawexpr i]] [def expr [eval rawexpr]] [if [equal? result expr] [test-success result expr rawexpr i] [test-failure result expr rawexpr i]]]]] v #{
25v 'anonymous v [err] v #@[source: [[display/error err] [test-failure result [list :exception-caught err] rawexpr i]]] v #{
10s err
08i 1 v display/error
0D
10s result
05v :exception-caught
10s err
08i 2 v list
10s rawexpr
10s i
08i 4 v test-failure
01
}
19o 84
08i 0 v current-closure
10s rawexpr
08i 2 v eval-in
0Es expr
0D
10s result
10s expr
08i 2 v equal?
0Bo 27
10s result
10s expr
10s rawexpr
10s i
08i 4 v test-success
09o 24
10s result
10s expr
10s rawexpr
10s i
08i 4 v test-failure
16
01
}
0Es test-default
0D
25v test-run-real v [test] v #@[source: [[set! nujel-start [time/milliseconds]] [set! success-count 0] [set! error-count 0] [def i [+ test-count 1]] [for-in [cur-test test-list] [test [car cur-test] [cdr cur-test] [-- i]]] [display-results] error-count]] v #{
08i 0 v time/milliseconds
0Fs nujel-start
0D
02i 0
0Fs success-count
0D
02i 0
0Fs error-count
0D
10s test-count
02i 1
08i 2 v +
0Es i
0D
15
10s test-list
0Es ΓεnΣym-153
0D
10s ΓεnΣym-153
0Bo 72
02i 0
1B
1C
10s ΓεnΣym-153
0Bo 58
0D
10s ΓεnΣym-153
11
0Es cur-test
0D
10s test
10s cur-test
11
10s cur-test
12
02i -1
10s i
08i 2 v +
0Fs i
1Ai 3
0D
10s ΓεnΣym-153
12
0Fs ΓεnΣym-153
09o -60
09o 4
24
16
0D
08i 0 v display-results
0D
10s error-count
01
}
0Es test-run-real
0D
25v test-run v [output-passes hide-errors] v #@[documentation: "Run through all automated Tests" source: ["Run through all automated Tests" [set! print-errors [not [bool hide-errors]]] [set! print-passes [bool output-passes]] [test-run-real test-default]]] v #{
10s hide-errors
08i 1 v bool
0Bo 10
05v #f
09o 7
05v #t
0Fs print-errors
0D
10s output-passes
08i 1 v bool
0Fs print-passes
0D
10s test-default
08i 1 v test-run-real
01
}
0Es test-run
0D
08i 0 v test/reset
01
}#{
25v dup v [l] v #@[source: [[case [type-of l] [:tree [tree/dup l]] [:array [array/dup l]] [otherwise l]]]] v #{
15
10s l
08i 1 v type-of
0Es ΓεnΣym-156
0D
10s ΓεnΣym-156
05v :tree
20
0Bo 15
10s l
08i 1 v tree/dup
09o 31
10s ΓεnΣym-156
05v :array
20
0Bo 15
10s l
08i 1 v array/dup
09o 7
10s l
16
01
}
0Es dup
0D
25v make-instance v [parent] v #@[source: [[when [and [not [nil? parent]] [!= [type-of parent] :tree]] [throw [list :type-error "Parents can only be trees or nil" parent [current-lambda]]]] [def ret [tree/new #nil]] [for-in [k [tree/keys parent]] [when [!= k :parent] [def pv [tree/get parent k]] [when-not [== [type-of pv] :lambda] [tree/set! ret k [dup pv]]]]] [tree/set! ret :parent parent]]] v #{
10s parent
08i 1 v nil?
0Bo 10
05v #f
09o 7
05v #t
0C
0Bo 22
0D
10s parent
08i 1 v type-of
05v :tree
08i 2 v !=
0Bo 33
05v :type-error
05v "Parents can only be trees or nil"
10s parent
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
09o 4
24
0D
24
08i 1 v tree/new
0Es ret
0D
15
10s parent
08i 1 v tree/keys
0Es ΓεnΣym-157
0D
10s ΓεnΣym-157
0Bo 124
02i 0
1B
1C
10s ΓεnΣym-157
0Bo 110
0D
10s ΓεnΣym-157
11
0Es k
0D
10s k
05v :parent
08i 2 v !=
0Bo 69
10s tree/get
10s parent
10s k
1Ai 2
0Es pv
0D
10s pv
08i 1 v type-of
05v :lambda
20
0Bo 7
24
09o 26
10s ret
10s k
10s dup
10s pv
1Ai 1
08i 3 v tree/set!
09o 4
24
0D
10s ΓεnΣym-157
12
0Fs ΓεnΣym-157
09o -112
09o 4
24
16
0D
10s ret
05v :parent
10s parent
08i 3 v tree/set!
01
}
0Es make-instance
0D
25v nos/funcall* v [o method-name args] v #@[source: [[if o [do [def v [tree/get o method-name]] [if v [apply v args] [nos/funcall* [tree/get o :parent] method-name args]]] [throw [list :missing-method "Can't find that method" o [current-lambda]]]]]] v #{
10s o
0Bo 76
10s tree/get
10s o
10s method-name
1Ai 2
0Es v
0D
10s v
0Bo 19
10s v
10s args
08i 2 v apply
09o 31
10s nos/funcall*
10s tree/get
10s o
05v :parent
1Ai 2
10s method-name
10s args
1Ai 3
09o 30
05v :missing-method
05v "Can't find that method"
10s o
08i 0 v current-lambda
08i 4 v list
08i 1 v throw
01
}
0Es nos/funcall*
0D
25v nos/funcall v [o method-name . args] v #@[source: [[nos/funcall* o method-name [cons o args]]]] v #{
10s nos/funcall*
10s o
10s method-name
10s o
10s args
14
1Ai 3
01
}
0Es nos/funcall
0D
25v nos/funcall*/try v [o method-name args] v #@[source: [[when o [def v [tree/get o method-name]] [if v [apply v args] [nos/funcall* [tree/get o :parent] method-name args]]]]] v #{
10s o
0Bo 76
10s tree/get
10s o
10s method-name
1Ai 2
0Es v
0D
10s v
0Bo 19
10s v
10s args
08i 2 v apply
09o 31
10s nos/funcall*
10s tree/get
10s o
05v :parent
1Ai 2
10s method-name
10s args
1Ai 3
09o 4
24
01
}
0Es nos/funcall*/try
0D
25v nos/funcall/try v [o method-name . args] v #@[source: [[nos/funcall*/try o method-name [cons o args]]]] v #{
10s nos/funcall*/try
10s o
10s method-name
10s o
10s args
14
1Ai 3
01
}
0Es nos/funcall/try
0D
26v defobject v [parent] v #@[source: [[quasiquote [make-instance [unquote parent]]]]] v #{
23s make-instance
10s parent
24
14
14
01
}
0Es defobject
0D
26v defproperty v [o name val] v #@[source: [[quasiquote [tree/set! [unquote o] [unquote name] [unquote val]]]]] v #{
23s tree/set!
10s o
10s name
10s val
24
14
14
14
14
01
}
0Es defproperty
0D
26v defmethod v [o name args . body] v #@[source: [[quasiquote [tree/set! [unquote o] [unquote name] [\ [unquote [cons 'this args]] [unquote-splicing body]]]]]] v #{
23s tree/set!
10s o
10s name
23s \
23s this
10s args
14
10s body
24
08i 2 v append
14
14
24
14
14
14
14
01
}
0Es defmethod
0D
26v _ v [o name . args] v #@[source: [[quasiquote [nos/funcall [unquote o] [unquote name] [unquote-splicing args]]]]] v #{
23s nos/funcall
10s o
10s name
10s args
24
08i 2 v append
14
14
14
01
}
0Es _
01
}