giles
0e53e88b02
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
279 lines
6.5 KiB
Plaintext
279 lines
6.5 KiB
Plaintext
;; Strict evaluator tests. Each test parses, desugars, and evaluates
|
|
;; either an expression (hk-eval-expr-source) or a full program
|
|
;; (hk-eval-program → look up a named value).
|
|
|
|
(define
|
|
hk-prog-val
|
|
(fn
|
|
(src name)
|
|
(hk-deep-force (get (hk-eval-program (hk-core src)) name))))
|
|
|
|
;; ── Literals ──
|
|
(hk-test "int literal" (hk-eval-expr-source "42") 42)
|
|
(hk-test "float literal" (hk-eval-expr-source "3.14") 3.14)
|
|
(hk-test "string literal" (hk-eval-expr-source "\"hi\"") "hi")
|
|
(hk-test "char literal" (hk-eval-expr-source "'a'") "a")
|
|
(hk-test "negative literal" (hk-eval-expr-source "- 5") -5)
|
|
|
|
;; ── Arithmetic ──
|
|
(hk-test "addition" (hk-eval-expr-source "1 + 2") 3)
|
|
(hk-test
|
|
"precedence"
|
|
(hk-eval-expr-source "1 + 2 * 3")
|
|
7)
|
|
(hk-test
|
|
"parens override precedence"
|
|
(hk-eval-expr-source "(1 + 2) * 3")
|
|
9)
|
|
(hk-test
|
|
"subtraction left-assoc"
|
|
(hk-eval-expr-source "10 - 3 - 2")
|
|
5)
|
|
|
|
;; ── Comparison + Bool ──
|
|
(hk-test
|
|
"less than is True"
|
|
(hk-eval-expr-source "3 < 5")
|
|
(list "True"))
|
|
(hk-test
|
|
"equality is False"
|
|
(hk-eval-expr-source "1 == 2")
|
|
(list "False"))
|
|
(hk-test
|
|
"&& shortcuts"
|
|
(hk-eval-expr-source "(1 == 1) && (2 == 2)")
|
|
(list "True"))
|
|
|
|
;; ── if / otherwise ──
|
|
(hk-test
|
|
"if True"
|
|
(hk-eval-expr-source "if True then 1 else 2")
|
|
1)
|
|
(hk-test
|
|
"if comparison branch"
|
|
(hk-eval-expr-source "if 5 > 3 then \"yes\" else \"no\"")
|
|
"yes")
|
|
(hk-test "otherwise is True" (hk-eval-expr-source "otherwise") (list "True"))
|
|
|
|
;; ── let ──
|
|
(hk-test
|
|
"let single binding"
|
|
(hk-eval-expr-source "let x = 5 in x + 1")
|
|
6)
|
|
(hk-test
|
|
"let two bindings"
|
|
(hk-eval-expr-source "let x = 1; y = 2 in x + y")
|
|
3)
|
|
(hk-test
|
|
"let recursive: factorial 5"
|
|
(hk-eval-expr-source
|
|
"let f n = if n == 0 then 1 else n * f (n - 1) in f 5")
|
|
120)
|
|
|
|
;; ── Lambdas ──
|
|
(hk-test
|
|
"lambda apply"
|
|
(hk-eval-expr-source "(\\x -> x + 1) 5")
|
|
6)
|
|
(hk-test
|
|
"lambda multi-arg"
|
|
(hk-eval-expr-source "(\\x y -> x * y) 3 4")
|
|
12)
|
|
(hk-test
|
|
"lambda with constructor pattern"
|
|
(hk-eval-expr-source "(\\(Just x) -> x + 1) (Just 7)")
|
|
8)
|
|
|
|
;; ── Constructors ──
|
|
(hk-test
|
|
"0-arity constructor"
|
|
(hk-eval-expr-source "Nothing")
|
|
(list "Nothing"))
|
|
(hk-test
|
|
"1-arity constructor applied"
|
|
(hk-eval-expr-source "Just 5")
|
|
(list "Just" 5))
|
|
(hk-test
|
|
"True / False as bools"
|
|
(hk-eval-expr-source "True")
|
|
(list "True"))
|
|
|
|
;; ── case ──
|
|
(hk-test
|
|
"case Just"
|
|
(hk-eval-expr-source
|
|
"case Just 7 of Just x -> x ; Nothing -> 0")
|
|
7)
|
|
(hk-test
|
|
"case Nothing"
|
|
(hk-eval-expr-source
|
|
"case Nothing of Just x -> x ; Nothing -> 99")
|
|
99)
|
|
(hk-test
|
|
"case literal pattern"
|
|
(hk-eval-expr-source
|
|
"case 0 of 0 -> \"zero\" ; n -> \"other\"")
|
|
"zero")
|
|
(hk-test
|
|
"case tuple"
|
|
(hk-eval-expr-source
|
|
"case (1, 2) of (a, b) -> a + b")
|
|
3)
|
|
(hk-test
|
|
"case wildcard fallback"
|
|
(hk-eval-expr-source
|
|
"case 5 of 0 -> \"z\" ; _ -> \"nz\"")
|
|
"nz")
|
|
|
|
;; ── List literals + cons ──
|
|
(hk-test
|
|
"list literal as cons spine"
|
|
(hk-eval-expr-source "[1, 2, 3]")
|
|
(list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))
|
|
(hk-test
|
|
"empty list literal"
|
|
(hk-eval-expr-source "[]")
|
|
(list "[]"))
|
|
(hk-test
|
|
"cons via :"
|
|
(hk-eval-expr-source "1 : []")
|
|
(list ":" 1 (list "[]")))
|
|
(hk-test
|
|
"++ concatenates lists"
|
|
(hk-eval-expr-source "[1, 2] ++ [3]")
|
|
(list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))
|
|
|
|
;; ── Tuples ──
|
|
(hk-test
|
|
"2-tuple"
|
|
(hk-eval-expr-source "(1, 2)")
|
|
(list "Tuple" 1 2))
|
|
(hk-test
|
|
"3-tuple"
|
|
(hk-eval-expr-source "(\"a\", 5, True)")
|
|
(list "Tuple" "a" 5 (list "True")))
|
|
|
|
;; ── Sections ──
|
|
(hk-test
|
|
"right section (+ 1) applied"
|
|
(hk-eval-expr-source "(+ 1) 5")
|
|
6)
|
|
(hk-test
|
|
"left section (10 -) applied"
|
|
(hk-eval-expr-source "(10 -) 4")
|
|
6)
|
|
|
|
;; ── Multi-clause top-level functions ──
|
|
(hk-test
|
|
"multi-clause: factorial"
|
|
(hk-prog-val
|
|
"fact 0 = 1\nfact n = n * fact (n - 1)\nresult = fact 6"
|
|
"result")
|
|
720)
|
|
|
|
(hk-test
|
|
"multi-clause: list length via cons pattern"
|
|
(hk-prog-val
|
|
"len [] = 0\nlen (x:xs) = 1 + len xs\nresult = len [10, 20, 30, 40]"
|
|
"result")
|
|
4)
|
|
|
|
(hk-test
|
|
"multi-clause: Maybe handler"
|
|
(hk-prog-val
|
|
"fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 (Just 9)"
|
|
"result")
|
|
9)
|
|
|
|
(hk-test
|
|
"multi-clause: Maybe with default"
|
|
(hk-prog-val
|
|
"fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 Nothing"
|
|
"result")
|
|
0)
|
|
|
|
;; ── User-defined data and matching ──
|
|
(hk-test
|
|
"custom data with pattern match"
|
|
(hk-prog-val
|
|
"data Color = Red | Green | Blue\nname Red = \"red\"\nname Green = \"green\"\nname Blue = \"blue\"\nresult = name Green"
|
|
"result")
|
|
"green")
|
|
|
|
(hk-test
|
|
"custom binary tree height"
|
|
(hk-prog-val
|
|
"data Tree = Leaf | Node Tree Tree\nh Leaf = 0\nh (Node l r) = 1 + max (h l) (h r)\nmax a b = if a > b then a else b\nresult = h (Node (Node Leaf Leaf) Leaf)"
|
|
"result")
|
|
2)
|
|
|
|
;; ── Currying ──
|
|
(hk-test
|
|
"partial application"
|
|
(hk-prog-val
|
|
"add x y = x + y\nadd5 = add 5\nresult = add5 7"
|
|
"result")
|
|
12)
|
|
|
|
;; ── Higher-order ──
|
|
(hk-test
|
|
"higher-order: function as arg"
|
|
(hk-prog-val
|
|
"twice f x = f (f x)\ninc x = x + 1\nresult = twice inc 10"
|
|
"result")
|
|
12)
|
|
|
|
;; ── Error built-in ──
|
|
(hk-test
|
|
"error short-circuits via if"
|
|
(hk-eval-expr-source
|
|
"if True then 1 else error \"unreachable\"")
|
|
1)
|
|
|
|
;; ── Laziness: app args evaluate only when forced ──
|
|
(hk-test
|
|
"second arg never forced"
|
|
(hk-eval-expr-source
|
|
"(\\x y -> x) 1 (error \"never\")")
|
|
1)
|
|
|
|
(hk-test
|
|
"first arg never forced"
|
|
(hk-eval-expr-source
|
|
"(\\x y -> y) (error \"never\") 99")
|
|
99)
|
|
|
|
(hk-test
|
|
"constructor argument is lazy under wildcard pattern"
|
|
(hk-eval-expr-source
|
|
"case Just (error \"deeply\") of Just _ -> 7 ; Nothing -> 0")
|
|
7)
|
|
|
|
(hk-test
|
|
"lazy: const drops its second argument"
|
|
(hk-prog-val
|
|
"const x y = x\nresult = const 5 (error \"boom\")"
|
|
"result")
|
|
5)
|
|
|
|
(hk-test
|
|
"lazy: head ignores tail"
|
|
(hk-prog-val
|
|
"myHead (x:_) = x\nresult = myHead (1 : (error \"tail\") : [])"
|
|
"result")
|
|
1)
|
|
|
|
(hk-test
|
|
"lazy: Just on undefined evaluates only on force"
|
|
(hk-prog-val
|
|
"wrapped = Just (error \"oh no\")\nresult = case wrapped of Just _ -> True ; Nothing -> False"
|
|
"result")
|
|
(list "True"))
|
|
|
|
;; ── not / id built-ins ──
|
|
(hk-test "not True" (hk-eval-expr-source "not True") (list "False"))
|
|
(hk-test "not False" (hk-eval-expr-source "not False") (list "True"))
|
|
(hk-test "id" (hk-eval-expr-source "id 42") 42)
|
|
|
|
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|