import case import math ; divmod, ilog, max, pow import stack ; to_a import util ; gt, lt, neq, range
;;; String packing and unpacking
; convert a 0-terminated string on the stack to a single base-128 integer ; [0 … c b a] => [“abc…”] ; ; [0 99 98 97] => [“abc”] ; [0 99 98 97] => [1634657] ; [0] => [0] strpack: push 0 ; accumulator _strpack_loop:
swap dup jz _strpack_done copy 1 push 128 mul add slide 1 jump _strpack_loop
_strpack_done: pop :strrev ret
; convert a single base-128 integer to a 0-terminated string on the stack ; [“abc…”] => [0 … c b a] ; ; [“abc”] => [0 99 98 97] ; [1634657] => [0 99 98 97] ; [0] => [0] strunpack: :strrev push 0 swap ; terminator _strunpack_loop:
dup jz _strunpack_done dup push 128 mod swap push 128 div jump _strunpack_loop
_strunpack_done: pop ret
; returns the length of a packed string, which is just the ; value itself log-128, +1 if the integer logarithm isn't exact. ; [S] => [len(S)] ; ; [“”] => [0] ; [“abc”] => [3] ; [“foobar”] => [6] strlen: dup push 128 :ilog swap push 128 mod push 0 :neq add ret
; takes two packed strings and returns their concatenation (as a packed string) ; [S T] => [S+T] ; ; [“foo” “”] => [“foo”] ; [“” “foo”] => [“foo”] ; [“foo” “bar”] => [“foobar”] strcat: push 128 copy 2 :strlen :pow mul add ret
; reverses a packed string “in-place” ; [S] => [S'] ; ; [“foo”] => [“oof”] ; [“bark”] => [“krab”] ; [“ab”] => [“ba”] ['a'] => ['a'] [“”] => [“”] strrev: push 0 swap _strrev_loop:
dup jz _strrev_done swap push 128 mul copy 1 push 128 mod add swap push 128 div jump _strrev_loop
_strrev_done: pop ret
; takes a packed string S, a start index I, and a length L and returns the ; corresponding substring (simply by doing division with powers of 128; neat) ; [S I L] => [S'] ; ; [“foobar” 0 6] => [“foobar”] ; [“foobar” 1 4] => [“ooba”] ; [“foobar” 1 10] => [“oobar”] ; [“foobar” 5 1] => ['r'] ; [“foobar” 6 0] => [“”] strslice:
swap push 128 swap :pow copy 2 swap div swap push 128 swap :pow mod slide 1 ret
; returns the index I of substring T in string S (or -1 if not found) ; [S T] => [I] ; ; [“foobar” 'o'] => [1] ; [“foobar” “ob”] => [2] ; [“foobar” “”] => [0] ; [“foobar” “bar”] => [3] ; [“foobar” “bark”] => [-1] strindex: swap push 0 _strindex_loop: ; [t s i]
copy 1 copy 3 :strlen push 0 swap :strslice copy 3 sub jz _strindex_found push 1 add swap push 128 div dup jz _strindex_no swap jump _strindex_loop
_strindex_no: push -1 slide 3 ret _strindex_found: slide 2 ret
; returns the character C at index I in string S ; [S I] => [C] ; ; [“foobar” 1] => ['o'] ; [“foobar” 3] => ['b'] ; [“foobar” 5] => ['r'] ; [“foobar” 6] => [“”] charat: push 1 :strslice ret
; returns 1 if the character at the top of the stack is ; alphabetical (ASCII 65-90 or 97-122), 0 otherwise ; [C] => [0 | 1] ; ; ['@'] => [0] ['a'] => [1] ; ['z'] => [1] ['['] => [0] ; ['`'] => [0] ['A'] => [1] ; ['Z'] => [1] ['{'] => [0] isalpha:
dup push 123 :lt jz _isalpha_no dup push 64 :gt jz _isalpha_no push 32 mod $-- push 32 mod push 26 :lt ret
_isalpha_no: dup sub ret
; returns string S replicated N times ; [S N] => [S'] ; ; [“abc” 1] => [“abc”] ; [“abc” 2] => [“abcabc”] ; [“abc” 0] => [“”] strrep: push 0 swap _strrep_loop:
dup jz _strrep_done swap copy 2 :strcat swap push 1 sub jump _strrep_loop
_strrep_done: swap slide 2 ret
;;; String alignment
; helper function for ljustc and rjustc, since the only difference is whether ; we swap before calling strcat. _justc: swap copy 2 :strlen sub push 0 :max :strrep ret
; left-justifies string S to width W with character C ; [S W C] => [S'] ; ; [“foo” 5 'x'] => [“fooxx”] ; [“foobar” 4 'x'] => [“foobar”] ; [“” 3 'x'] => [“xxx”] ljustc: :_justc :strcat ret
; left-justifies string S to width W with spaces ; [S W] => [S'] ; ; [“foo” 5] => [“foo ”] ; [“foobar” 4] => [“foobar”] ; [“” 3] => [528416] ljust: push ' ' :ljustc ret
; right-justifies string S to width W with character C ; [S W C] => [S'] ; ; [“foo” 5 'x'] => [“xxfoo”] ; [“foobar” 4 'x'] => [“foobar”] ; [“” 3 'x'] => [“xxx”] rjustc: :_justc swap :strcat ret
; right-justifies string S to width W with spaces ; [S W C] => [S'] ; ; [“foo” 5] => [“ foo”] ; [“foobar” 4] => [“foobar”] ; [“” 3] => [528416] rjust: push ' ' :rjustc ret
; centers string S to width W with character C, favoring left alignment when ; there's a parity mismatch (even-length string to odd width or vice versa) ; ! TODO: This seems unnecessarily intricate, but perhaps just its nature. ; [S W C] => [S'] ; ; [“abc” 7 'x'] => [“xxabcxx”] ; [“abc” 6 'x'] => [“xabcxx”] ; [“abcd” 6 'o'] => [“oabcdo”] ; [“abcd” 7 'o'] => [“oabcdoo”] ; [“abcd” 3 '!'] => [“abcd”] centerc:
swap dup copy 3 :strlen sub push 0 :max push 2 div copy 2 swap :strrep copy 3 :strcat swap copy 1 :strlen sub push 0 :max copy 2 swap :strrep :strcat slide 2 ret
; centers string S to width W with spaces ; [S W] => [S'] ; ; [“abc” 7] => [“ abc ”] ; [“abc” 6] => [“ abc ”] ; [“abcd” 6] => [“ abcd ”] ; [“abcd” 7] => [“ abcd ”] ; [“abcd” 3] => [“abcd”] center: push ' ' :centerc ret
;;;
; removes the last character of a string ; [S] => [S'] ; ; [“foobar”] => [“fooba”] ; [“abc”] => [“ab”] ; [“a”] => [“”] ; [“”] => [“”] 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) ; ! TODO: permit string delimiter ; ! clobbers heap addresses -1 (strlen), -2, and -3 ; [S C] => [A] ; ; [“fooxbar” 'x'] => [“foo” “bar” 2] ; [“foobar” 'x'] => [“foobar” 1] ; [“foo|bar|baz” '|'] => [“foo” “bar” “baz” 3] ; [“foo,,bar” ','] => [“foo” “” “bar” 3] ; [“/foo/bar/” '/'] => [“” “foo” “bar” “” 4] strsplit:
push -3,1 store ; number of found substrings ^-2 ; stash delimiter to allow some stack juggling
_strsplit_loop:
dup dup @-2 :strindex dup jn _strsplit_done ; done when index of delimiter is -1 push 0 swap :strslice swap copy 1 @-3 swap :strlen swap push -3 swap push 1 add store ; update number of found push 1 add push 128 swap :pow div ; shrink haystack jump _strsplit_loop
_strsplit_done: push 2 sub slide 1 load ret
; splits the string S on newlines lines: push 10 :strsplit ret
; joins the pseudo-array of strings A into string S with delimiter string D ; ! clobbers heap address -2 (and strlen uses -1) ; [A D] => [S] ; ; [“foo” “bar” 2 'x'] => [“fooxbar”] ; [“foo” “bar” “baz” 3 '–'] => [“foo–bar–baz”] ; [“foo” 1 “?!”] => [“foo”] strjoinc:
dup :strlen pop ^-2 ; get delimiter length into -1 map (@-2 :strcat) ; add delimiter to all elements swap push 128 copy 1 :strlen @-2 :strlen sub :pow mod swap ; remove delimiter from last and flow into strjoin
; concatenates the pseudo-array of strings A into string S ; [A] => [S] ; ; [“foo” 1] => [“foo”] ; [“foo” “bar” 2] => [“foobar”] ; [“foo” 'x' “bar” 'x' “baz” 5] => [“fooxbarxbaz”] strjoin: reduce (:strcat) ret
; returns the number of ocurrences of character C in string S ; [S C] => [N] ; ; [“foobar” 'a'] => [1] ; [“foobar” 'o'] => [2] ; [“foobar” 'c'] => [0] strcountc: swap push 0 swap _strcountc_loop:
dup jz _strcountc_done dup push 128 mod copy 3 sub jz _strcountc_yes push 128 div jump _strcountc_loop
_strcountc_yes:
swap push 1 add swap push 128 div jump _strcountc_loop
_strcountc_done: swap slide 2 ret
; returns the total number of ocurrences of all characters in string T in string S ; [S T] => [N] ; ! clobbers heap address -2 ; ; [“foobar” 'o'] => [2] ; [“foobar” “ob”] => [3] ; [“foxboar” “box”] => [4] ; [“eunoia” “aeiou”] => [5] ; [“why” “aeiou”] => [0] strcount:
swap ^-2 :strunpack push 0 :to_a map (@-2 swap :strcountc) reduce (add) ret
; translates all characters in A to the corresponding characters in B ; 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'] ; ; [“abcd” “abc” “xyz”] => [“xyzd”] ; [“foobar” “oba” “ele”] => [“feeler”] ; [“abcdcba” “abcd” “xyz|”] => [“xyz|zyx”] strtrans: ^-3 ^-2
dup :strlen ^-1 :strunpack @-1 map (:_strtrans) pop :strpack ret
_strtrans:
dup @-2 swap :strindex dup jn _strtrans_no @-3 swap :charat slide 1 ret
_strtrans_no: pop ret
; expands the length-2 string S to contain the intervening ASCII characters ; ! TODO: make this smarter; multiple ranges in one string ; [S] => [S'] ; ; [“CJ”] => [“CDEFGHIJ”] ; [“DA”] => [“DCBA”] ; [“af”] => [“abcdef”] ; [“09”] => [“0123456789”] ; [“90”] => [“9876543210”] ; [“(1”] => [“()*+,-./01”] strexpand:
push 0 swap push 128 :divmod swap :range :strpack :strrev ret
; “squeezes” runs of the same character in string S to just one occurrence ; [S] => [S'] ; ; [“abc”] => [“abc”] ; [“foobar”] => [“fobar”] ; [“bookkeeper”] => [“bokeper”] ; [“xxxxxxx”] => [“x”] strsqueeze: push 0 swap _strsqueeze_loop: ; [s]
dup jz _strsqueeze_done push 128 :divmod dup copy 3 sub jz _strsqueeze_skip swap jump _strsqueeze_loop
_strsqueeze_skip: pop jump _strsqueeze_loop _strsqueeze_done: pop :strpack :strrev ret
$_strdel(cmp) {
:strunpack @-1 :strlen select (@-2 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] ; [“”] => [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'] ; ; [“abc” 0] => [“abc”] ; [“abcd” 1] => [“bcda”] ; [“abcd” 5] => [“bcda”] ; [“foodbar” 4] => [“barfood”] 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'] ; ; [“abcd” 1] => [“dabc”] ; [“abcd” 5] => [“dabc”] ; [“foodbar” 3] => [“barfood”] strrotr: push -1 mul :strrotl ret
; gets the characters of the string S onto the stack as a pseudo-array, but ; with a leading 0 on the assumption that it'll eventually be repacked ; ; [“abc”] => [0 99 98 97 3] strtoa: dup :strlen pop :strunpack @-1 $++ ret
; frobnicates the string S by XORing all its bytes with 42 ; [S] => [S'] ; ; [“foobar”] => [“LEEHKX”] ; [“LEEHKX”] => [“foobar”] memfrob: :strtoa map (push 42 :bxor) pop :strpack ret
; returns 1 if the string S begins with substring T, 0 otherwise ; [S T] => [0 | 1] ; ; [“foobar” “foo”] => [1] ; [“foobar” “boo”] => [0] ; [“abc123” “123”] => [0] ; [“ foo” “ ”] = [1] strbegins?:
dup :strlen copy 2 swap push 0 swap :strslice :eq slide 1 ret
; returns 1 if the string S ends with substring T, 0 otherwise ; [S T] => [0 | 1] ; ; [“foobar” “bar”] => [1] ; [“foobar” “foo”] => [0] ; [“abc123” “abc”] => [0] ; [“foo ” “ ”] = [1] strends?:
:strrev dup :strlen copy 2 :strrev swap push 0 swap :strslice :eq slide 1 ret