giles
58dbbc5d8b
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
279 lines
6.3 KiB
Plaintext
279 lines
6.3 KiB
Plaintext
;; case-of and do-notation parser tests.
|
|
;; Covers the minimal patterns needed to make these meaningful: var,
|
|
;; wildcard, literal, constructor (with and without args), tuple, list.
|
|
|
|
;; ── Patterns (in case arms) ──
|
|
(hk-test
|
|
"wildcard pat"
|
|
(hk-parse "case x of _ -> 0")
|
|
(list
|
|
:case
|
|
(list :var "x")
|
|
(list (list :alt (list :p-wild) (list :int 0)))))
|
|
|
|
(hk-test
|
|
"var pat"
|
|
(hk-parse "case x of y -> y")
|
|
(list
|
|
:case
|
|
(list :var "x")
|
|
(list
|
|
(list :alt (list :p-var "y") (list :var "y")))))
|
|
|
|
(hk-test
|
|
"0-arity constructor pat"
|
|
(hk-parse "case x of\n Nothing -> 0\n Just y -> y")
|
|
(list
|
|
:case
|
|
(list :var "x")
|
|
(list
|
|
(list :alt (list :p-con "Nothing" (list)) (list :int 0))
|
|
(list
|
|
:alt
|
|
(list :p-con "Just" (list (list :p-var "y")))
|
|
(list :var "y")))))
|
|
|
|
(hk-test
|
|
"int literal pat"
|
|
(hk-parse "case n of\n 0 -> 1\n _ -> n")
|
|
(list
|
|
:case
|
|
(list :var "n")
|
|
(list
|
|
(list :alt (list :p-int 0) (list :int 1))
|
|
(list :alt (list :p-wild) (list :var "n")))))
|
|
|
|
(hk-test
|
|
"string literal pat"
|
|
(hk-parse "case s of\n \"hi\" -> 1\n _ -> 0")
|
|
(list
|
|
:case
|
|
(list :var "s")
|
|
(list
|
|
(list :alt (list :p-string "hi") (list :int 1))
|
|
(list :alt (list :p-wild) (list :int 0)))))
|
|
|
|
(hk-test
|
|
"tuple pat"
|
|
(hk-parse "case p of (a, b) -> a")
|
|
(list
|
|
:case
|
|
(list :var "p")
|
|
(list
|
|
(list
|
|
:alt
|
|
(list
|
|
:p-tuple
|
|
(list (list :p-var "a") (list :p-var "b")))
|
|
(list :var "a")))))
|
|
|
|
(hk-test
|
|
"list pat"
|
|
(hk-parse "case xs of\n [] -> 0\n [a] -> a")
|
|
(list
|
|
:case
|
|
(list :var "xs")
|
|
(list
|
|
(list :alt (list :p-list (list)) (list :int 0))
|
|
(list
|
|
:alt
|
|
(list :p-list (list (list :p-var "a")))
|
|
(list :var "a")))))
|
|
|
|
(hk-test
|
|
"nested constructor pat"
|
|
(hk-parse "case x of\n Just (a, b) -> a\n _ -> 0")
|
|
(list
|
|
:case
|
|
(list :var "x")
|
|
(list
|
|
(list
|
|
:alt
|
|
(list
|
|
:p-con
|
|
"Just"
|
|
(list
|
|
(list
|
|
:p-tuple
|
|
(list (list :p-var "a") (list :p-var "b")))))
|
|
(list :var "a"))
|
|
(list :alt (list :p-wild) (list :int 0)))))
|
|
|
|
(hk-test
|
|
"constructor with multiple var args"
|
|
(hk-parse "case t of Pair a b -> a")
|
|
(list
|
|
:case
|
|
(list :var "t")
|
|
(list
|
|
(list
|
|
:alt
|
|
(list
|
|
:p-con
|
|
"Pair"
|
|
(list (list :p-var "a") (list :p-var "b")))
|
|
(list :var "a")))))
|
|
|
|
;; ── case-of shapes ──
|
|
(hk-test
|
|
"case with explicit braces"
|
|
(hk-parse "case x of { Just y -> y ; Nothing -> 0 }")
|
|
(list
|
|
:case
|
|
(list :var "x")
|
|
(list
|
|
(list
|
|
:alt
|
|
(list :p-con "Just" (list (list :p-var "y")))
|
|
(list :var "y"))
|
|
(list :alt (list :p-con "Nothing" (list)) (list :int 0)))))
|
|
|
|
(hk-test
|
|
"case scrutinee is a full expression"
|
|
(hk-parse "case f x + 1 of\n y -> y")
|
|
(list
|
|
:case
|
|
(list
|
|
:op
|
|
"+"
|
|
(list :app (list :var "f") (list :var "x"))
|
|
(list :int 1))
|
|
(list (list :alt (list :p-var "y") (list :var "y")))))
|
|
|
|
(hk-test
|
|
"case arm body is full expression"
|
|
(hk-parse "case x of\n Just y -> y + 1")
|
|
(list
|
|
:case
|
|
(list :var "x")
|
|
(list
|
|
(list
|
|
:alt
|
|
(list :p-con "Just" (list (list :p-var "y")))
|
|
(list :op "+" (list :var "y") (list :int 1))))))
|
|
|
|
;; ── do blocks ──
|
|
(hk-test
|
|
"do with two expressions"
|
|
(hk-parse "do\n putStrLn \"hi\"\n return 0")
|
|
(list
|
|
:do
|
|
(list
|
|
(list
|
|
:do-expr
|
|
(list :app (list :var "putStrLn") (list :string "hi")))
|
|
(list
|
|
:do-expr
|
|
(list :app (list :var "return") (list :int 0))))))
|
|
|
|
(hk-test
|
|
"do with bind"
|
|
(hk-parse "do\n x <- getLine\n putStrLn x")
|
|
(list
|
|
:do
|
|
(list
|
|
(list :do-bind (list :p-var "x") (list :var "getLine"))
|
|
(list
|
|
:do-expr
|
|
(list :app (list :var "putStrLn") (list :var "x"))))))
|
|
|
|
(hk-test
|
|
"do with let"
|
|
(hk-parse "do\n let y = 5\n print y")
|
|
(list
|
|
:do
|
|
(list
|
|
(list
|
|
:do-let
|
|
(list (list :bind (list :p-var "y") (list :int 5))))
|
|
(list
|
|
:do-expr
|
|
(list :app (list :var "print") (list :var "y"))))))
|
|
|
|
(hk-test
|
|
"do with multiple let bindings"
|
|
(hk-parse "do\n let x = 1\n y = 2\n print (x + y)")
|
|
(list
|
|
:do
|
|
(list
|
|
(list
|
|
:do-let
|
|
(list
|
|
(list :bind (list :p-var "x") (list :int 1))
|
|
(list :bind (list :p-var "y") (list :int 2))))
|
|
(list
|
|
:do-expr
|
|
(list
|
|
:app
|
|
(list :var "print")
|
|
(list :op "+" (list :var "x") (list :var "y")))))))
|
|
|
|
(hk-test
|
|
"do with bind using constructor pat"
|
|
(hk-parse "do\n Just x <- getMaybe\n return x")
|
|
(list
|
|
:do
|
|
(list
|
|
(list
|
|
:do-bind
|
|
(list :p-con "Just" (list (list :p-var "x")))
|
|
(list :var "getMaybe"))
|
|
(list
|
|
:do-expr
|
|
(list :app (list :var "return") (list :var "x"))))))
|
|
|
|
(hk-test
|
|
"do with explicit braces"
|
|
(hk-parse "do { x <- a ; y <- b ; return (x + y) }")
|
|
(list
|
|
:do
|
|
(list
|
|
(list :do-bind (list :p-var "x") (list :var "a"))
|
|
(list :do-bind (list :p-var "y") (list :var "b"))
|
|
(list
|
|
:do-expr
|
|
(list
|
|
:app
|
|
(list :var "return")
|
|
(list :op "+" (list :var "x") (list :var "y")))))))
|
|
|
|
;; ── Mixing case/do inside expressions ──
|
|
(hk-test
|
|
"case inside let"
|
|
(hk-parse "let f = \\x -> case x of\n Just y -> y\n _ -> 0\nin f 5")
|
|
(list
|
|
:let
|
|
(list
|
|
(list
|
|
:bind
|
|
(list :p-var "f")
|
|
(list
|
|
:lambda
|
|
(list (list :p-var "x"))
|
|
(list
|
|
:case
|
|
(list :var "x")
|
|
(list
|
|
(list
|
|
:alt
|
|
(list :p-con "Just" (list (list :p-var "y")))
|
|
(list :var "y"))
|
|
(list :alt (list :p-wild) (list :int 0)))))))
|
|
(list :app (list :var "f") (list :int 5))))
|
|
|
|
(hk-test
|
|
"lambda containing do"
|
|
(hk-parse "\\x -> do\n y <- x\n return y")
|
|
(list
|
|
:lambda
|
|
(list (list :p-var "x"))
|
|
(list
|
|
:do
|
|
(list
|
|
(list :do-bind (list :p-var "y") (list :var "x"))
|
|
(list
|
|
:do-expr
|
|
(list :app (list :var "return") (list :var "y")))))))
|
|
|
|
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|