import io ; println import math ; divmod, pow import stack ; to_a import string ; charat, strcat, strindex, strlen
; inserts between the top two stack values the intervening consecutive elements ; supports counting up or down ; [I J] => [I I±1 … J] ; ; [2 5] => [2 3 4 5] ; [5 2] => [5 4 3 2] ; [0 4] => [0 1 2 3 4] ; [4 0] => [4 3 2 1 0] ; [-2 0] => [-2 -1 0] ; [0 -2] => [0 -1 -2] ; [-3 3] => [-3 -2 -1 0 1 2 3] ; [3 -3] => [3 2 1 0 -1 -2 -3] ; [4 4] => [4] range: dup copy 2 sub jz _range_one dup copy 2 sub jn _range_down
copy 1 push 1 add swap copy 1 copy 1 sub jn range pop ret
_range_one: pop ret _range_down:
copy 1 push 1 sub swap dup copy 2 sub jn _range_down pop ret
$range_loop(fn, cmp) { `fn`:
dup copy 2 add @-1 `cmp` jz _`fn`_done copy 1 copy 1 add swap jump `fn`
_`fn`_done: pop ret }
; inserts between I and J the intervening consecutive elements, counting by ; step S up/down to (but never beyond) J ; [I J S] => [I I±S … ~J] ; ; [1 4 1] => [1 2 3 4] ; [4 1 -1] => [4 3 2 1] ; [2 10 3] => [2 5 8] ; [10 2 -3] => [10 7 4] ; [-5 25 10] => [-5 5 15 25] ; [25 -5 -10] => [25 15 5 -5] ; [4 20 3] => [4 7 10 13 16 19] ; [20 4 -3] => [20 17 14 11 8 5] ; [3 9 7] => [3] ; [9 3 -7] => [9] steprange: swap push -1 copy 1 store copy 2 sub
jn _steprange_down_loop jump _steprange_loop ; prevent DCE
$range_loop(_steprange_loop, :lte) $range_loop(_steprange_down_loop, :gte)
; prints the string at the top of the stack and halts execution after pushing ; something onto the stack to signal abnormal termination/unclean exit ; […] => [… 1] die!: :println push 1 exit
; for stoi and itos alpha: push “0123456789abcdefghijklmnopqrstuvwxyz” ret
; converts the string S to an integer in base B (2-36) ; ! TODO: support prefixes? ; [S B] ; ; [“101010” 2] => [42] ; [“0777” 8] => [511] ; [“12345” 10] => [12345] ; [“123_” 10] => [123] ; [“123__” 10] => [123000] ; TODO: bug ; [“dead” 16] => [57005] ; [“gabe” 17] => [81699] ; [“0” 10] => [0] [“-0” 10] => [0] ; [“-10001” 2] => [-17] ; [“-123” 10] => [-123] ; [“-ff” 16] => [-255] stoi: swap dup :_stoi_sign swap copy 1 :eq
push 2 mul $-- ^-2 push 0
_stoi_loop: ; [b s a]
swap dup jz _stoi_done swap copy 2 copy 2 :strlen push 1 sub :pow copy 2 push 128 mod :alpha swap :strindex dup jn _stoi_invalid ; found something non-alphanumeric mul add swap push 128 div swap jump _stoi_loop
_stoi_sign: dup push 0 :charat push '-' :eq copy 1 :strlen :strslice ret _stoi_invalid: pop pop slide 1 swap div @-2 mul ret _stoi_done: swap slide 2 @-2 mul ret
; creature comforts
bin: push 2 :stoi ret oct: push 8 :stoi ret to_i: push 10 :stoi ret hex: push 16 :stoi ret
; converts the integer N to a string in base B ; [N B] ; ; [42 2] => [“101010”] ; [-42 2] => [“-101010”] ; [511 8] => [“777”] ; [12345 10] => [“12345”] ; [-54321 10] => [“-54321”] ; [57005 16] => [“dead”] ; [81699 17] => [“gabe”] itos: swap push -2 copy 1 :neg? store :abs push 0 _itos_loop:
swap dup jz _itos_done swap copy 1 copy 3 mod :alpha swap :charat swap :strcat swap copy 2 div swap jump _itos_loop
_itos_done: swap slide 2 push 45 @-2 mul swap :strcat ret
; creature comforts
to_bin: push 2 :itos ret to_oct: push 8 :itos ret to_s: push 10 :itos ret to_hex: push 16 :itos ret
; puts the digits of N in base B on the stack as a pseudo-array ; [N B] => [Dn …D0 n] ; ; [42 2] => [1 0 1 0 1 0 6] ; [12345 10] => [1 2 3 4 5 5] ; [255 16] => [15 15 2] ; [256 16] => [1 0 0 3] digits:
copy 1 jz _digits_zero ; special case ^-1 push -1 swap ; sentinel value
_digits_loop:
dup jz _digits_done @-1 :divmod swap jump _digits_loop
_digits_zero: dup div ret _digits_done: push 1 sub :to_a ret
; increments the value at heap address N TODO: make heap effects test-able ? ; [N] inc: dup load $++ store ret
; decrements the value at heap address N ; [N] dec: dup load $– store ret
; pops A and B and pushes 1 if they're equal, 0 otherwise ; [A B] => [A == B] ; ; [1 2] => [0] ; [3 3] => [1] ; [-4 4] => [0] ; ['A' 65] => [1] ; ['B' 65] => [0] eq: sub jz _eq_yes push 0 ret _eq_yes: push 1 ret
; pops A and B and pushes 1 if they're not equal, 0 otherwise ; [A B] => [A != B] ; ; [1 2] => [1] ; [3 3] => [0] ; [-4 4] => [1] ; ['A' 65] => [0] ; ['B' 65] => [1] neq: sub jz _neq_no push 1 ret _neq_no: push 0 ret
; pops A and B and pushes 1 if A is greater than B, 0 otherwise ; [A B] => [A > B] ; ; [4 3] => [1] [3 4] => [0] ; [2 2] => [0] [2 1] => [1] gt: swap ; intentionally flow into lt
; pops A and B and pushes 1 if A is less than than B, 0 otherwise ; [A B] => [A < B] ; ; [3 4] => [1] [4 3] => [0] ; [2 2] => [0] [1 2] => [1] lt: sub jn _lt_yes push 0 ret _lt_yes: push 1 ret
; pops A and B and pushes 1 if A is less than or equal to B, 0 otherwise ; [A B] => [A > B] ; ; [2 2] => [1] [2 1] => [0] ; [4 3] => [0] [3 4] => [1] lte: swap ; intentionally flow into gte
; pops A and B and pushes 1 if A is greater than or equal to B, 0 otherwise ; [A B] => [A > B] ; ; [2 2] => [1] [1 2] => [0] ; [3 4] => [0] [4 3] => [1] gte: sub jn _gte_no push 1 ret _gte_no: push 0 ret
; returns 1 if the number N is between A and B (inclusive), 0 otherwise ; ! A must be <= B for sensible results TODO: bug? ; [N A B] ; ; [5 0 10] => [1] ; [11 0 10] => [0] ; [4 0 4] => [1] ; [-1 0 4] => [0] ; [-5 -10 0] => [1] ; [3 4 2] => [0] between?: copy 2 :gte swap copy 2 :lte mul slide 1 ret
; Though extremely rare, it's possible that we know a particular value is ; stored in the heap at some key, just not which one. This subroutine takes ; a value V to search for and a starting index I, and either returns the first ; key associated with that value or loops forever. Probably don't touch. ; [V I] heap-seeking_missile:
$++ dup load copy 2 :eq jz heap-seeking_missile slide 1 ret
; converts the #RRGGBB (leading '#' optional) color string S to ; its individual RGB components as integers in the range 0-255 ; [S] => [R G B] ; ; [“#000000”] => [0 0 0] ; [“ffffff”] => [255 255 255] ; [“#102030”] => [16 32 48] ; [“c0ffee”] => [192 255 238] hex2rgb:
dup push 0 :charat push '#' :eq push 127 mul $++ div push 128,2 :pow :divmod :hex swap push 128,2 :pow :divmod :hex swap :hex ret
; converts R, G, and B components to length-6 hexadecimal string S ; ! dies if any of the values to convert aren't between 0 and 255 ; [R G B] => [S] ; ; [0 0 0] => [“000000”] ; [255 255 255] => [“ffffff”] ; [16 32 48] => [“102030”] ; [192 255 238] => [“c0ffee”] rgb2hex:
push 3 :arydup all (push 0,255 :between?) jz _rgb2hex_invalid pop copy 2 push 256,2 :pow mul copy 2 push 256 mul add add slide 2 :to_hex push 6,48 :rjustc ret
_rgb2hex_invalid: push “(rgb2hex) invalid RGB” :die!
; stashes the array A in negative heap space starting at index I ; [A I] => [] aryheap:
$++ dup copy 2 store swap times ($-- swap copy 1 swap store) pop ret
; restores the heaped array starting at index I ; [I] => [A] heapary:
$++ dup load swap copy 1 sub swap times (dup load swap $++) load ret
; swaps the elements in the heap at indices I and J ; ! TODO: make heap effects doctest-able ; [I J] => [] heapswap: dup load swap copy 2 load store store ret
; returns the number of nanoseconds N since the Unix epoch ; [] => [N] time: push “date +%s%N” shell :to_i ret
$bench(insns) {
#insns :println :time ^0 `insns` :time @0 sub push 10,9 :pow :divmod swap onum push '.' ochr :to_s push 9,48 :rjustc :println
}