;;;;;
;;;;; 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"
)
(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)
[ [x xs]])
{[1 {2 3}]})
(assert-equal "match-all-multi"
(match-all {1 2 3} (multiset integer)
{[> [x (+ x 1)]]
[> [x (+ x 2)]]})
{[1 2] [2 3] [1 3]})
(assert-equal "match-lambda"
(letrec {[$count (match-lambda (list something)
{[ 0]
[ (+ (count xs) 1)]})]}
(count {1 2 3}))
3)
(assert-equal "match-all-lambda"
((match-all-lambda (list something) [> x]) {1 2 3})
{1 2 3})
(assert-equal "match-all-lambda-multi"
((match-all-lambda (multiset something)
{[> [x (+ x 1)]]
[> [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)
{[(& ) #t]}))
(assert "and pattern"
(match {1 2 3} (list integer)
{[(& ) #f]
[_ #t]}))
(assert "and pattern"
(match #t something
{[(&) #t]}))
(assert "or pattern"
(match {1 2 3} (list integer)
{[(| ) #t]}))
(assert "or pattern"
(match {1 2 3} (list integer)
{[(| ) #f]
[_ #t]}))
(assert "or pattern"
(match #t something
{[(|) #f]
[_ #t]}))
;(assert-equal "ordered or pattern"
; (match {1 2 3 4 5} (list integer) {[ xs]})
; {4 5})
;(assert-equal "ordered or pattern"
; (let {[$x [| 1 2 3 |]]}
; (match-all {2 1 3} (multiset integer)
; [>>> (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)
; {[(|* ) #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)
[> n])
{1})
(assert-equal "later pattern"
(match-all {1 1 2} (list integer)
[> n])
{1})
(assert "predicate pattern"
(match {1 2 3} (list integer)
{[ #t]}))
(assert "predicate pattern"
(match {1 2 3} (list integer)
{[ #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)
[{>
!> }
x])
{1 2 3 4 5})
;(assert-equal "dfs pattern 1"
; (take 10 (match-all nats (set integer)
; [(dfs >>) [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)
; [>)> [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)
; [)>> [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 >)>) [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 )>>) [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} _] ) #t]}))
(assert-equal "double loop pattern"
(match {{1 2 3} {4 5 6} {7 8 9}} (list (list integer))
{[(loop $i [1 {3} _]
) ...>
)
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)
{[ [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]
>)
]}
(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]
(|
))
]}
(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} _]
>
_)))
]}
(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)
[> [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)
[>>> [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
{ })))
(define $tree-insert
(lambda [$n $t]
(match t (tree integer)
{[ n >]
[
(match (compare n m) ordering
{[ ]
[ ]
[ ]})]})))
(define $tree-member?
(lambda [$n $t]
(match t (tree integer)
{[ #f]
[
(match (compare n m) ordering
{[ (tree-member? n t1)]
[ #t]
[ (tree-member? n t2)]})]})))
(assert-equal "tree set using algebraic-data-matcher"
(let {[$t (foldr tree-insert {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]) [ 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])