;;;;;
;;;;; Syntax Test
;;;;;

;;;
;;; Primitive Data
;;;
(assert-equal "char literal"
  c#a
  c#a)

(assert-equal "string literal"
  "abc\n"
  "abc\n")

(assert-equal "bool literal"
  [#t #f]
  [#t #f])

(assert-equal "integer literal"
  [1 0 -100 (+ 1 -100)]
  [1 0 -100 -99])

(assert-equal "rational number"
  [(/ 10 3) (/ 10 20) (/ -1 2)]
  [(/ 10 3) (/ 1 2) (/ -1 2)])

(assert-equal "float literal"
  [1.0 0.0 -100.012001 (+ 1.0 2)]
  [1.0 0.0 -100.012001 3.0])

(assert-equal "inductive data literal"
  <A>
  <A>)

(assert-equal "tuple literal"
  [1 2 3]
  [1 2 3])

(assert-equal "singleton tuple literal"
  [1]
  1)

(assert-equal "collection literal"
  {1 @{2 3 @{@{4} 5}} 6}
  {1 2 3 4 5 6})

;;;
;;; Basic Sytax
;;;
(assert-equal "if"
  (if #t #t #f)
  #t)

(assert-equal "if"
  (if #f #t #f)
  #f)

(assert-equal "let binding"
  (let {[$t [1 2]]}
    (let {[[$x $y] t]}
      (+ x y)))
  3)

(assert-equal "let* binding"
  (let* {[$x 1] [$y (+ x 1)]} y)
  2)

(assert-equal "letrec binding"
  (letrec {[[$x $y] t]
           [$t [1 2]]}
    (+ x y))
  3)

(assert-equal "mutual recursion"
  (letrec {[$even? (lambda [$n]
                     (if (eq? n 0) #t (odd? (- n 1))))]
           [$odd? (lambda [$n]
                    (if (eq? n 0) #f (even? (- n 1))))]}
    (even? 10))
  #t)

(assert-equal "lambda and application"
  ((lambda [$x] (+ 1 x)) 10)
  11)

(assert-equal "placeholder"
  ((+ $ 1) 10)
  11)

(assert-equal "indexed placeholder"
  ((+ $1 $1) 10)
  20)

(assert-equal "indexed placeholder2"
  ((- $2 $1) 10 20)
  10)

;;;
;;; Pattern-Matching
;;;
(assert-equal "match"
  (match 1 integer
    {[,0 0]
     [$x (+ 10 x)]})
  11)

(assert-equal "match-all"
  (match-all {1 2 3} (list integer)
    [<cons $x $xs> [x xs]])
  {[1 {2 3}]})

(assert-equal "match-all-multi"
  (match-all {1 2 3} (multiset integer)
    {[<cons $x <cons ,(+ x 1) _>> [x (+ x 1)]]
     [<cons $x <cons ,(+ x 2) _>> [x (+ x 2)]]})
  {[1 2] [2 3] [1 3]})

(assert-equal "match-lambda"
  (letrec {[$count (match-lambda (list something)
                     {[<nil> 0]
                      [<cons _ $xs> (+ (count xs) 1)]})]}
    (count {1 2 3}))
  3)

(assert-equal "match-all-lambda"
  ((match-all-lambda (list something) [<join _ <cons $x _>> x]) {1 2 3})
  {1 2 3})

(assert-equal "match-all-lambda-multi"
  ((match-all-lambda (multiset something)
     {[<cons $x <cons ,(+ x 1) _>> [x (+ x 1)]]
      [<cons $x <cons ,(+ x 2) _>> [x (+ x 2)]]}) {1 2 3})
  {[1 2] [2 3] [1 3]})

(assert-equal "pattern variable"
  (match 1 something
    {[$x x]})
  1)

(assert "value pattern"
  (match 1 integer
    {[,1 #t]}))

(assert "and pattern"
  (match {1 2 3} (list integer)
    {[(& <cons ,1 _> <snoc ,3 _>) #t]}))

(assert "and pattern"
  (match {1 2 3} (list integer)
    {[(& <cons ,1 _> <cons ,3 _>) #f]
     [_ #t]}))

(assert "and pattern"
  (match #t something
    {[(&) #t]}))

(assert "or pattern"
  (match {1 2 3} (list integer)
    {[(| <snoc ,1 _> <snoc ,3 _>) #t]}))

(assert "or pattern"
  (match {1 2 3} (list integer)
    {[(| <cons ,2 _> <cons ,3 _>) #f]
     [_ #t]}))

(assert "or pattern"
  (match #t something
    {[(|) #f]
     [_ #t]}))

;(assert-equal "ordered or pattern"
;  (match {1 2 3 4 5} (list integer) {[<join (|* ,{2} ,{1 2 3} ,{1}) $xs> xs]})
;  {4 5})

;(assert-equal "ordered or pattern"
;  (let {[$x [| 1 2 3 |]]}
;    (match-all {2 1 3} (multiset integer)
;      [<cons (& (|* !,x_1 ,x_1) $y_1)
;             <cons (& (|* !,x_2 ,x_2) $y_2)
;                   <cons (& (|* !,x_3 ,x_3) $y_3) <nil>>>> (map 1#y_%1 (between 1 3))]))
;  {{2 3 1} {3 1 2} {2 1 3} {3 2 1} {1 3 2} {1 2 3}})

;(assert "ordered or pattern"
;  (match {1 2 3} (list integer)
;    {[(|* <cons ,2 _> <cons ,3 _>) #f]
;     [_ #t]}))

(assert "not pattern"
  (match 1 integer
    {[!,1 #f]
     [!,2 #t]}))

(assert-equal "not pattern"
  (match-all {1 2 2 3 3 3} (multiset integer)
    [<cons $n !<cons ,n _>> n])
  {1})

(assert-equal "later pattern"
  (match-all {1 1 2} (list integer)
    [<cons (later ,n) <cons $n _>> n])
  {1})

(assert "predicate pattern"
  (match {1 2 3} (list integer)
    {[<cons ?(eq? 1 $) _> #t]}))

(assert "predicate pattern"
  (match {1 2 3} (list integer)
    {[<cons ?(eq? 2 $) _> #f]
     [_ #t]}))

(assert-equal "indexed pattern variable"
  (match 23 (mod 10) {[$a_1 a]})
  {| [1 23] |})

(assert-equal "seq pattern"
  (match-all {1 2 3 2 4 3 5} (list integer)
    [{<join #                     <cons $x _>>
            !<join _ <cons ,x _>>             }
   x])
  {1 2 3 4 5})

;(assert-equal "dfs pattern 1"
;  (take 10 (match-all nats (set integer)
;       [(dfs <cons $m <cons $n <cons $l _>>>) [m n l]]))
;  {[1 1 1] [1 1 2] [1 1 3] [1 1 4] [1 1 5] [1 1 6] [1 1 7] [1 1 8] [1 1 9] [1 1 10]})

;(assert-equal "dfs pattern 2"
;  (take 10 (match-all nats (set integer)
;       [<cons $m (dfs <cons $n <cons $l _>>)> [m n l]]))
;  {[1 1 1] [2 1 1] [3 1 1] [4 1 1] [5 1 1] [6 1 1] [7 1 1] [8 1 1] [9 1 1] [10 1 1]})

;(assert-equal "dfs pattern 3"
;  (match-all (between 1 3) (set integer)
;       [<cons $m <cons $n (dfs <cons $l _>)>> [m n l]])
;  {[1 1 1] [1 2 1] [2 1 1] [1 3 1] [2 2 1] [3 1 1] [2 3 1] [3 2 1] [3 3 1] [1 1 2] [1 2 2] [2 1 2] [1 3 2] [2 2 2] [3 1 2] [2 3 2] [3 2 2] [3 3 2] [1 1 3] [1 2 3] [2 1 3] [1 3 3] [2 2 3] [3 1 3] [2 3 3] [3 2 3] [3 3 3]})

;(assert-equal "dfs and bfs pattern 1"
;  (take 10 (match-all nats (set integer)
;       [(dfs <cons $m (bfs <cons $n <cons $l _>>)>) [m n l]]))
;  {[1 1 1] [1 1 2] [1 2 1] [1 1 3] [1 2 2] [1 3 1] [1 1 4] [1 2 3] [1 3 2] [1 4 1]})

;(assert-equal "dfs and bfs pattern 2"
;  (take 10 (match-all nats (set integer)
;       [(dfs <cons $m <cons $n (bfs <cons $l _>)>>) [m n l]]))
;  {[1 1 1] [1 1 2] [1 1 3] [1 1 4] [1 1 5] [1 1 6] [1 1 7] [1 1 8] [1 1 9] [1 1 10]})

(assert "loop pattern"
  (match {3 2 1} (list integer)
    {[(loop $i [1 {3} _] <snoc ,i ...> <nil>) #t]}))

(assert-equal "double loop pattern"
  (match {{1 2 3} {4 5 6} {7 8 9}} (list (list integer))
    {[(loop $i [1 {3} _]
        <cons (loop $j [1 {3} _]
                <cons $n_i_j ...>
                <nil>) ...>
        <nil>)
      n]})
  {|[1 {|[1 1] [2 2] [3 3]|}] [2 {|[1 4] [2 5] [3 6]|}] [3 {|[1 7] [2 8] [3 9]|}]|})

(assert-equal "let pattern"
  (match {1 2 3} (list integer)
    {[(let {[$a 42]} _) a]})
  42)

(assert-equal "let pattern"
  (match {1 2 3} (list integer)
    {[<cons $a (let {[$x a]} $xs)> [x xs]]})
  [1 { 2 3 }])

(assert-equal "let pattern"
  (match {1 2 3} (list integer)
    {[(& $a (let {[$n (length a)]} _)) [a n]]})
  [{1 2 3} 3])

(assert-equal "tuple patterns"
  (match-all [1 [2 3]] [integer [integer integer]]
    [[$m [$n $w]] [m n w]])
  {[1 2 3]})

(assert-equal "pattern function call"
  (letrec {[$twin (pattern-function [$pat1 $pat2]
                    <cons (& pat1 $x) <cons ,x pat2>>)
            ]}
    (match {1 1 1 2 3} (list integer)
      {[(twin $n $ns) [n ns]]}))
  [1 {1 2 3}])

(assert-equal "recursive pattern function call"
  (letrec {[$repeat (pattern-function [$pat]
                      (| <nil>
                         <cons (& pat $x) (repeat ,x)>))
            ]}
    (match {1 1 1 1} (list integer)
      {[(repeat $n) n]}))
  1)

(assert-equal "loop pattern in pattern function"
  (letrec {[$comb (lambda [$n]
                    (pattern-function [$p]
                      (loop $i [1 {n} _]
                        <join _ <cons p_i ...>>
                        _)))
           ]}
    (match-all {1 2 3 4 5} (list integer)
      [((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]|}})

(assert-equal "pairs of 2 natural numbers"
  (take 10 (match-all nats (set integer)
             [<cons $m <cons $n _>> [m n]]))
  {[1 1] [1 2] [2 1] [1 3] [2 2] [3 1] [1 4] [2 3] [3 2] [4 1]})

(assert-equal "pairs of 2 different natural numbers"
  (take 10 (match-all nats (list integer)
             [<join _ <cons $m <join _ <cons $n _>>>> [m n]]))
  {[1 2] [1 3] [2 3] [1 4] [2 4] [3 4] [1 5] [2 5] [3 5] [4 5]})

(define $tree
  (lambda [$a]
    (algebraic-data-matcher
      {<leaf> <node (tree a) a (tree a)>})))

(define $tree-insert
  (lambda [$n $t]
    (match t (tree integer)
      {[<leaf> <Node <Leaf> n <Leaf>>]
       [<node $t1 $m $t2>
        (match (compare n m) ordering
          {[<less> <Node (tree-insert n t1) m t2>]
           [<equal> <Node t1 n t2>]
           [<greater> <Node t1 m (tree-insert n t2)>]})]})))

(define $tree-member?
  (lambda [$n $t]
    (match t (tree integer)
      {[<leaf> #f]
       [<node $t1 $m $t2>
        (match (compare n m) ordering
          {[<less> (tree-member? n t1)]
           [<equal> #t]
           [<greater> (tree-member? n t2)]})]})))

(assert-equal "tree set using algebraic-data-matcher"
  (let {[$t (foldr tree-insert <Leaf> {4 1 2 4 3})]}
    [(tree-member? 1 t) (tree-member? 0 t)])
  [#t #f])

(assert-equal "tuple pattern"
  (match-all {[1 1] [2 2]} (multiset [integer integer]) [<cons [$x ,x] _> x])
  {1 2})


;;;
;;; Array
;;;

(assert-equal "array-literal"
  (| 1 2 3 4 5 |)
  (| 1 2 3 4 5 |)
  )

(assert-equal "empty array literal"
  (||)
  (||)
  )

(assert-equal "generate-array"
  (generate-array (+ $ 100) [3 5])_4
  104
  )

(assert-equal "array-bounds - case 1"
  (array-bounds (| 1 2 3 |))
  [1 3]
  )

(assert-equal "array-bounds - case 2"
  (array-bounds (generate-array (+ $ 100) [3 5]))
  [3 5]
  )

(assert-equal "array-ref"
  (array-ref (| 1 2 3 4 5 |) 3)
  3)

;;;
;;; Tensor
;;;
(assert-equal "generate-tensor - case 1"
  (generate-tensor kronecker-delta {3})
  [| 1 1 1 |])

(assert-equal "generate-tensor - case 2"
  (generate-tensor kronecker-delta { 2 2 2 2 })
  (tensor {2 2 2 2} {1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1} ))

;;;
;;; Hash
;;;
(assert-equal "hash-literal"
  {| [1 11] [2 12] [3 13] [4 14] [5 15] |}
  {| [1 11] [2 12] [3 13] [4 14] [5 15] |}
  )

(assert-equal "empty hash-literal"
  {| |}
  {| |}
  )

(assert-equal "hash access"
  {| [1 11] [2 12] [3 13] [4 14] [5 15] |}_3
  13
  )

;(assert-equal "string hash access"
;  {| ["1" 11] ["2" 12] ["3" 13] ["4" 14] ["5" 15] |}_"3"
;  13
;  )

;;;
;;; Partial Application
;;;
(assert-equal "partial application '$'"
  ((+ $ $) 1 2)
  3)

(assert-equal "partial application '$' with index"
  ((- $2 $1) 1 2)
  1)

(assert-equal "partial application '#'"
  (2#(+ (* 10 %1) %2) 1 2)
  12)

(assert-equal "recursive partial application '#'"
  (take 10 (1#{%1 @(%0 (* %1 2))} 2))
  {2 4 8 16 32 64 128 256 512 1024})

(assert-equal "double inverted index"
  (let {[$f (lambda [*$x *$y] (+ x y))]}
    [(f [|1 2 3|]_i [|10 20 30|]_j)])
  [[| [| 11 21 31 |] [| 12 22 32 |] [| 13 23 33 |] |]~i~j])

(assert-equal "single inverted index"
  (let {[$f (lambda [$x *$y] (+ x y))]}
    [(f [|1 2 3|]_i [|10 20 30|]_j)])
  [[| [| 11 21 31 |] [| 12 22 32 |] [| 13 23 33 |] |]_i~j])