343 lines
7.3 KiB
Plaintext
343 lines
7.3 KiB
Plaintext
!import "base" !Local
|
|
|
|
_ = t
|
|
|
|
matchList = a b : triage a _ b
|
|
|
|
emptyList? = matchList true (_ _ : false)
|
|
head = matchList t (head _ : head)
|
|
tail = matchList t (_ tail : tail)
|
|
|
|
append_ self xs ys =
|
|
matchList
|
|
ys
|
|
(h r : pair h (self r ys))
|
|
xs
|
|
append = xs ys : y append_ xs ys
|
|
|
|
lExist?_ self x xs =
|
|
matchList
|
|
false
|
|
(h r : or? (equal? x h) (self x r))
|
|
xs
|
|
lExist? = x xs : y lExist?_ x xs
|
|
|
|
map_ self l f =
|
|
matchList
|
|
t
|
|
(h r : pair (f h) (self r f))
|
|
l
|
|
map = f l : y map_ l f
|
|
|
|
filter_ self l f =
|
|
matchList
|
|
t
|
|
(h r :
|
|
matchBool
|
|
(pair h (self r f))
|
|
(self r f)
|
|
(f h))
|
|
l
|
|
filter = f l : y filter_ l f
|
|
|
|
foldl_ self l f acc =
|
|
matchList
|
|
acc
|
|
(h r : self r f (f acc h))
|
|
l
|
|
foldl = f x l : y foldl_ l f x
|
|
|
|
foldr_ self l f x =
|
|
matchList
|
|
x
|
|
(h r : f (self r f x) h)
|
|
l
|
|
foldr = f x l : y foldr_ l f x
|
|
|
|
length_ self xs =
|
|
matchList
|
|
0
|
|
(_ r : succ (self r))
|
|
xs
|
|
length = xs : y length_ xs
|
|
|
|
reverse_ self xs acc =
|
|
matchList
|
|
acc
|
|
(h r : self r (pair h acc))
|
|
xs
|
|
reverse = xs : y reverse_ xs t
|
|
|
|
snoc_ self x xs =
|
|
matchList
|
|
(pair x t)
|
|
(h r : pair h (self x r))
|
|
xs
|
|
snoc = x xs : y snoc_ x xs
|
|
|
|
count_ self x xs =
|
|
matchList
|
|
0
|
|
(h r :
|
|
matchBool
|
|
(succ (self x r))
|
|
(self x r)
|
|
(equal? x h))
|
|
xs
|
|
count = x xs : y count_ x xs
|
|
|
|
last_ self xs =
|
|
matchList
|
|
t
|
|
(h r :
|
|
matchBool
|
|
h
|
|
(self r)
|
|
(emptyList? r))
|
|
xs
|
|
last = xs : y last_ xs
|
|
|
|
all?_ self pred xs =
|
|
matchList
|
|
true
|
|
(h r : and? (pred h) (self pred r))
|
|
xs
|
|
all? = pred xs : y all?_ pred xs
|
|
|
|
any?_ self pred xs =
|
|
matchList
|
|
false
|
|
(h r : or? (pred h) (self pred r))
|
|
xs
|
|
any? = pred xs : y any?_ pred xs
|
|
|
|
intersect = xs ys : filter (x : lExist? x ys) xs
|
|
|
|
nth_ self xs n i =
|
|
matchList
|
|
t
|
|
(h r :
|
|
matchBool
|
|
h
|
|
(self r n (succ i))
|
|
(equal? i n))
|
|
xs
|
|
nth = n xs : y nth_ xs n 0
|
|
|
|
headMaybe = matchList nothing (h _ : just h)
|
|
|
|
lastMaybe_ self xs =
|
|
matchList
|
|
nothing
|
|
(h r :
|
|
matchBool
|
|
(just h)
|
|
(self r)
|
|
(emptyList? r))
|
|
xs
|
|
lastMaybe = xs : y lastMaybe_ xs
|
|
|
|
nthMaybe_ self xs n i =
|
|
matchList
|
|
nothing
|
|
(h r :
|
|
matchBool
|
|
(just h)
|
|
(self r n (succ i))
|
|
(equal? i n))
|
|
xs
|
|
nthMaybe = n xs : y nthMaybe_ xs n 0
|
|
|
|
take_ self xs n i =
|
|
matchList
|
|
t
|
|
(h r :
|
|
matchBool
|
|
t
|
|
(pair h (self r n (succ i)))
|
|
(equal? i n))
|
|
xs
|
|
take = n xs : y take_ xs n 0
|
|
|
|
drop_ self xs n i =
|
|
matchBool
|
|
xs
|
|
(matchList
|
|
t
|
|
(_ r : self r n (succ i))
|
|
xs)
|
|
(equal? i n)
|
|
drop = n xs : y drop_ xs n 0
|
|
|
|
splitAt = n xs : pair (take n xs) (drop n xs)
|
|
|
|
concatMap_ self f xs =
|
|
matchList
|
|
t
|
|
(h r : append (f h) (self f r))
|
|
xs
|
|
concatMap = f xs : y concatMap_ f xs
|
|
|
|
find_ self pred xs =
|
|
matchList
|
|
nothing
|
|
(h r :
|
|
matchBool
|
|
(just h)
|
|
(self pred r)
|
|
(pred h))
|
|
xs
|
|
find = pred xs : y find_ pred xs
|
|
|
|
partition_ self pred xs trues falses =
|
|
matchList
|
|
(pair (reverse trues) (reverse falses))
|
|
(h r :
|
|
matchBool
|
|
(self pred r (pair h trues) falses)
|
|
(self pred r trues (pair h falses))
|
|
(pred h))
|
|
xs
|
|
partition = pred xs : y partition_ pred xs t t
|
|
|
|
strLength = length
|
|
strAppend = append
|
|
strEq? = equal?
|
|
strEmpty? = emptyList?
|
|
|
|
startsWith?_ self prefix input =
|
|
matchList
|
|
true
|
|
(ph pr :
|
|
matchList
|
|
false
|
|
(sh sr :
|
|
matchBool
|
|
(self pr sr)
|
|
false
|
|
(equal? ph sh))
|
|
input)
|
|
prefix
|
|
startsWith? = prefix input : y startsWith?_ prefix input
|
|
|
|
endsWith? = prefix str : startsWith? (reverse prefix) (reverse str)
|
|
|
|
contains?_ self needle haystack =
|
|
matchBool
|
|
true
|
|
(matchList
|
|
false
|
|
(_ r : self needle r)
|
|
haystack)
|
|
(startsWith? needle haystack)
|
|
contains? = needle haystack : y contains?_ needle haystack
|
|
|
|
sum = foldl (acc x : add x acc) 0
|
|
product = foldl (acc x : mul x acc) 1
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Generic separators
|
|
--
|
|
-- `lines`, `unlines`, `words` and `unwords` at the bottom of this section are
|
|
-- the byte-valued special cases of these primitives.
|
|
--
|
|
-- Joining takes any separator; splitting takes one byte. Separators are removed
|
|
-- rather than kept, and empty fields are preserved.
|
|
--
|
|
-- The workers below follow notes/tricu-normalization-rules.md: consumed data
|
|
-- first, lazy eliminators around every recursive branch, `y` only inside the
|
|
-- public wrapper, and `pair`-only state updates.
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
takeWhile_ self xs f =
|
|
lazyList
|
|
(_ : t)
|
|
(h r :
|
|
lazyBool
|
|
(_ : pair h (self r f))
|
|
(_ : t)
|
|
(f h))
|
|
xs
|
|
takeWhile = f xs : y takeWhile_ xs f
|
|
|
|
dropWhile_ self xs f =
|
|
lazyList
|
|
(_ : t)
|
|
(h r :
|
|
lazyBool
|
|
(_ : self r f)
|
|
(_ : pair h r)
|
|
(f h))
|
|
xs
|
|
dropWhile = f xs : y dropWhile_ xs f
|
|
|
|
-- Byte-level whitespace only: space and horizontal tab (HTTP OWS).
|
|
spaceByte? = b : equal? b 32
|
|
tabByte? = b : equal? b 9
|
|
trimByte? = b : or? (spaceByte? b) (tabByte? b)
|
|
|
|
trim = xs : dropWhile trimByte? (reverse (dropWhile trimByte? (reverse xs)))
|
|
|
|
intercalate_ self xs sep =
|
|
lazyList
|
|
(_ : t)
|
|
(h r :
|
|
lazyBool
|
|
(_ : h)
|
|
(_ : append h (append sep (self r sep)))
|
|
(emptyList? r))
|
|
xs
|
|
intercalate = sep xs : y intercalate_ xs sep
|
|
|
|
-- Separator after every field, including the last one. Line-oriented formats
|
|
-- want this: `joinSuffix "\n" xs` terminates the final line while
|
|
-- `intercalate "\n" xs` does not.
|
|
joinSuffix_ self xs sep =
|
|
lazyList
|
|
(_ : t)
|
|
(h r : append (append h sep) (self r sep))
|
|
xs
|
|
joinSuffix = sep xs : y joinSuffix_ xs sep
|
|
|
|
-- Split on a single byte. A separator byte is never stored, so the state
|
|
-- updates stay `pair`s and every recursive argument is a variable: the input is
|
|
-- walked exactly once and the fields are reversed back once, when it ends.
|
|
--
|
|
-- Splitting on a multi-byte separator is deliberately not here. Detecting a
|
|
-- separator longer than a byte means re-walking the remaining input at every
|
|
-- split point (or splicing the field), which is quadratic in the best case and
|
|
-- blew up when tried. `http.tri` wants CRLF and `:` splits; that wants a shape
|
|
-- where the separator drives the recursion instead of the input.
|
|
--
|
|
-- Empty fields are preserved: `splitOnByte 58 "a::b"` is ["a" "" "b"].
|
|
splitByte_ self str byte acc current =
|
|
lazyList
|
|
(_ : map reverse (reverse (pair current acc)))
|
|
(h r :
|
|
lazyBool
|
|
(_ : self r byte (pair current acc) t)
|
|
(_ : self r byte acc (pair h current))
|
|
(equal? h byte))
|
|
str
|
|
splitOnByte = byte str : y splitByte_ str byte t t
|
|
|
|
-- Every one of these keeps its arguments bound: partially applying a
|
|
-- multi-argument function at the top level leaves a fixed point exposed.
|
|
lines = str : splitOnByte 10 str
|
|
unlines = xs : joinSuffix "\n" xs
|
|
|
|
-- Runs of separators collapse: empty fields are dropped.
|
|
words = str : filter (w : not? (emptyList? w)) (splitOnByte 32 str)
|
|
unwords = xs : intercalate " " xs
|
|
|
|
zipWith_ self f xs ys =
|
|
matchList
|
|
t
|
|
(xh xt :
|
|
matchList
|
|
t
|
|
(yh yt : pair (f xh yh) (self f xt yt))
|
|
ys)
|
|
xs
|
|
zipWith = f xs ys : y zipWith_ f xs ys
|