haskell: full patterns — as/lazy/negative/infix + lambda & let pat LHS (+18 tests, 138/138)

lib/haskell/parser.sx

@@ -104,9 +104,9 @@
       (nil? tok)
       false
       (let
-        ((ty (get tok "type")))
+        ((ty (get tok "type")) (val (get tok "value")))
         (or
-          (and (= ty "reserved") (= (get tok "value") "_"))
+          (and (= ty "reserved") (= val "_"))
           (= ty "integer")
           (= ty "float")
           (= ty "string")
@@ -115,7 +115,9 @@
           (= ty "conid")
           (= ty "qconid")
           (= ty "lparen")
-          (= ty "lbracket"))))))
+          (= ty "lbracket")
+          (and (= ty "varsym") (= val "-"))
+          (and (= ty "reservedop") (= val "~")))))))
 
 ;; ── Main entry ───────────────────────────────────────────────────
 (define
@@ -313,7 +315,7 @@
             (hk-app-loop)
             fn-e)))
 
-      ;; ── Lambda: \ p1 p2 ... pn -> body ───────────────────────
+      ;; ── Lambda: \ apat1 apat2 ... apatn -> body ──────────────
       (define
         hk-parse-lambda
         (fn
@@ -322,16 +324,16 @@
           (let
             ((params (list)))
             (when
-              (not (hk-match? "varid" nil))
-              (hk-err "lambda parameter must be a variable"))
+              (not (hk-apat-start? (hk-peek)))
+              (hk-err "lambda needs at least one pattern parameter"))
             (define
               hk-lam-loop
               (fn
                 ()
                 (when
-                  (hk-match? "varid" nil)
+                  (hk-apat-start? (hk-peek))
                   (do
-                    (append! params (get (hk-advance!) "value"))
+                    (append! params (hk-parse-apat))
                     (hk-lam-loop)))))
             (hk-lam-loop)
             (hk-expect! "reservedop" "->")
@@ -400,17 +402,17 @@
               (hk-expect! "reserved" "in")
               (list :let binds (hk-parse-expr-inner))))))
 
+      ;; Binding LHS is a pattern. Simple `x = e` parses as
+      ;; (:bind (:p-var "x") e); pattern bindings like
+      ;; `(x, y) = pair` parse with a p-tuple LHS.
       (define
         hk-parse-bind
         (fn
           ()
-          (when
-            (not (hk-match? "varid" nil))
-            (hk-err "binding must start with a variable"))
           (let
-            ((name (get (hk-advance!) "value")))
+            ((pat (hk-parse-pat)))
             (hk-expect! "reservedop" "=")
-            (list :bind name (hk-parse-expr-inner)))))
+            (list :bind pat (hk-parse-expr-inner)))))
 
       ;; ── Patterns ─────────────────────────────────────────────
       (define
@@ -425,6 +427,31 @@
                   (= (get t "type") "reserved")
                   (= (get t "value") "_"))
                 (do (hk-advance!) (list :p-wild)))
+              ((and
+                  (= (get t "type") "reservedop")
+                  (= (get t "value") "~"))
+                (do (hk-advance!) (list :p-lazy (hk-parse-apat))))
+              ((and
+                  (= (get t "type") "varsym")
+                  (= (get t "value") "-"))
+                (do
+                  (hk-advance!)
+                  (let
+                    ((n (hk-peek)))
+                    (cond
+                      ((nil? n)
+                        (hk-err "expected numeric literal after '-'"))
+                      ((= (get n "type") "integer")
+                        (do
+                          (hk-advance!)
+                          (list :p-int (- 0 (get n "value")))))
+                      ((= (get n "type") "float")
+                        (do
+                          (hk-advance!)
+                          (list :p-float (- 0 (get n "value")))))
+                      (:else
+                        (hk-err
+                          "only numeric literals may follow '-' in a pattern"))))))
               ((= (get t "type") "integer")
                 (do (hk-advance!) (list :p-int (get t "value"))))
               ((= (get t "type") "float")
@@ -434,7 +461,19 @@
               ((= (get t "type") "char")
                 (do (hk-advance!) (list :p-char (get t "value"))))
               ((= (get t "type") "varid")
-                (do (hk-advance!) (list :p-var (get t "value"))))
+                (let
+                  ((next-t (hk-peek-at 1)))
+                  (cond
+                    ((and
+                        (not (nil? next-t))
+                        (= (get next-t "type") "reservedop")
+                        (= (get next-t "value") "@"))
+                      (do
+                        (hk-advance!)
+                        (hk-advance!)
+                        (list :p-as (get t "value") (hk-parse-apat))))
+                    (:else
+                      (do (hk-advance!) (list :p-var (get t "value")))))))
               ((= (get t "type") "conid")
                 (do
                   (hk-advance!)
@@ -503,7 +542,7 @@
                 (list :p-list items))))))
 
       (define
-        hk-parse-pat
+        hk-parse-pat-lhs
         (fn
           ()
           (let
@@ -529,6 +568,27 @@
                   (list :p-con name args)))
               (:else (hk-parse-apat))))))
 
+      ;; Infix constructor patterns: `x : xs`, `a `Cons` b`, etc.
+      ;; Right-associative, single precedence band.
+      (define
+        hk-parse-pat
+        (fn
+          ()
+          (let
+            ((left (hk-parse-pat-lhs)))
+            (cond
+              ((or
+                  (= (hk-peek-type) "consym")
+                  (and
+                    (= (hk-peek-type) "reservedop")
+                    (= (hk-peek-value) ":")))
+                (let
+                  ((op (get (hk-advance!) "value")))
+                  (let
+                    ((right (hk-parse-pat)))
+                    (list :p-con op (list left right)))))
+              (:else left)))))
+
       ;; ── case ─ of { pat -> expr ; ... } ─────────────────────
       (define
         hk-parse-alt