egison-5.1.0: test/syntax.egi

--
-- 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, f.- 0.0 100.012001, f.+ 1.0 2.0] [1.0, 0.0, f.- 0.0 100.012001, 3.0]

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" (i.* 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 case"
  ((\() -> 1) ())
  1

assertEqual "lambda with case"
  ((\(x, y, z) -> x - y - z) (1, 2, 3))
  (-4)

assertEqual "lambda with case"
  ((\_ -> 1) 2)
  1

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 @
def (@) x y := x - y

assertEqual "user defined infix"
  (4 @ 3 @ 5)
  (-4)

def findFactor :=
  memoizedLambda n ->
    match takeWhile (<= floor (f.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]

def 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)]

def 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)]

def someFunction x y z :=
  x + y * z

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

-- (named to avoid shadowing GCDDomain's method `gcd`, which warns;
-- unannotated, on purpose: the definition's own name is bound to a
-- monomorphic placeholder during body inference, so top-level
-- recursion needs no signature)
def euclid m n :=
  if m >= n then
            if n = 0 then m
                     else euclid n (m % n)
            else euclid n m

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

def A x := 1

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

def f0 () := 1
def 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]

-- Uses `multiset integer` (not `multiset something`): the value patterns `#(x + 1)` /
-- `#(x + 2)` give the element a concrete (Integer) structural type, at which a bare-variable
-- matcher (`something`) is not structurally admissible under the MatcherSlot type system
-- (paper's per-use-site structural admissibility); a concrete element matcher is required.
assertEqual "match-all-lambda-multi"
  ((\matchAll as multiset integer 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
   | _ *: #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 :: _ & _ *: #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
   | _ *: #1 | _ *: #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
   | _ *: !#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], _)
--       (... *: #i)
--       [] -> True)

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

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

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 "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)]

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

--
-- Tensor
--

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

assertEqual "generate vector using generate-tensor"
  (generateTensor (\[x] -> x + 1) [3])
  [| 2, 3, 4 |]

assertEqual "generate scalar using rank-zero generate-tensor"
  (generateTensor (\[] -> 42) [])
  42

assertEqual "rank-one singleton generated value remains a tensor"
  (generateTensor (\[x] -> x) [1])
  [| 1 |]

assertEqual "empty rank-one generated value remains a tensor"
  (show (generateTensor (\_ -> 42) [0]))
  "[|  |]"

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 sum [5, 5, 5]
    in x_(i_1)..._(i_3))
  6

declare symbol x, a, b, c: MathExpr

def TestT := generateTensor (\[a, b, c] -> x_a_b_c) [2,3,4]
def 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])_#_#_#

def symmT[_i_j] :=
  [| [| 0, 1, 2 |],
     [| 1, 0, 3 |],
     [| 2, 3, 0 |] |]

def asymmT{_i_j} :=
  [| [| 0, 1, 2 |],
     [| -1, 0, 3 |],
     [| -2, -3, 0 |] |]

assert "symmetric tensor"
  (symmT_1_1 = 0 && symmT_1_2 = 1 && symmT_1_3 = 2 &&
   symmT_2_1 = 1 && symmT_2_2 = 0 && symmT_2_3 = 3 &&
   symmT_3_1 = 2 && symmT_3_2 = 3 && symmT_3_3 = 0)

assert "symmetric tensor"
  (asymmT_1_1 = 0  && asymmT_1_2 = 1  && asymmT_1_3 = 2 &&
   asymmT_2_1 = -1 && asymmT_2_2 = 0  && asymmT_2_3 = 3 &&
   asymmT_3_1 = -2 && asymmT_3_2 = -3 && asymmT_3_3 = 0)

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

assertEqual "char hash access"
  {| ('a', 11), ('b', 12), ('c', 13), ('d', 14), ('e', 15) |}_'c'
  13

-- Primitive data pattern match with let expression
assertEqual "let pattern match"
  (let (x :: xs) := [1, 2, 3] in (x, xs))
  (1, [2, 3])

assertEqual "let pattern match"
  (let (xs *: x) := [1, 2, 3] in (xs, x))
  ([1, 2], 3)

assertEqual "let pattern match"
  (let (x, y) := (2, 3) in x + y)
  5

-- Functions to become binary operator (of infixl 7) when surrounded with 2 backquotes
assertEqual "function to become binary operator"
  (10 `i.modulo` 4 + 5)
  7

assertEqual "function to become binary operator with space"
  (10` i.modulo `4)
  2

assertEqual "function to become binary operator with section"
  ((`i.modulo` 4) 10)
  2