!import "base.tri" !Local

_ = t

matchList = a b : triage a _ b

emptyList? = matchList true (_ _ : false)
head = matchList t (head _ : head)
tail = matchList t (_ tail : tail)

append = y (self : matchList
  (k : k)
  (h r k : pair h (self r k)))

lExist? = y (self x : matchList
  false
  (h z : or? (equal? x h) (self x z)))

map_ = y (self :
  matchList
    (_ : t)
    (head tail f : pair (f head) (self tail f)))
map = f l : map_ l f

filter_ = y (self : matchList
  (_ : t)
  (head tail f : matchBool (t head) id (f head) (self tail f)))
filter  = f l : filter_ l f

foldl_ = y (self l f x : matchList (acc : acc) (head tail acc : self tail f (f acc head)) l x)
foldl  = f x l : foldl_ l f x

foldr_ = y (self l f x : matchList x (head tail : f (self tail f x) head) l)
foldr  = f x l : foldr_ l f x

length = y (self : matchList
  0
  (_ tail : succ (self tail)))

reverse_ = y (self xs acc :
  matchList
    acc
    (h r : self r (pair h acc))
    xs)

reverse = xs : reverse_ xs t

snoc = y (self x : matchList
  (pair x t)
  (h z : pair h (self x z)))

count = y (self x : matchList
  0
  (h z : matchBool
    (succ (self x z))
    (self x z)
    (equal? x h)))

last = y (self : matchList
  t
  (hd tl : matchBool
    hd
    (self tl)
    (emptyList? tl)))

all? = y (self pred : matchList
  true
  (h z : and? (pred h) (self pred z)))

any? = y (self pred : matchList
  false
  (h z : or? (pred h) (self pred z)))

intersect = xs ys : filter (x : lExist? x ys) xs

nth_ = y (self n xs i :
  matchList
    t
    (h r :
      matchBool
        h
        (self n r (succ i))
        (equal? i n))
    xs)

nth = n xs : nth_ n xs 0

headMaybe = matchList nothing (h _ : just h)

lastMaybe = y (self : matchList
  nothing
  (hd tl : matchBool
    (just hd)
    (self tl)
    (emptyList? tl)))

nthMaybe_ = y (self n xs i :
  matchList
    nothing
    (h r :
      matchBool
        (just h)
        (self n r (succ i))
        (equal? i n))
    xs)

nthMaybe = n xs : nthMaybe_ n xs 0

take_ = y (self n xs i :
  matchList
    t
    (h r :
      matchBool
        t
        (pair h (self n r (succ i)))
        (equal? i n))
    xs)

take = n xs : take_ n xs 0

drop_ = y (self n xs i :
  matchBool
    xs
    (matchList
      t
      (_ r : self n r (succ i))
      xs)
    (equal? i n))

drop = n xs : drop_ n xs 0

splitAt = n xs : pair (take n xs) (drop n xs)

concatMap_ = y (self f xs :
  matchList
    t
    (h r : append (f h) (self f r))
    xs)

concatMap = f xs : concatMap_ f xs

find = y (self pred xs :
  matchList
    nothing
    (h r : matchBool (just h) (self pred r) (pred h))
    xs)

partition_ = y (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 : partition_ pred xs t t

strLength = length
strAppend = append
strEq? = equal?
strEmpty? = emptyList?

startsWith? = y (self prefix str :
  matchList
    true
    (ph pr :
      matchList
        false
        (sh sr :
          matchBool
            (self pr sr)
            false
            (equal? ph sh))
        str)
    prefix)

endsWith? = prefix str : startsWith? (reverse prefix) (reverse str)

contains? = y (self needle haystack :
  matchBool
    true
    (matchList
      false
      (_ r : self needle r)
      haystack)
    (startsWith? needle haystack))

lines_ = y (self str :
  matchList
    (acc current : snoc (reverse current) acc)
    (h r :
      acc current :
      matchBool
        (self r (snoc (reverse current) acc) t)
        (self r acc (pair h current))
        (equal? h 10))
    str)

lines = str : lines_ str t t

unlines = y (self lines :
  matchList
    ""
    (h r : append h (append "\n" (self r)))
    lines)

words_ = y (self str :
  matchList
    (acc current :
      matchBool
        acc
        (snoc (reverse current) acc)
        (emptyList? current))
    (h r :
      acc current :
      matchBool
        (matchBool
          (self r acc current)
          (self r (snoc (reverse current) acc) t)
          (emptyList? current))
        (self r acc (pair h current))
        (equal? h 32))
    str)

words = str : words_ str t t

unwords = y (self words :
  matchList
    ""
    (h r :
      matchBool
        h
        (append h (append " " (self r)))
        (emptyList? r))
    words)

zipWith = y (self f xs ys :
  matchList
    t
    (xh xt :
      matchList
        t
        (yh yt : pair (f xh yh) (self f xt yt))
        ys)
    xs)