-- -- 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