haskell: full patterns — as/lazy/negative/infix + lambda & let pat LHS (+18 tests, 138/138)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
234
lib/haskell/tests/parser-patterns.sx
Normal file
234
lib/haskell/tests/parser-patterns.sx
Normal file
@@ -0,0 +1,234 @@
|
||||
;; Full-pattern parser tests: as-patterns, lazy ~, negative literals,
|
||||
;; infix constructor patterns (`:`, any consym), lambda pattern args,
|
||||
;; and let pattern-bindings.
|
||||
|
||||
;; ── as-patterns ──
|
||||
(hk-test
|
||||
"as pattern, wraps constructor"
|
||||
(hk-parse "case x of n@(Just y) -> n")
|
||||
(list
|
||||
:case
|
||||
(list :var "x")
|
||||
(list
|
||||
(list
|
||||
:alt
|
||||
(list
|
||||
:p-as
|
||||
"n"
|
||||
(list :p-con "Just" (list (list :p-var "y"))))
|
||||
(list :var "n")))))
|
||||
|
||||
(hk-test
|
||||
"as pattern, wraps wildcard"
|
||||
(hk-parse "case x of all@_ -> all")
|
||||
(list
|
||||
:case
|
||||
(list :var "x")
|
||||
(list
|
||||
(list
|
||||
:alt
|
||||
(list :p-as "all" (list :p-wild))
|
||||
(list :var "all")))))
|
||||
|
||||
(hk-test
|
||||
"as in lambda"
|
||||
(hk-parse "\\xs@(a : rest) -> xs")
|
||||
(list
|
||||
:lambda
|
||||
(list
|
||||
(list
|
||||
:p-as
|
||||
"xs"
|
||||
(list
|
||||
:p-con
|
||||
":"
|
||||
(list (list :p-var "a") (list :p-var "rest")))))
|
||||
(list :var "xs")))
|
||||
|
||||
;; ── lazy patterns ──
|
||||
(hk-test
|
||||
"lazy var"
|
||||
(hk-parse "case x of ~y -> y")
|
||||
(list
|
||||
:case
|
||||
(list :var "x")
|
||||
(list
|
||||
(list :alt (list :p-lazy (list :p-var "y")) (list :var "y")))))
|
||||
|
||||
(hk-test
|
||||
"lazy constructor"
|
||||
(hk-parse "\\(~(Just x)) -> x")
|
||||
(list
|
||||
:lambda
|
||||
(list
|
||||
(list
|
||||
:p-lazy
|
||||
(list :p-con "Just" (list (list :p-var "x")))))
|
||||
(list :var "x")))
|
||||
|
||||
;; ── negative literal patterns ──
|
||||
(hk-test
|
||||
"negative int pattern"
|
||||
(hk-parse "case n of\n -1 -> 0\n _ -> n")
|
||||
(list
|
||||
:case
|
||||
(list :var "n")
|
||||
(list
|
||||
(list :alt (list :p-int -1) (list :int 0))
|
||||
(list :alt (list :p-wild) (list :var "n")))))
|
||||
|
||||
(hk-test
|
||||
"negative float pattern"
|
||||
(hk-parse "case x of -0.5 -> 1")
|
||||
(list
|
||||
:case
|
||||
(list :var "x")
|
||||
(list (list :alt (list :p-float -0.5) (list :int 1)))))
|
||||
|
||||
;; ── infix constructor patterns (`:` and any consym) ──
|
||||
(hk-test
|
||||
"cons pattern"
|
||||
(hk-parse "case xs of x : rest -> x")
|
||||
(list
|
||||
:case
|
||||
(list :var "xs")
|
||||
(list
|
||||
(list
|
||||
:alt
|
||||
(list
|
||||
:p-con
|
||||
":"
|
||||
(list (list :p-var "x") (list :p-var "rest")))
|
||||
(list :var "x")))))
|
||||
|
||||
(hk-test
|
||||
"cons is right-associative in pats"
|
||||
(hk-parse "case xs of a : b : rest -> rest")
|
||||
(list
|
||||
:case
|
||||
(list :var "xs")
|
||||
(list
|
||||
(list
|
||||
:alt
|
||||
(list
|
||||
:p-con
|
||||
":"
|
||||
(list
|
||||
(list :p-var "a")
|
||||
(list
|
||||
:p-con
|
||||
":"
|
||||
(list (list :p-var "b") (list :p-var "rest")))))
|
||||
(list :var "rest")))))
|
||||
|
||||
(hk-test
|
||||
"consym pattern"
|
||||
(hk-parse "case p of a :+: b -> a")
|
||||
(list
|
||||
:case
|
||||
(list :var "p")
|
||||
(list
|
||||
(list
|
||||
:alt
|
||||
(list
|
||||
:p-con
|
||||
":+:"
|
||||
(list (list :p-var "a") (list :p-var "b")))
|
||||
(list :var "a")))))
|
||||
|
||||
;; ── lambda with pattern args ──
|
||||
(hk-test
|
||||
"lambda with constructor pattern"
|
||||
(hk-parse "\\(Just x) -> x")
|
||||
(list
|
||||
:lambda
|
||||
(list (list :p-con "Just" (list (list :p-var "x"))))
|
||||
(list :var "x")))
|
||||
|
||||
(hk-test
|
||||
"lambda with tuple pattern"
|
||||
(hk-parse "\\(a, b) -> a + b")
|
||||
(list
|
||||
:lambda
|
||||
(list
|
||||
(list
|
||||
:p-tuple
|
||||
(list (list :p-var "a") (list :p-var "b"))))
|
||||
(list :op "+" (list :var "a") (list :var "b"))))
|
||||
|
||||
(hk-test
|
||||
"lambda with wildcard"
|
||||
(hk-parse "\\_ -> 42")
|
||||
(list :lambda (list (list :p-wild)) (list :int 42)))
|
||||
|
||||
(hk-test
|
||||
"lambda with mixed apats"
|
||||
(hk-parse "\\x _ (Just y) -> y")
|
||||
(list
|
||||
:lambda
|
||||
(list
|
||||
(list :p-var "x")
|
||||
(list :p-wild)
|
||||
(list :p-con "Just" (list (list :p-var "y"))))
|
||||
(list :var "y")))
|
||||
|
||||
;; ── let pattern-bindings ──
|
||||
(hk-test
|
||||
"let tuple pattern-binding"
|
||||
(hk-parse "let (x, y) = pair in x + y")
|
||||
(list
|
||||
:let
|
||||
(list
|
||||
(list
|
||||
:bind
|
||||
(list
|
||||
:p-tuple
|
||||
(list (list :p-var "x") (list :p-var "y")))
|
||||
(list :var "pair")))
|
||||
(list :op "+" (list :var "x") (list :var "y"))))
|
||||
|
||||
(hk-test
|
||||
"let constructor pattern-binding"
|
||||
(hk-parse "let Just x = m in x")
|
||||
(list
|
||||
:let
|
||||
(list
|
||||
(list
|
||||
:bind
|
||||
(list :p-con "Just" (list (list :p-var "x")))
|
||||
(list :var "m")))
|
||||
(list :var "x")))
|
||||
|
||||
(hk-test
|
||||
"let cons pattern-binding"
|
||||
(hk-parse "let (x : rest) = xs in x")
|
||||
(list
|
||||
:let
|
||||
(list
|
||||
(list
|
||||
:bind
|
||||
(list
|
||||
:p-con
|
||||
":"
|
||||
(list (list :p-var "x") (list :p-var "rest")))
|
||||
(list :var "xs")))
|
||||
(list :var "x")))
|
||||
|
||||
;; ── do with constructor-pattern binds ──
|
||||
(hk-test
|
||||
"do bind to tuple pattern"
|
||||
(hk-parse "do\n (a, b) <- pairs\n return a")
|
||||
(list
|
||||
:do
|
||||
(list
|
||||
(list
|
||||
:do-bind
|
||||
(list
|
||||
:p-tuple
|
||||
(list (list :p-var "a") (list :p-var "b")))
|
||||
(list :var "pairs"))
|
||||
(list
|
||||
:do-expr
|
||||
(list :app (list :var "return") (list :var "a"))))))
|
||||
|
||||
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|
||||
Reference in New Issue
Block a user