haskell: value-level pattern matcher (+31 tests, 281/281)

lib/haskell/tests/match.sx

@@ -0,0 +1,256 @@
+;; Pattern-matcher tests. The matcher takes (pat val env) and returns
+;; an extended env dict on success, or `nil` on failure. Constructor
+;; values are tagged lists (con-name first); tuples use the "Tuple"
+;; tag; lists use chained `:` cons with `[]` nil.
+
+;; ── Atomic patterns ──
+(hk-test
+  "wildcard always matches"
+  (hk-match (list :p-wild) 42 (dict))
+  (dict))
+
+(hk-test
+  "var binds value"
+  (hk-match (list :p-var "x") 42 (dict))
+  {:x 42})
+
+(hk-test
+  "var preserves prior env"
+  (hk-match (list :p-var "y") 7 {:x 1})
+  {:x 1 :y 7})
+
+(hk-test
+  "int literal matches equal"
+  (hk-match (list :p-int 5) 5 (dict))
+  (dict))
+
+(hk-test
+  "int literal fails on mismatch"
+  (hk-match (list :p-int 5) 6 (dict))
+  nil)
+
+(hk-test
+  "negative int literal matches"
+  (hk-match (list :p-int -3) -3 (dict))
+  (dict))
+
+(hk-test
+  "string literal matches"
+  (hk-match (list :p-string "hi") "hi" (dict))
+  (dict))
+
+(hk-test
+  "string literal fails"
+  (hk-match (list :p-string "hi") "bye" (dict))
+  nil)
+
+(hk-test
+  "char literal matches"
+  (hk-match (list :p-char "a") "a" (dict))
+  (dict))
+
+;; ── Constructor patterns ──
+(hk-test
+  "0-arity con matches"
+  (hk-match
+    (list :p-con "Nothing" (list))
+    (hk-mk-con "Nothing" (list))
+    (dict))
+  (dict))
+
+(hk-test
+  "1-arity con matches and binds"
+  (hk-match
+    (list :p-con "Just" (list (list :p-var "y")))
+    (hk-mk-con "Just" (list 9))
+    (dict))
+  {:y 9})
+
+(hk-test
+  "con name mismatch fails"
+  (hk-match
+    (list :p-con "Just" (list (list :p-var "y")))
+    (hk-mk-con "Nothing" (list))
+    (dict))
+  nil)
+
+(hk-test
+  "con arity mismatch fails"
+  (hk-match
+    (list :p-con "Pair" (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-con "Pair" (list 1))
+    (dict))
+  nil)
+
+(hk-test
+  "nested con: Just (Just x)"
+  (hk-match
+    (list
+      :p-con
+      "Just"
+      (list
+        (list
+          :p-con
+          "Just"
+          (list (list :p-var "x")))))
+    (hk-mk-con "Just" (list (hk-mk-con "Just" (list 42))))
+    (dict))
+  {:x 42})
+
+;; ── Tuple patterns ──
+(hk-test
+  "2-tuple matches and binds"
+  (hk-match
+    (list
+      :p-tuple
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-tuple (list 10 20))
+    (dict))
+  {:a 10 :b 20})
+
+(hk-test
+  "tuple arity mismatch fails"
+  (hk-match
+    (list
+      :p-tuple
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-tuple (list 10 20 30))
+    (dict))
+  nil)
+
+;; ── List patterns ──
+(hk-test
+  "[] pattern matches empty list"
+  (hk-match (list :p-list (list)) (hk-mk-nil) (dict))
+  (dict))
+
+(hk-test
+  "[] pattern fails on non-empty"
+  (hk-match (list :p-list (list)) (hk-mk-list (list 1)) (dict))
+  nil)
+
+(hk-test
+  "[a] pattern matches singleton"
+  (hk-match
+    (list :p-list (list (list :p-var "a")))
+    (hk-mk-list (list 7))
+    (dict))
+  {:a 7})
+
+(hk-test
+  "[a, b] pattern matches pair-list and binds"
+  (hk-match
+    (list
+      :p-list
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-list (list 1 2))
+    (dict))
+  {:a 1 :b 2})
+
+(hk-test
+  "[a, b] fails on too-long list"
+  (hk-match
+    (list
+      :p-list
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-list (list 1 2 3))
+    (dict))
+  nil)
+
+;; Cons-style infix pattern (which the parser produces as :p-con ":")
+(hk-test
+  "cons (h:t) on non-empty list"
+  (hk-match
+    (list
+      :p-con
+      ":"
+      (list (list :p-var "h") (list :p-var "t")))
+    (hk-mk-list (list 1 2 3))
+    (dict))
+  {:h 1 :t (list ":" 2 (list ":" 3 (list "[]")))})
+
+(hk-test
+  "cons fails on empty list"
+  (hk-match
+    (list
+      :p-con
+      ":"
+      (list (list :p-var "h") (list :p-var "t")))
+    (hk-mk-nil)
+    (dict))
+  nil)
+
+;; ── as patterns ──
+(hk-test
+  "as binds whole + sub-pattern"
+  (hk-match
+    (list
+      :p-as
+      "all"
+      (list :p-con "Just" (list (list :p-var "x"))))
+    (hk-mk-con "Just" (list 99))
+    (dict))
+  {:all (list "Just" 99) :x 99})
+
+(hk-test
+  "as on wildcard binds whole"
+  (hk-match
+    (list :p-as "v" (list :p-wild))
+    "anything"
+    (dict))
+  {:v "anything"})
+
+(hk-test
+  "as fails when sub-pattern fails"
+  (hk-match
+    (list
+      :p-as
+      "n"
+      (list :p-con "Just" (list (list :p-var "x"))))
+    (hk-mk-con "Nothing" (list))
+    (dict))
+  nil)
+
+;; ── lazy ~ pattern (eager equivalent for now) ──
+(hk-test
+  "lazy pattern eager-matches its inner"
+  (hk-match
+    (list :p-lazy (list :p-var "y"))
+    42
+    (dict))
+  {:y 42})
+
+;; ── Source-driven: parse a real Haskell pattern, match a value ──
+(hk-test
+  "parsed pattern: Just x against Just 5"
+  (hk-match
+    (hk-parse-pat-source "Just x")
+    (hk-mk-con "Just" (list 5))
+    (dict))
+  {:x 5})
+
+(hk-test
+  "parsed pattern: x : xs against [10, 20, 30]"
+  (hk-match
+    (hk-parse-pat-source "x : xs")
+    (hk-mk-list (list 10 20 30))
+    (dict))
+  {:x 10 :xs (list ":" 20 (list ":" 30 (list "[]")))})
+
+(hk-test
+  "parsed pattern: (a, b) against (1, 2)"
+  (hk-match
+    (hk-parse-pat-source "(a, b)")
+    (hk-mk-tuple (list 1 2))
+    (dict))
+  {:a 1 :b 2})
+
+(hk-test
+  "parsed pattern: n@(Just x) against Just 7"
+  (hk-match
+    (hk-parse-pat-source "n@(Just x)")
+    (hk-mk-con "Just" (list 7))
+    (dict))
+  {:n (list "Just" 7) :x 7})
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}