--
-- 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]
assertEqual "identifier with dot and operator" (b.* 1 2) 2
--
-- 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 isEven n := if n = 0 then True else isOdd (n - 1)
isOdd n := if n = 0 then False else isEven (n - 1)
in isEven 10)
True
assertEqual "lambda and application"
((\x -> x + 1) 10)
11
assertEqual "application with binops"
((\x y -> x + y) 1 2 + 3)
6
assertEqual "lambda with 0 argument"
((\() -> 1) ())
1
assertEqual "lambda with tuple argument"
((\(x, y, z) -> x + y + z) 1 2 3)
6
assertEqual "append op" ([1] ++ [2]) [1, 2]
assertEqual "append op" ((++) [1] [2]) [1, 2]
assertEqual "apply op" ((+ 5) $ 1 + 2) 8
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)
-- user-defined infix
infixl expression 5 @
(@) x y := x - y
assertEqual "user defined infix"
(4 @ 3 @ 5)
(-4)
infixl expression 5 @@
(@@) %x y := x - y
assertEqual "user defined infix with tensor arg"
(4 @@ 3 @@ 2)
(-1)
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
someFunctionWithDollar $x $y $z :=
x + y + z
assertEqual "function definition with '$' scalar arg"
(someFunctionWithDollar 1 2 3)
6
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
assertEqual "capply"
(capply (+) [1, 2])
3
f0 () := 1
f2 (x, y) := x + y
assertEqual "nullary function definition"
(f0 ())
1
assertEqual "function definition with tupled argument"
(f2 1 2)
3
{-
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 "collection pattern - nil"
(match [] as list integer with
| [] -> True)
assertEqual "collection pattern"
(match [1, 2, 3] as list integer with
| [#1, _, $x] -> x)
3
assertEqual "collection pattern"
(matchAll [1, 2, 3, 4] as list integer with
| [_, _, _] -> 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, 2] as list integer with
| snoc !#1 _ -> True
| !#1 :: _ -> False)
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 :: (repeat ~pat) in
matchAll [1, 1, 1, 1] as list integer with
| repeat #1 -> "OK")
["OK"]
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]
assertEqual "partial sequential pattern"
(matchAll ([1,2,3,2], [10,20]) as (list eq, list eq) with
| ({ @ ++ $x :: _, !(_ ++ #x :: _) }, $ys) -> (x, ys))
[(1, [10, 20]), (2, [10, 20]), (3, [10, 20])]
assertEqual "forall pattern 1"
(matchAll [1,5,3] as multiset integer with
| forall _ _ -> "ok")
["ok"]
assertEqual "forall pattern 2"
(matchAll [1,5,3] as multiset integer with
| (forall ((@ & $x) :: _) ?isOdd) & $xs -> (x,xs))
[(1, [1, 5, 3]), (5, [1, 5, 3]), (3, [1, 5, 3])]
assertEqual "forall pattern 3"
(matchAllDFS [1,5,3] as multiset integer with
| forall ((@ & $x) :: _) ?isOdd -> x)
[1,5,3]
assertEqual "forall pattern 4"
(matchAll [1,5,3] as multiset integer with
| forall ((@ & $x) :: _) ?isOdd -> x)
[1, 5, 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"
(! 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
TestT := generateTensor 3#x_%1_%2_%3 [2,3,4]
TestC_c_a_b := TestT_a_b_c
assertEqual "transpose"
TestC_#_#_#
(tensor [4, 2, 3] [x_1_1_1, x_1_2_1, x_1_3_1, x_2_1_1, x_2_2_1, x_2_3_1, x_1_1_2, x_1_2_2, x_1_3_2, x_2_1_2, x_2_2_2, x_2_3_2, x_1_1_3, x_1_2_3, x_1_3_3, x_2_1_3, x_2_2_3, x_2_3_3, x_1_1_4, x_1_2_4, x_1_3_4, x_2_1_4, x_2_2_4, x_2_3_4] )_#_#_#
--
-- 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 :=
head (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
-- User-defined pattern infix
infixl pattern 7 <>
infixl pattern 4 -- '?' is allowed from the 2nd character
dummyMatcher := matcher
| $ <> $ as (integer, integer) with
| $x :: $y :: [] -> [(x, y)]
| _ -> []
| $ $ as (integer, list integer) with
| $x :: $xs -> [(x, xs)]
| _ -> []
assertEqual "user-defined pattern infix"
(match [1, 2] as dummyMatcher with $x <> $y -> x + y)
3
assertEqual "user-defined pattern infix"
(match [1, 2] as dummyMatcher with $x $y :: _ -> x + y)
3