--
--
-- Collection
--
--

--
-- List
--
list a :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | $ :: $ as (a, list a) with
      | $x :: $xs -> [(x, xs)]
      | _ -> []
    | snoc $ $ as (a, list a) with
      | snoc $xs $x -> [(x, xs)]
      | _ -> []
    | _ ++ $ as (list a) with
      | $tgt ->
        matchAll tgt as list a with
          | loop $i (1, _)
              (_ :: ...)
              $rs -> rs
    | $ ++ $ as (list a, list a) with
      | $tgt ->
        matchAll tgt as list a with
          | loop $i (1, $n)
              ($xa_i :: ...)
              $rs -> (foldr (\%i %r -> xa_i :: r) [] [1..n], rs)
    | nioj $ $ as (list a, list a) with
      | $tgt ->
        matchAll tgt as list a with
          | loop $i (1, $n)
              (snoc $xa_i ...)
              $rs -> (foldr (\%i %r -> r ++ [xa_i]) [] [1..n], rs)
    | #$val as () with
      | $tgt -> if val = tgt then [()] else []
    | $ as (something) with
      | $tgt -> [tgt]

sortedList a :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | $ ++ #$px :: $ as (sortedList a, sortedList a) with
      | $tgt ->
        matchAll tgt as list a with
          | loop $i (1, $n)
              ((?(< px) & $xa_i) :: ...)
              (#px :: $rs) -> (map (\i -> xa_i) [1..n], rs)
    | $ ++ $ as (sortedList a, sortedList a) with
      | $tgt ->
        matchAll tgt as list a with
          | loop $i (1, $n)
              ($xa_i :: ...)
              $rs -> (map (\i -> xa_i) [1..n], rs)
    | $ :: $ as (a, sortedList a) with
      | $x :: $xs -> [(x, xs)]
      | _ -> []
    | #$val as () with
      | $tgt -> if val = tgt then [()] else []
    | $ as (something) with
      | $tgt -> [tgt]

--
-- Accessors
--
nth n xs :=
  match xs as list something with
    | loop $i (1, n - 1, _)
        (_ :: ...)
        ($x :: _) -> x

takeAndDrop n xs :=
  match xs as list something with
    | loop $i (1, n, _)
        ($a_i :: ...)
        $rs -> (map (\i -> a_i) [1..n], rs)

take n xs :=
  if n = 0
    then []
    else match xs as list something with
      | $x :: $xs -> x :: take (n - 1) xs
      | [] -> []

drop n xs :=
  if n = 0
    then xs
    else match xs as list something with
      | _ :: $xs -> drop (n - 1) xs
      | [] -> []

takeWhile pred xs :=
  match xs as list something with
    | [] -> []
    | $x :: $rs -> if pred x then x :: takeWhile pred rs else []

takeWhileBy pred xs :=
  match xs as list something with
    | [] -> []
    | $x :: $rs -> if pred x then x :: takeWhileBy pred rs else [x]

taileUntil pred xs :=
  match xs as list something with
    | [] -> []
    | $x :: $rs -> if not (pred x) then x :: takeUntil pred rs else []

takeUntilBy pred xs :=
  match xs as list something with
    | [] -> []
    | $x :: $rs -> if not (pred x) then x :: takeUntilBy pred rs else [x]

dropWhile pred xs :=
  match xs as list something with
    | [] -> []
    | $x :: $rs -> if pred x then dropWhile pred rs else xs

--
-- head, tail, uncons, unsnoc
--
head xs :=
  match xs as list something with
    | $x :: _ -> x

tail xs :=
  match xs as list something with
    | _ :: $ys -> ys

last xs :=
  match xs as list something with
    | snoc $x _ -> x

init xs :=
  match xs as list something with
    | snoc _ $ys -> ys

uncons xs :=
  match xs as list something with
    | $x :: $ys -> (x, ys)

unsnoc xs :=
  match xs as list something with
    | snoc $x $ys -> (ys, x)


--
-- list functions
--
isEmpty xs :=
  match xs as list something with
    | [] -> True
    | _  -> False

length xs := foldl 2#(%1 + 1) 0 xs

map fn xs :=
  match xs as list something with
    | [] -> []
    | $x :: $rs -> fn x :: map fn rs

map2 fn xs ys :=
  match (xs, ys) as (list something, list something) with
    | ([], _) -> []
    | (_, []) -> []
    | ($x :: $xs2, $y :: $ys2) -> fn x y :: map2 fn xs2 ys2

map3 fn xs ys zs :=
  match (xs, ys, zs) as (list something, list something, list something) with
    | ([], _, _) -> []
    | (_, [], _) -> []
    | (_, _, []) -> []
    | ($x :: $xs2, $y :: $ys2, $z :: $zs2) -> fn x y z :: map3 fn xs2 ys2 zs2

map4 fn xs ys zs ws :=
  match (xs, ys, zs, ws) as
    (list something, list something, list something, list something) with
    | ([], _, _, _) -> []
    | (_, [], _, _) -> []
    | (_, _, [], _) -> []
    | (_, _, _, []) -> []
    | ($x :: $xs2, $y :: $ys2, $z :: $zs2, $w :: $ws2) ->
      fn x y z w :: map4 fn xs2 ys2 zs2 ws2

filter pred xs := foldr (\%y %ys -> if pred y then y :: ys else ys) [] xs

partition pred xs := (filter pred xs, filter 1#(not (pred %1)) xs)

zip xs ys := map2 (\x y -> (x, y)) xs ys

zip3 xs ys zs := map3 (\x y z -> (x, y, z)) xs ys zs

zip4 xs ys zs ws := map4 (\x y z w -> (x, y, z, w)) xs ys zs ws

lookup k ls :=
  match ls as list (something, something) with
    | _ ++ (#k, $x) :: _ -> x

foldr fn %init %ls :=
  match ls as list something with
    | [] -> init
    | $x :: $xs -> fn x (foldr fn init xs)

foldl fn %init %ls :=
  match ls as list something with
    | [] -> init
    | $x :: $xs ->
      let z := fn init x
       in seq z (foldl fn z xs)

foldl1 fn %ls := foldl fn (head ls) (tail ls)

reduce fn %ls := foldl fn (head ls) (tail ls)

scanl fn %init %ls :=
  init :: (match ls as list something with
    | [] -> []
    | $x :: $xs -> scanl fn (fn init x) xs)

iterate fn %x :=
  let nx1 := fn x
      nx2 := fn nx1
      nx3 := fn nx2
      nx4 := fn nx3
      nx5 := fn nx4
   in x :: nx1 :: nx2 :: nx3 :: nx4 :: iterate fn nx5

repeatedSquaring fn %x n :=
  match n as integer with
    | #1 -> x
    | ?isEven ->
      let y := repeatedSquaring fn x (quotient n 2)
       in fn y y
    | ?isOdd ->
      let y := repeatedSquaring fn x (quotient n 2)
       in fn (fn y y) x

append xs ys := xs ++ ys

concat xss := foldr (\%xs %rs -> xs ++ rs) [] xss

reverse xs :=
  match xs as list something with
    | [] -> []
    | snoc $x $rs -> x :: reverse rs

intersperse sep ws :=
  match ws as list something with
    | [] -> []
    | $w :: $rs -> foldl (\s1 s2 -> s1 ++ [sep, s2]) [w] rs

intercalate := compose intersperse concat

split sep ls :=
  match ls as list something with
    | $xs ++ #sep ++ $rs -> xs :: split sep rs
    | _ -> [ls]

splitAs a sep ls :=
  match ls as list a with
    | $xs ++ #sep ++ $rs -> xs :: splitAs a sep rs
    | _ -> [ls]

findCycle xs :=
  head
    (matchAll xs as list something with
      | $ys ++ (_ :: _ & $cs) ++ #cs ++ _ -> (ys, cs))

repeat %xs := xs ++ repeat xs

repeat1 %x := x :: repeat1 x

--
-- Others
--
all pred xs :=
  match xs as list something with
    | [] -> True
    | $x :: $rs -> if pred x then all pred rs else False

any pred xs :=
  match xs as list something with
    | [] -> False
    | $x :: $rs -> if pred x then True else any pred rs

from s :=
  [s, s + 1, s + 2, s + 3, s + 4, s + 5, s + 6, s + 7, s + 8, s + 9, s + 10] ++
    from (s + 11)

-- Note. `between` is used in the definition of the list matcher.
between s e :=
  if s = e then [s] else if s < e then s :: between (s + 1) e else []

L./ xs ys :=
  if length xs < length ys
    then ([], xs)
    else match (ys, xs) as (list mathExpr, list mathExpr) with
      | ($y :: $yrs, $x :: $xrs) ->
        let (zs, rs) := L./
                          (map2
                             (-)
                             (take (length yrs) xrs)
                             (map 1#(%1 * (x / y)) yrs) ++ drop (length yrs) xrs)
                          ys
         in (x / y :: zs, rs)

--
-- Multiset
--
multiset a :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | $ :: _ as (a) with
      | $tgt -> tgt
    | $ :: $ as (a, multiset a) with
      | $tgt ->
        matchAll tgt as list a with
          | $hs ++ $x :: $ts -> (x, hs ++ ts)
    | #$pxs ++ $ as (multiset a) with
      | $tgt ->
        match (pxs, tgt) as (list a, multiset a) with
          | loop $i (1, length pxs, _)
              {($x_i :: @, #x_i :: @), ...}
              ([], $rs) -> [rs]
          | _ -> []
    | $ ++ $ as (multiset a, multiset a) with
      | $tgt ->
        matchAll tgt as list a with
          | loop $i (1, $n)
              ($rs_i ++ $x_i :: ...)
              $ts ->
            (map (\i -> x_i) [1..n], concat (map (\i -> rs_i) [1..n] ++ [ts]))
    | #$val as () with
      | $tgt ->
        match (val, tgt) as (list a, multiset a) with
          | ([], []) -> [()]
          | ($x :: $xs, #x :: #xs) -> [()]
          | (_, _) -> []
    | $ as (something) with
      | $tgt -> [tgt]

--
-- multiset operation
--
deleteFirst %x xs :=
  match xs as list something with
    | [] -> []
    | #x :: $rs -> rs
    | $y :: $rs -> y :: deleteFirst x rs

deleteFirstAs a %x xs :=
  match xs as list a with
    | [] -> []
    | #x :: $rs -> rs
    | $y :: $rs -> y :: deleteFirstAs a x rs

delete x xs :=
  match xs as list something with
    | [] -> []
    | $hs ++ #x :: $ts -> hs ++ delete x ts
    | _ -> xs

deleteAs a x xs :=
  match xs as list a with
    | [] -> []
    | $hs ++ #x :: $ts -> hs ++ deleteAs a x ts
    | _ -> xs

difference xs ys :=
  match ys as list something with
    | [] -> xs
    | $y :: $rs -> difference (deleteFirst y xs) rs

differenceAs a xs ys :=
  match ys as list a with
    | [] -> xs
    | $y :: $rs -> differenceAs a (deleteFirstAs a y xs) rs

include xs ys :=
  match ys as list something with
    | [] -> True
    | $y :: $rs ->
      if member y xs then include (deleteFirst y xs) rs else False

includeAs a xs ys :=
  match ys as list a with
    | [] -> True
    | $y :: $rs ->
      if memberAs a y xs then includeAs a (deleteFirst y xs) rs else False

union xs ys :=
  xs ++ (matchAll (ys, xs) as (multiset something, multiset something) with
    | ($y :: _, !(#y :: _)) -> y)

unionAs a xs ys :=
  xs ++ (matchAll (ys, xs) as (multiset a, multiset a) with
    | ($y :: _, !(#y :: _)) -> y)

intersect xs ys :=
  matchAll (xs, ys) as (multiset something, multiset something) with
    | ($x :: _, #x :: _) -> x

intersectAs a xs ys :=
  matchAll (xs, ys) as (multiset a, multiset a) with
    | ($x :: _, #x :: _) -> x

--
-- Simple predicate
--
member x ys :=
  match ys as list something with
    | _ ++ #x :: _ -> True
    | _ -> False

memberAs a x ys :=
  match ys as list a with
    | _ ++ #x :: _ -> True
    | _ -> False

--
-- Counting
--
count x xs :=
  foldl
    (\match as (something, something) with
      | ($r, #x) -> r + 1
      | ($r, $y) -> r)
    0
    xs

countAs a x xs :=
  foldl
    (\match as (a, a) with
      | ($r, #x) -> r + 1
      | ($r, $y) -> r)
    0
    xs

frequency xs :=
  let us := unique xs
   in map (\u -> (u, count u xs)) us

frequencyAs a xs :=
  let us := uniqueAs a xs
   in map (\u -> (u, countAs a u xs)) us

--
-- Index
--
elemIndices x xs :=
  matchAll xs as list something with
    | $hs ++ #x :: _ -> 1 + length hs

--
-- Set
--
set a :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | $ :: $ as (a, set a) with
      | $tgt ->
        matchAll tgt as list a with
          | _ ++ $x :: _ -> (x, tgt)
    | #$pxs ++ $ as (set a) with
      | $tgt ->
        match (pxs, tgt) as (list a, set a) with
          | ( loop $i (1, $n) ($x_i :: ...) []
            , loop $i (1, n)  (#x_i :: ...) _ ) -> [tgt]
          | _ -> []
    | $ ++ $ as (set a, set a) with
      | $tgt ->
        matchAll tgt as list a with
          | loop $i (1, $n)
              ($rs_i ++ $x_i :: ...)
              $ts -> (map (\i -> x_i) [1..n], tgt)
    | #$val as () with
      | $tgt ->
        match (unique val, unique tgt) as (list a, multiset a) with
          | ([], []) -> [()]
          | ($x :: $xs, #x :: #xs) -> [()]
          | (_, _) -> []
    | $ as (something) with
      | $tgt -> [tgt]

--
-- set operation
--
add x xs := if member x xs then xs else xs ++ [x]

addAs a x xs := if memberAs a x xs then xs else xs ++ [x]

fastUnique xs :=
  matchAll sort xs as list something with
    | _ ++ $x :: !(#x :: _) -> x

unique xs :=
  reverse
    (matchAll reverse xs as list something with
      | _ ++ $x :: !(_ ++ #x :: _) -> x)

uniqueAs a xs := loopFn xs []
  where
    loopFn xs ys :=
      match (xs, ys) as (list a, multiset a) with
        | ([], _) -> ys
        | ($x :: $rs, #x :: _) -> loopFn rs ys
        | ($x :: $rs, _) -> loopFn rs (ys ++ [x])