--
-- Syntax test
--

--
-- Primitive Data
--

assertEqual "char literal"
  ['a', '\n', '\'']
  ['a', '\n', '\'']

assertEqual "string literal" "" ""
assertEqual "string literal" "abc\n" "abc\n"

assertEqual "bool literal"
  [True, False]
  [True, False]

assertEqual "integer literal"
  [1, 0, -100, 1 - 100]
  [1, 0, -100, -99]

assertEqual "rational number"
  [10 / 3, 10 / 20, -1 / 2]
  [10 / 3 , 1 / 2, -1 / 2]

assertEqual "float literal" [1.0, 0.0, -100.012001, 1.0 + 2] [1.0, 0.0, -100.012001, 3.0]

assertEqual "inductive data literal" A A

assertEqual "tuple literal" (1, 2, 3) (1, 2, 3)

assertEqual "collection literal" [1, 2, 3, 4, 5, 6] [1, 2, 3, 4, 5, 6]

assertEqual "collection between" [1..5] [1, 2, 3, 4, 5]
assertEqual "collection from" (take 5 [1..]) [1, 2, 3, 4, 5]

--
-- Basic Sytax
--

assertEqual "if"
  (if True then True else False)
  True

assertEqual "if"
  (if False then True else False)
  False

assertEqual "let binding"
  (let t := (1, 2)
       (x, y) := t
    in x + y)
  3

assertEqual "let binding"
  (let x := 1
       y := x + 1
    in y)
  2

assertEqual "let binding without newline"
  (let { x := 1; y := x + 1 } in y)
  2

io do print "io and do expression"
      return 0

io do { print "io and do expression without newline"; return 0 }

assertEqual "where"
  (f 0 + y + 1
    where f x := 2 + x
          y := 3)
  6

assertEqual "nested where"
  (f 0 + 1
    where
      f x := 2 + y + z
        where y := 3
      z := 4)
  10

assertEqual "multiple where in one expression"
  (matchAll [1, 2, 3] as multiset integer with
   | #1 :: $xs -> f xs
     where f xs := length xs
   | #2 :: #3 :: $xs -> g xs
     where g xs := length xs)
  [2, 1]

assertEqual "mutual recursion"
  (let even? n := if n = 0 then True else odd? (n - 1)
       odd?  n := if n = 0 then False else even? (n - 1)
    in even? 10)
  True

assertEqual "lambda and application"
  ((\x -> x + 1) 10)
  11

assertEqual "application with binops"
  ((\x y -> x + y) 1 2 + 3)
  6

assertEqual "append op" ([1] ++ [2]) [1, 2]
assertEqual "append op" ((++) [1] [2]) [1, 2]

assertEqual "section" ((+) 10 1) 11
assertEqual "section" ((+ 1) 10) 11
assertEqual "section" (foldl (*) 1 [1..5]) 120
assertEqual "section" ((-) 10 1) 9
assertEqual "section" ((10 -) 1) 9
assertEqual "section" ((10 - ) 1) 9
assertEqual "section" ((-1 +) 2) 1
assertEqual "safe section - left assoc"  ((1 + 2 +) 3) 6
assertEqual "safe section - right assoc" ((++ [1] ++ [2]) [3]) [3, 1, 2]
assertEqual "not section" (- 2) (1 - 3)

findFactor :=
  memoizedLambda n ->
    match takeWhile (<= floor (sqrt (itof n))) primes as list integer with
    | _ ++ (?(\m -> divisor? n m) & $x) :: _ -> x
    | _ -> n

assertEqual "memoized lambda"
  (map findFactor [1..10])
  [1, 2, 3, 2, 5, 2, 7, 2, 3, 2]

twinPrimes :=
  matchAll primes as list integer with
  | _ ++ $p :: #(p + 2) :: _ -> (p, p + 2)

assertEqual "twin primes"
  (take 10 twinPrimes)
  [(3, 5), (5, 7), (11, 13), (17, 19), (29, 31), (41, 43), (59, 61), (71, 73), (101, 103), (107, 109)]

primeTriplets :=
  matchAll primes as list integer with
  | _ ++ $p :: ((#(p + 2) | #(p + 4)) & $m) :: #(p + 6) ::  _
  -> (p, m, p + 6)

assertEqual "prime triplets"
  (take 10 primeTriplets)
  [(5, 7, 11), (7, 11, 13), (11, 13, 17), (13, 17, 19), (17, 19, 23), (37, 41, 43), (41, 43, 47), (67, 71, 73), (97, 101, 103), (101, 103, 107)]

someFunction x y z :=
  x + y * z

assertEqual "function definition"
  (someFunction 1 2 3)
  7

gcd m n :=
  if m >= n then
            if n = 0 then m
                     else gcd n (m % n)
            else gcd n m

assertEqual "recursive function definition"
  (gcd 143 22)
  11

A x := 1

assertEqual "definition of upper-case identifier"
  (A 2)
  1

{-
  This is a comment
 -}

{-
  {- We can nest comments! -}
  {- {- nested -} comment -}
 -}

--
-- Pattern-Matching
--

assertEqual "match"
  (match 1 as integer with
   | #0 -> 0
   | $x -> 10 + x)
  11

assertEqual "match-all"
  (matchAll [1, 2, 3] as multiset integer with
   | $x :: _ -> x)
  [1, 2, 3]

assertEqual "match-all-multi"
  (matchAll [1, 2, 3] as multiset integer with
   | $x :: #(x + 1) :: _ -> [x, x + 1]
   | $x :: #(x + 2) :: _ -> [x, x + 2])
  [[1, 2], [2, 3], [1, 3]]

assertEqual "match-lambda"
  ((\match as list integer with
    | [] -> 0
    | $x :: _ -> x) [1, 2, 3])
  1

assertEqual "match-all-lambda"
  ((\matchAll as list something with
    | _ ++ $x :: _ -> x) [1, 2, 3])
  [1, 2, 3]

assertEqual "match-all-lambda-multi"
  ((\matchAll as multiset something with
    | $x :: #(x + 1) :: _ -> [x, x + 1]
    | $x :: #(x + 2) :: _ -> [x, x + 2]) [1, 2, 3])
  [[1, 2], [2, 3], [1, 3]]

assert "nested pattern match"
  (match [1, 2, 3] as list integer with
   | #2 :: $x -> match x as multiset integer with
                | _ -> False
   | #1 :: $x -> match x as multiset integer with
                | #1 :: _ -> False
                | #2 :: _ -> True)

assertEqual "pattern variable"
  (match 1 as something with $x -> x)
  1

assert "value pattern" (match 1 as integer with #1 -> True)

assert "inductive pattern"
  (match [1, 2, 3] as list integer with
   | snoc #3 _ -> True)

assert "and pattern"
  (match [1, 2, 3] as list integer with
   | #1 :: _ & snoc #3 _ -> True)

assert "and pattern"
  (match [1, 2, 3] as list integer with
   | #1 :: _ & #3 :: _ -> False
   | _ -> True)

assert "or pattern"
  (match [1, 2, 3] as list integer with
   | snoc #1 _ | snoc #3 _ -> True)

assert "or pattern"
  (match [1, 2, 3] as list integer with
   | #2 :: _ | #1 :: _ -> True)

assert "not pattern"
  (match 1 as integer with
   | ! #1 -> False
   | ! #2 -> True)

assertEqual "not pattern"
  (matchAll [1, 2, 2, 3, 3, 3] as multiset integer with
   | $n :: !(#n :: _) -> n)
  [1]

assert "predicate pattern"
  (match [1, 2, 3] as list integer with
   | ?(= 1) :: _ -> True)

assert "predicate pattern"
  (match [1, 2, 3] as list integer with
   | ?(= 2) :: _ -> False
   | _ -> True)

assertEqual "indexed pattern variable"
  (match 23 as mod 10 with
   | $a_1 -> a)
  {| (1, 23) |}

assert "loop pattern"
  (match [3, 2, 1] as list integer with
   | loop $i (1, [3], _)
       (snoc #i ...)
       [] -> True)

assertEqual "loop pattern"
  (match [1..10] as list integer with
   | loop $i (1, $n)
       (#i :: ...)
       [] -> n)
  10

assert "loop pattern"
  (match [3, 2, 1] as list integer with
   | loop $i (1, [3], _)
       (snoc #i ...)
       [] -> True)

assertEqual "double loop pattern"
  (match [[1, 2, 3], [4, 5, 6], [7, 8, 9]] as (list (list integer)) with
   | loop $i (1, [3], _)
       ((loop $j (1, [3], _)
           ($n_i_j :: ...)
           []) :: ...)
       [] -> n)
  {| (1, {| (1, 1), (2, 2), (3, 3) |}),
     (2, {| (1, 4), (2, 5), (3, 6) |}),
     (3, {| (1, 7), (2, 8), (3, 9) |}) |}

assertEqual "let pattern"
  (match [1, 2, 3] as list integer with
   | let a := 42 in _ -> a)
  42

assertEqual "let pattern"
  (match [1, 2, 3] as list integer with
   | $a :: (let x := a in $xs) -> [x, xs])
  [1, [2, 3]]

assertEqual "let pattern"
  (match [1, 2, 3] as list integer with
   | $a & (let n := length a in _) -> [a, n])
  [[1, 2, 3], 3]

assertEqual "tuple pattern"
  (matchAll (1, (2, 3)) as (integer, (integer, integer)) with
   | ($m, ($n, $w)) -> [m, n, w])
  [[1, 2, 3]]

assertEqual "tuple pattern"
  (matchAll [(1, 1), (2, 2)] as multiset (integer, integer) with
   | ($x, #x) :: _ -> x)
  [1, 2]

-- assertEqual "pattern function call"
--   (let twin := \pat1 pat2 => (~pat1 & $x) :: #x :: ~pat2 in
--    match [1, 1, 1, 2, 3] as list integer with
--    | twin $n $ns -> [n, ns])
--   [1, [1, 2, 3]]

-- assertEqual "recursive pattern function call"
--   (let repeat := \pat => [] | (~pat & $x) :: (repeat x) in
--    match [1, 1, 1, 1] as list integer with
--    | repeat $n -> n)
--   1

-- assertEqual "loop pattern in pattern function"
--   let comb n := \p =>
--     loop $i (1, n, _) (_ ++ ~p_i :: ...) _
--    in
--   matchAll [1, 2, 3, 4, 5] as (list integer) with
--   | (comb 2) $n -> n
--   [{|(1, 1), (2, 2)|}, {|(1, 1), (2, 3)|},
--    {|(1, 2), (2, 3)|}, {|(1, 1), (2, 4)|},
--    {|(1, 2), (2, 4)|}, {|(1, 3), (2, 4)|},
--    {|(1, 1), (2, 5)|}, {|(1, 2), (2, 5)|},
--    {|(1, 3), (2, 5)|}, {|(1, 4), (2, 5)|}]

assertEqual "pairs of 2, natural numbers"
  (take 10 (matchAll nats as set integer with
            | $m :: $n :: _ -> [m, n]))
  [[1, 1], [1, 2], [2, 1], [1, 3], [2, 2], [3, 1], [1, 4], [2, 3], [3, 2], [4, 1]]

assertEqual "pairs of 2, different natural numbers"
  (take 10 (matchAll nats as list integer with
            | _ ++ $m :: _ ++ $n :: _ -> [m, n]))
  [[1, 2], [1, 3], [2, 3], [1, 4], [2, 4], [3, 4], [1, 5], [2, 5], [3, 5], [4, 5]]

assertEqual "combinations"
  (matchAll [1,2,3] as list something with
   | _ ++ $x :: _ ++ $y :: _ -> (x, y))
  [(1, 2), (1, 3), (2, 3)]

assertEqual "permutations"
  (matchAll [1,2,3] as multiset something with
   | $x :: $y :: _ -> (x, y))
  [(1, 2), (1, 3), (2, 1), (2, 3), (3, 1), (3, 2)]

tree a := algebraicDataMatcher
  | leaf
  | node (tree a) a (tree a)

treeInsert n t :=
  match t as tree integer with
  | leaf -> Node Leaf n Leaf
  | node $t1 $m $t2 -> match (compare n m) as ordering with
      | less    -> Node (treeInsert n t1) m t2
      | equal   -> Node t1 n t2
      | greater -> Node t1 m (treeInsert n t2)

treeMember? n t :=
  match t as tree integer with
  | leaf -> False
  | node $t1 $m $t2 -> match (compare n m) as ordering with
      | less    -> treeMember? n t1
      | equal   -> True
      | greater -> treeMember? n t2

assertEqual "tree set using algebraic-data-matcher"
  (let t := foldr treeInsert Leaf [4, 1, 2, 4, 3]
    in [treeMember? 1 t, treeMember? 0 t])
  [True, False]

assert "sequential pattern"
  (match [2,3,1,4,5] as list integer with
   | { @ :: @ :: $x :: _,
       (#(x + 1), @),
      #(x + 2)}
   -> True)

assertEqual "sequential not pattern"
  (matchAll ([1,2,3], [4,3,5]) as (multiset eq, multiset eq) with
   | { ($x :: @, #x :: @),
       !($y :: _, #y :: _) }
   -> x)
  [3]

--
-- Tensor
--

assertEqual "generate-tensor"
  (generateTensor (*) [3, 5])
  [| [| 1, 2, 3, 4, 5 |], [| 2, 4, 6, 8, 10 |], [| 3, 6, 9, 12, 15 |] |]

assertEqual "tensor"
  (tensor [2, 5] [1, 2, 3, 4, 5, 2, 4, 6, 8, 10])
  [| [| 1, 2, 3, 4, 5 |], [| 2, 4, 6, 8, 10 |] |]

assertEqual "tensor wedge expr"
  (! b.min [| 1, 2, 3 |] [| 1, 2, 3 |])
  [| [| 1, 1, 1 |], [| 1, 2, 2 |], [| 1, 2, 3 |] |]

assertEqual "tensor wedge expr of binary operator"
  ([| 1, 2, 3 |] !+ [| 1, 2, 3 |])
  [| [| 2, 3, 4 |], [| 3, 4, 5 |], [| 4, 5, 6 |] |]

-- assertEqual "tensor wedge expr of binary operator - section style"
--   ((!+) [| 1, 2, 3 |] [| 1, 2, 3 |])
--   [| [| 2, 3, 4 |], [| 3, 4, 5 |], [| 4, 5, 6 |] |]

assertEqual "tensor multiplication"
  ([| 1, 2, 3 |]_i * [| 1, 2, 3 |]_i)
  [| 1, 4, 9 |]_i

assertEqual "multi subscript"
  (let i := {| (1, 1), (2, 2), (3, 3) |}
       x := generateTensor (\x y z -> x + y + z) [5, 5, 5]
    in x_(i_1)..._(i_3))
  6

--
-- Hash
--

assertEqual "hash-literal"
  {| (1, 11), (2, 12), (3, 13), (4, 14), (5, 15), |}
  {| (1, 11), (2, 12), (3, 13), (4, 14), (5, 15), |}

assertEqual "empty hash-literal"
  {| |}
  {| |}

assertEqual "hash access"
  {| (1, 11), (2, 12), (3, 13), (4, 14), (5, 15), |}_3
  13

-- assertEqual "string hash access"
--   {| ("1", 11), ("2", 12), ("3", 13), ("4", 14), ("5", 15) |}_"3"
--   13

--
-- Partial Application
--

assertEqual "partial application '#'"
  (2#(10 * %1 + %2) 1 2)
  12

-- assertEqual "recursive partial application '#'"
--   (take 10 (1#(%1 :: (%0 (%1 * %2))) 2))
--   [2, 4, 8, 16, 32, 64, 128, 256, 512, 1024]

f *x *y := x + y

assertEqual "double inverted index"
  (f [|1, 2, 3|]_i [|10, 20, 30|]_j)
  [| [| 11, 21, 31, |], [| 12, 22, 32, |], [| 13, 23, 33, |], |]~i~j

g x *y := x + y

assertEqual "single inverted index"
  (g [|1, 2, 3|]_i  [|10, 20, 30|]_j)
  [| [| 11, 21, 31, |], [| 12, 22, 32, |], [| 13, 23, 33, |], |]_i~j

--
-- matcherExpr
--

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]

multiset a := matcher
  | [] as () with
    | $tgt -> match tgt as (mutiset a) with
                | [] -> [()]
                | _ -> []
  | $ :: $ as (a, multiset a) with
    | $tgt -> matchAll tgt as list a with
                | $hs ++ $x :: $ts -> (x, hs ++ ts)
  | #$val as () with
    | $tgt -> match (val, tgt) as (list a, multiset a) with
                | ([], []) -> [()]
                | ($x :: $xs, #x :: #xs) -> [()]
                | (_, _) -> []
  | $ as something with
    | $tgt -> [tgt]

assertEqual "matcher definition"
  (matchAll [1, 2, 3] as multiset integer with
   | $x :: _ -> x)
  [1, 2, 3]

nishiwakiIf b e1 e2 :=
  car (matchAll b as (matcher
                      | $ as something with
                          | True  -> [e1]
                          | False -> [e2]) with
       | $x -> x)

assertEqual "case 1" (nishiwakiIf True     1 2) 1
assertEqual "case 2" (nishiwakiIf False    1 2) 2
assertEqual "case 3" (nishiwakiIf (1 = 1) 1 2) 1