spitewaste 0.1.007 → 0.1.012

data/lib/spitewaste/libspw/fun.spw

@@ -56,3 +56,24 @@ _collatz_done: pop ret
 
 ; ruby:
 ;   push "'" :strcat push "ruby -e 'p " swap :strcat shell ret
+
+$_to_roman(r, v) {
+  push `v` :divmod swap push `r` swap :strrep
+  push -2 load swap :strcat push -2 swap store
+}
+
+; converts the number N to a string of roman numerals R
+; [N] => [R]
+;
+; [2020] => ["MMXX"]
+; [1666] => ["MDCLXVI"]
+; [1337] => ["MCCCXXXVII"]
+; [94] => ["XCIV"]
+to_roman: push -2,0 store
+  $_to_roman("M", 1000) $_to_roman("CM", 900)
+  $_to_roman("D", 500)  $_to_roman("CD", 400)
+  $_to_roman("C", 100)  $_to_roman("XC", 90)
+  $_to_roman("L", 50)   $_to_roman("XL", 40)
+  $_to_roman("X", 10)   $_to_roman("IX", 9)
+  $_to_roman("V", 5)    $_to_roman("IV", 4)
+  $_to_roman("I", 1) push 2 sub load ret

data/lib/spitewaste/libspw/math.spw

@@ -2,10 +2,12 @@ import array ; arycat, arydup
 import util  ; eq, inc, range
 
 ; returns B raised to the power E
+; ! TODO: support negative exponents (return Rational)
 ; [B E] => [B**E]
 ;
 ; [0 0] => [1],   [0 9] => [0],   [9 0] => [1]
 ; [3 2] => [9],   [2 3] => [8],   [7 4] => [2401]
+; [-2 3] => [-8]  [-5 0] => [1]   [-4 4] => [256]
 pow: push 1 swap
 _pow_loop: ; [b n e]
   dup jz _pow_done
@@ -18,10 +20,10 @@ _pow_done: swap slide 2 ret
 ;
 ; [0] => [1],   [1] => [1],     [2] => [2]
 ; [3] => [6],   [5] => [120],   [10] => [3628800]
-factorial: push 0 swap :range
+factorial: dup jz _fac_zero push 0 swap :range
 _fac_loop: swap dup jz _fac_done mul jump _fac_loop
-
 _fac_done: pop ret
+_fac_zero: $++ ret
 
 ; returns the integer square root of N
 ; [N] => [floor(sqrt(N))]
@@ -153,6 +155,8 @@ _divisors_square: slide 1 $-- ret ; de-duplicate when N is a perfect square
 ; [16 4] => [1820]
 ; [50 3] => [19600]
 nCk:
+  copy 1 copy 1 sub jn _nCk_empty
   copy 1 copy 1 sub :factorial
   swap :factorial mul
   swap :factorial swap div ret
+_nCk_empty: push 0 slide 2 ret

data/lib/spitewaste/libspw/random.spw

@@ -10,3 +10,7 @@ rand:
 
 rand_range: ; [a b]
   copy 1 sub :rand swap mod add ret
+
+dice:
+  push -2 swap store push 1 :aryfill
+  map (push -2 load :rand_range) ret

data/lib/spitewaste/libspw/rational.spw

@@ -151,3 +151,51 @@ ratsign:
   dup $RAT push 2 mul push 2 add sub jn _ratsign_zero
   push 2 mod push 2 mul push 1 sub ret
 _ratsign_zero: pop push 0 ret
+
+; returns the simplified inverse of the rational number R
+; [R] => [1/R]
+;
+; [R(4,8)] => [R(2,1)]
+; [R(3,-5)] => [R(-5,3)]
+; [R(-22,-7)] => [R(7,22)]
+ratinv:
+  push 2 :divmod push 2 mul $--
+  swap $RAT :divmod copy 2 mul
+  swap :to_r :ratsimp slide 1 ret
+
+; returns the rational R raised to the power E
+; [R E] => [R']
+;
+; [R(4,2) 5] => [R(32,1)]
+; [R(-3,7) 0] => [R(1,1)]
+; [R(-3,14) 2] => [R(9,196)]
+ratpow:
+  swap push 2 :divmod push 2 mul $--
+  swap $RAT :divmod copy 2 mul
+  copy 3 :pow swap copy 3 :pow
+  swap :to_r :ratsimp slide 2 ret
+
+; converts the rational number R to a "pseudo-float" with a whole (W) part
+; and a fractional (F) part composed of P digits after the decimal point
+; [R P] => [W F]
+;
+; [R(22,7) 2] => [3 14]
+; [R(355,113) 6] => [3 141592]
+; [R(8675,309) 10] => [28 744336569] TODO: leading 0 is lost (bug)
+; [R(2,4) 3] => [0 500]
+to_f: push -2 swap store :from_r :divmod push 0 swap
+_to_f_loop:
+  push -1 load :divmod  swap
+  copy 2 push 10 mul add
+  swap push 10 mul
+  push 2 :dig
+  push -2 dup :dec load :neg? jz _to_f_loop pop ret
+
+; converts the rational number R to a string S of the form
+; "<simplified numerator>/<simplified denominator>"
+; [R] => [S]
+;
+; [R(22,7)] => ["22/7"]
+; [R(2,4)] => ["1/2"]
+; [R(99,9)] => ["11/1"]
+ratstr: :ratsimp :from_r push 2 map (:to_s) push '/' :strjoinc ret

data/lib/spitewaste/libspw/string.spw

@@ -207,8 +207,10 @@ center: push ' ' :centerc ret
 ; ["foobar"] => ["fooba"]
 ; ["abc"] => ["ab"]
 ; ["a"] => [""]
-; ! [""] => ERROR TODO: Should just be a no-op.
-strchop: dup :strlen push 1 sub push 0 swap :strslice ret
+; [""] => [""]
+strchop: dup jz _strchop_empty
+  dup :strlen push 1 sub push 0 swap :strslice ret
+_strchop_empty: ret
 
 ; splits string S on delimiting character C, leaving the resultant substrings
 ; on the stack as a pseudo-array (length at top of stack)
@@ -293,7 +295,7 @@ strcount:
   reduce (add) ret
 
 ; translates all characters in A to the corresponding characters in B
-; in stirng S, ; similar to the `tr` utility in Unix. A and B must be
+; in string S, ; similar to the `tr` utility in Unix. A and B must be
 ; of the same length. TODO: make this smarter (ranges, length mismatch)
 ; ! clobbers heap addresses -1, -2, and -3
 ; [S A B] => [S']
@@ -319,9 +321,10 @@ _strtrans_no: pop ret
 ; [S] => [S']
 ;
 ; ["CJ"] => ["CDEFGHIJ"]
-; ["DA"] => ["DE"] TODO: bug
+; ["DA"] => ["DCBA"]
 ; ["af"] => ["abcdef"]
 ; ["09"] => ["0123456789"]
+; ["90"] => ["9876543210"]
 ; ["(1"] => ["()*+,-./01"]
 strexpand:
   push 0 swap push 128 :divmod
@@ -342,17 +345,38 @@ _strsqueeze_loop: ; [s]
 _strsqueeze_skip: pop jump _strsqueeze_loop
 _strsqueeze_done: pop :strpack :strrev ret
 
+$_strdel(cmp) {
+  :strunpack push -1 load :strlen
+  select (push -2 load swap :strindex `cmp`)
+  pop :strpack ret
+}
+
+; returns the string S with all characters in string T removed, like `tr -d`.
+; If the first character of T is '^', instead only those characters are kept.
+; [S T] => [S']
+;
+; ["abc123" "abc"] => ["123"]
+; ["abc123" "123"] => ["abc"]
+; ["abcba12321" "abc"] => ["12321"]
+; ["abc12321cba" "^2ac"] => ["ac22ca"]
+; ["facetious" "^aeiou"] => ["aeiou"]
+strdel: push -1 copy 2 store push -2 copy 1 store
+  push 0 :charat push '^' :neq jz _strdel_comp $_strdel(:neg?)
+_strdel_comp: $_strdel(:pos?)
+
 ; returns the sum of the ordinal values of the characters in string S
 ; [S] => [N]
 ;
 ; ["ABC"] => [198]
 ; ["012"] => [147]
 ; ["a"] => [97]
-; [""] => [] TODO: bug, should be 0
-strsum: :strunpack push 0 :to_a reduce (add) ret
+; [""] => [0]
+strsum: dup jz _strsum_empty
+  :strunpack push 0 :to_a reduce (add) ret
+_strsum_empty: ret
 
 ; rotates the string S to the left N times, wrapping
-; [S N]
+; [S N] => [S']
 ;
 ; ["abc" 0] => ["abc"]
 ; ["abcd" 1] => ["bcda"]
@@ -361,9 +385,18 @@ strsum: :strunpack push 0 :to_a reduce (add) ret
 strrotl: push 128 swap copy 2 :strlen mod :pow :divmod :strcat ret
 
 ; rotates the string S to the right N times, wrapping
-; [S N]
+; [S N] => [S']
 ;
 ; ["abcd" 1] => ["dabc"]
 ; ["abcd" 5] => ["dabc"]
 ; ["foodbar" 3] => ["barfood"]
 strrotr: push 0 swap sub :strrotl ret
+
+; frobnicates the string S by XORing all its bytes with 42
+; [S] => [S']
+;
+; ["foobar"] => ["LEEHKX"]
+; ["LEEHKX"] => ["foobar"]
+memfrob:
+  dup :strlen pop :strunpack push -1 load $++
+  map (push 42 :bxor) pop :strpack ret

data/lib/spitewaste/libspw/terminal.spw

@@ -0,0 +1,14 @@
+;;; Miscellaneous terminal-based functionality
+
+import util ; hex2rgb
+
+$_setg(code) {
+  push 91,27 ochr ochr
+  push `code` onum push 50,59 ochr ochr
+  :hex2rgb each (push 59 ochr onum)
+  push 109 ochr ret
+}
+
+setfg: $_setg(38)
+setbg: $_setg(48)
+reset: push 109,91,27 ochr ochr ochr ret

data/lib/spitewaste/libspw/test.spw

@@ -1,11 +1,10 @@
 import io     ; print, println
 import string ; strcat
+import util   ; die!
 
 assert_eq:
   dup copy 2 sub jz _assert_eq_yes
   push "expected " :print onum
   push ", got " :print onum
-  push " for test " :strcat :print :println
-  exit
-
+  push " for test " swap :strcat :die!
 _assert_eq_yes: pop pop pop ret

data/lib/spitewaste/libspw/util.spw

@@ -4,18 +4,51 @@ import stack  ; to_a
 import string ; charat, strcat, strindex, strlen
 
 ; inserts between the top two stack values the intervening consecutive elements
-; ! TODO: Support step, and negative as well.
-; [I J] => [I I+1 ... J]
+; 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]
-; [4 4] => [4 5] TODO: bug
-range:
+; [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
+  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 push -1 load `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
 die!: :println exit
@@ -34,7 +67,12 @@ alpha: push "0123456789abcdefghijklmnopqrstuvwxyz" ret
 ; ["123____"  10] => [123000] ; TODO: bug
 ; ["dead"  16] => [57005]
 ; ["gabe"  17] => [81699]
-stoi: swap push 0 ; accumulator
+; ["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 $-- push -2 swap store push 0
 _stoi_loop: ; [b s a]
   swap dup jz _stoi_done
   swap copy 2 copy 2
@@ -44,10 +82,12 @@ _stoi_loop: ; [b s a]
   dup jn _stoi_invalid ; found something non-alphanumeric
   mul add swap push 128 div swap
   jump _stoi_loop
-_stoi_invalid: pop pop slide 1 swap div ret ; return what we were able to parse
-_stoi_done: swap slide 2 ret
+_stoi_sign: dup push 0 :charat push '-' :eq copy 1 :strlen :strslice ret
+_stoi_invalid: pop pop slide 1 swap div push -2 load mul ret
+_stoi_done: swap slide 2 push -2 load mul ret
 
 ; creature comforts
+
 bin:  push  2 :stoi ret
 oct:  push  8 :stoi ret
 to_i: push 10 :stoi ret
@@ -57,11 +97,13 @@ hex:  push 16 :stoi ret
 ; [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 0 ; accumulator
+itos: swap push -2 copy 1 :neg? store :abs push 0
 _itos_loop:
   swap dup jz _itos_done
   swap copy 1 copy 3 mod
@@ -69,9 +111,10 @@ _itos_loop:
   swap :strcat
   swap copy 2 div
   swap jump _itos_loop
-_itos_done: swap slide 2 ret
+_itos_done: swap slide 2 push 45,-2 load mul swap :strcat ret
 
 ; creature comforts
+
 to_bin: push  2 :itos ret
 to_oct: push  8 :itos ret
 to_s:   push 10 :itos ret
@@ -128,22 +171,45 @@ _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]
+; [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]
+; [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
@@ -152,3 +218,31 @@ _lt_yes: push 1 ret
 heap_seeking_missile:
   $++ dup load copy 2 :eq jz heap_search
   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!

data/lib/spitewaste/parsers/fucktional.rb

@@ -64,9 +64,13 @@ maxby_lesser_%1$s: swap jump maxby_resume_%1$s
 maxby_done_%1$s:
 SPW
 
-    'minby' => 'maxby (%2$s push -1 mul)',
-    'each' => 'dup times (dup call roll %2$s push 1 sub) pop',
-    'count' => 'select (%2$s) dup call nslide',
+    'minby'  => 'maxby (%2$s push -1 mul)',
+    'each'   => 'dup times (dup call roll %2$s push 1 sub) pop',
+    'all'    => 'map (%2$s) reduce (add) push -11 load call eq',
+    # TODO: optimize any to stop early if possible
+    'any'    => 'map (%2$s) reduce (add) push 0 call gt',
+    'none'   => 'map (%2$s) reduce (add) push 0 call eq',
+    'count'  => 'select (%2$s) dup call nslide',
     'select' => generate_filter_spw('select', 0, 1),
     'reject' => generate_filter_spw('reject', 1, 0),
   }