haskell: Phase 9 — error builtin raises with hk-error: prefix (+2 tests, 57/57)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/haskell/eval.sx

@@ -135,11 +135,9 @@
             (let
               ((env-after (hk-match p1 arg env)))
               (cond
-                ((nil? env-after)
+                ((nil? env-after) (raise "pattern match failure in lambda"))
-                  (raise "pattern match failure in lambda"))
                 ((empty? rest-p) (hk-eval body env-after))
-                (:else
+                (:else (hk-mk-closure rest-p body env-after))))))))))
-                  (hk-mk-closure rest-p body env-after))))))))))
 
 (define
   hk-apply-multi
@@ -151,8 +149,7 @@
         (env (get mf "env"))
         (collected (append (get mf "collected") (list arg))))
       (cond
-        ((< (len collected) arity)
+        ((< (len collected) arity) (assoc mf "collected" collected))
-          (assoc mf "collected" collected))
         (:else (hk-dispatch-multi clauses collected env))))))
 
 (define
@@ -185,8 +182,7 @@
           ((res (hk-match (first pats) (first args) env)))
           (cond
             ((nil? res) nil)
-            (:else
+            (:else (hk-match-args (rest pats) (rest args) res))))))))
-              (hk-match-args (rest pats) (rest args) res))))))))
 
 (define
   hk-apply-con-partial
@@ -208,25 +204,16 @@
       ((arity (get b "arity"))
         (collected (append (get b "collected") (list arg))))
       (cond
-        ((< (len collected) arity)
+        ((< (len collected) arity) (assoc b "collected" collected))
-          (assoc b "collected" collected))
         (:else
-          ;; Strict built-ins force every collected arg before
-          ;; calling. Lazy ones (`seq`, `deepseq`) receive the raw
-          ;; thunks so they can choose what to force.
           (cond
             ((get b "lazy") (apply (get b "fn") collected))
-            (:else
+            (:else (apply (get b "fn") (map hk-force collected)))))))))
-              (apply
-                (get b "fn")
-                (map hk-force collected)))))))))
 
 ;; ── Bool helpers (Bool values are tagged conses) ────────────
 (define
   hk-truthy?
-  (fn
+  (fn (v) (and (list? v) (not (empty? v)) (= (first v) "True"))))
-    (v)
-    (and (list? v) (not (empty? v)) (= (first v) "True"))))
 
 (define hk-true (hk-mk-con "True" (list)))
 (define hk-false (hk-mk-con "False" (list)))
@@ -250,8 +237,7 @@
             ((= tag "char") (nth node 1))
             ((= tag "var") (hk-eval-var (nth node 1) env))
             ((= tag "con") (hk-eval-con-ref (nth node 1)))
-            ((= tag "neg")
+            ((= tag "neg") (- 0 (hk-force (hk-eval (nth node 1) env))))
-              (- 0 (hk-force (hk-eval (nth node 1) env))))
             ((= tag "if") (hk-eval-if node env))
             ((= tag "let") (hk-eval-let (nth node 1) (nth node 2) env))
             ((= tag "lambda")
@@ -261,19 +247,12 @@
                 (hk-eval (nth node 1) env)
                 (hk-mk-thunk (nth node 2) env)))
             ((= tag "op")
-              (hk-eval-op
+              (hk-eval-op (nth node 1) (nth node 2) (nth node 3) env))
-                (nth node 1)
+            ((= tag "case") (hk-eval-case (nth node 1) (nth node 2) env))
-                (nth node 2)
-                (nth node 3)
-                env))
-            ((= tag "case")
-              (hk-eval-case (nth node 1) (nth node 2) env))
             ((= tag "tuple")
-              (hk-mk-tuple
+              (hk-mk-tuple (map (fn (e) (hk-eval e env)) (nth node 1))))
-                (map (fn (e) (hk-eval e env)) (nth node 1))))
             ((= tag "list")
-              (hk-mk-list
+              (hk-mk-list (map (fn (e) (hk-eval e env)) (nth node 1))))
-                (map (fn (e) (hk-eval e env)) (nth node 1))))
             ((= tag "range")
               (let
                 ((from (hk-force (hk-eval (nth node 1) env)))
@@ -286,25 +265,18 @@
                   (to (hk-force (hk-eval (nth node 3) env))))
                 (hk-build-range from to (- nxt from))))
             ((= tag "range-from")
-              ;; [from..] = iterate (+ 1) from — uses the Prelude.
               (hk-eval
                 (list
-                  :app
+                  :app (list
-                  (list
+                    :app (list :var "iterate")
-                    :app
+                    (list :sect-right "+" (list :int 1)))
-                    (list :var "iterate")
-                    (list
-                      :sect-right
-                      "+"
-                      (list :int 1)))
                   (nth node 1))
                 env))
             ((= tag "sect-left")
               (hk-eval-sect-left (nth node 1) (nth node 2) env))
             ((= tag "sect-right")
               (hk-eval-sect-right (nth node 1) (nth node 2) env))
-            (:else
+            (:else (raise (str "eval: unknown node tag '" tag "'")))))))))
-              (raise (str "eval: unknown node tag '" tag "'")))))))))
 
 (define
   hk-eval-var
@@ -319,18 +291,19 @@
   hk-eval-con-ref
   (fn
     (name)
-    (let ((arity (hk-con-arity name)))
+    (let
+      ((arity (hk-con-arity name)))
       (cond
         ((nil? arity) (raise (str "unknown constructor: " name)))
         ((= arity 0) (hk-mk-con name (list)))
-        (:else
+        (:else {:args (list) :arity arity :type "con-partial" :name name})))))
-          {:type "con-partial" :name name :arity arity :args (list)})))))
 
 (define
   hk-eval-if
   (fn
     (node env)
-    (let ((cv (hk-force (hk-eval (nth node 1) env))))
+    (let
+      ((cv (hk-force (hk-eval (nth node 1) env))))
       (cond
         ((hk-truthy? cv) (hk-eval (nth node 2) env))
         ((and (list? cv) (= (first cv) "False"))
@@ -351,37 +324,33 @@
   hk-eval-let-bind!
   (fn
     (b env)
-    (let ((tag (first b)))
+    (let
+      ((tag (first b)))
       (cond
         ((= tag "fun-clause")
           (let
-            ((name (nth b 1))
+            ((name (nth b 1)) (pats (nth b 2)) (body (nth b 3)))
-              (pats (nth b 2))
-              (body (nth b 3)))
             (cond
-              ((empty? pats)
+              ((empty? pats) (dict-set! env name (hk-eval body env)))
-                (dict-set! env name (hk-eval body env)))
+              (:else (dict-set! env name (hk-mk-closure pats body env))))))
-              (:else
-                (dict-set! env name (hk-mk-closure pats body env))))))
         ((or (= tag "bind") (= tag "pat-bind"))
-          (let ((pat (nth b 1)) (body (nth b 2)))
+          (let
-            (let ((val (hk-eval body env)))
+            ((pat (nth b 1)) (body (nth b 2)))
-              (let ((res (hk-match pat val env)))
+            (let
+              ((val (hk-eval body env)))
+              (let
+                ((res (hk-match pat val env)))
                 (cond
-                  ((nil? res)
+                  ((nil? res) (raise "let: pattern bind failure"))
-                    (raise "let: pattern bind failure"))
+                  (:else (hk-extend-env-with-match! env res)))))))
-                  (:else
-                    (hk-extend-env-with-match! env res)))))))
         (:else nil)))))
 
 (define
   hk-eval-let
   (fn
     (binds body env)
-    ;; Reuse hk-bind-decls! so multi-clause fun bindings in where/let
+    (let
-    ;; are grouped into multifuns, enabling patterns like:
+      ((new-env (hk-dict-copy env)))
-    ;;   let { go 0 = [[]]; go k = [...] } in go n
-    (let ((new-env (hk-dict-copy env)))
       (hk-bind-decls! new-env binds)
       (hk-eval body new-env))))
 
@@ -389,8 +358,7 @@
   hk-eval-case
   (fn
     (scrut alts env)
-    (let ((sv (hk-force (hk-eval scrut env))))
+    (let ((sv (hk-force (hk-eval scrut env)))) (hk-try-alts alts sv env))))
-      (hk-try-alts alts sv env))))
 
 (define
   hk-try-alts
@@ -414,14 +382,8 @@
   (fn
     (op left right env)
     (cond
-      ;; Cons is non-strict in both args: build a cons cell whose
-      ;; head and tail are deferred. This is what makes `repeat x =
-      ;; x : repeat x` and `fibs = 0 : 1 : zipWith (+) fibs (tail
-      ;; fibs)` terminate.
       ((= op ":")
-        (hk-mk-cons
+        (hk-mk-cons (hk-mk-thunk left env) (hk-mk-thunk right env)))
-          (hk-mk-thunk left env)
-          (hk-mk-thunk right env)))
       (:else
         (let
           ((lv (hk-force (hk-eval left env)))
@@ -452,8 +414,7 @@
       ((and (> step 0) (> from to)) (hk-mk-nil))
       ((and (< step 0) (< from to)) (hk-mk-nil))
       ((= step 0) (hk-mk-nil))
-      (:else
+      (:else (hk-mk-cons from (hk-build-range (+ from step) to step))))))
-        (hk-mk-cons from (hk-build-range (+ from step) to step))))))
 
 (define
   hk-binop
@@ -495,33 +456,28 @@
   hk-eval-sect-left
   (fn
     (op e env)
-    ;; (e op) = \x -> e op x — bind e once, defer the operator call.
+    (let
-    (let ((ev (hk-eval e env)))
+      ((ev (hk-eval e env)))
-      (let ((cenv (hk-dict-copy env)))
+      (let
+        ((cenv (hk-dict-copy env)))
         (dict-set! cenv "__hk-sect-l" ev)
         (hk-mk-closure
           (list (list :p-var "__hk-sect-x"))
-          (list
+          (list :op op (list :var "__hk-sect-l") (list :var "__hk-sect-x"))
-            :op
-            op
-            (list :var "__hk-sect-l")
-            (list :var "__hk-sect-x"))
           cenv)))))
 
 (define
   hk-eval-sect-right
   (fn
     (op e env)
-    (let ((ev (hk-eval e env)))
+    (let
-      (let ((cenv (hk-dict-copy env)))
+      ((ev (hk-eval e env)))
+      (let
+        ((cenv (hk-dict-copy env)))
         (dict-set! cenv "__hk-sect-r" ev)
         (hk-mk-closure
           (list (list :p-var "__hk-sect-x"))
-          (list
+          (list :op op (list :var "__hk-sect-x") (list :var "__hk-sect-r"))
-            :op
-            op
-            (list :var "__hk-sect-x")
-            (list :var "__hk-sect-r"))
           cenv)))))
 
 ;; ── Top-level program evaluation ────────────────────────────
@@ -532,10 +488,7 @@
   hk-make-binop-builtin
   (fn
     (name op-name)
-    (hk-mk-builtin
+    (hk-mk-builtin name (fn (a b) (hk-binop op-name a b)) 2)))
-      name
-      (fn (a b) (hk-binop op-name a b))
-      2)))
 
 ;; Inline Prelude source — loaded into the initial env so simple
 ;; programs can use `head`, `take`, `repeat`, etc. without each
@@ -549,14 +502,11 @@
   hk-load-into!
   (fn
     (env src)
-    (let ((ast (hk-core src)))
+    (let
+      ((ast (hk-core src)))
       (hk-register-program! ast)
       (let
-        ((decls
+        ((decls (cond ((= (first ast) "program") (nth ast 1)) ((= (first ast) "module") (nth ast 4)) (:else (list)))))
-            (cond
-              ((= (first ast) "program") (nth ast 1))
-              ((= (first ast) "module") (nth ast 4))
-              (:else (list)))))
         (hk-bind-decls! env decls)))))
 
 (define
@@ -635,10 +585,7 @@
       (dict-set!
         env
         "error"
-        (hk-mk-builtin
+        (hk-mk-builtin "error" (fn (msg) (raise (str "hk-error: " msg))) 1))
-          "error"
-          (fn (msg) (raise (str "*** Exception: " msg)))
-          1))
       (dict-set!
         env
         "not"

lib/haskell/tests/eval.sx

@@ -231,16 +231,30 @@
   1)
 
 ;; ── Laziness: app args evaluate only when forced ──
+(hk-test
+  "error builtin: raises with hk-error prefix"
+  (guard
+    (e (true (>= (index-of e "hk-error: boom") 0)))
+    (begin (hk-deep-force (hk-run "main = error \"boom\"")) false))
+  true)
+
+(hk-test
+  "error builtin: raises with computed message"
+  (guard
+    (e (true (>= (index-of e "hk-error: oops: 42") 0)))
+    (begin
+      (hk-deep-force (hk-run "main = error (\"oops: \" ++ show 42)"))
+      false))
+  true)
+
 (hk-test
   "second arg never forced"
-  (hk-eval-expr-source
+  (hk-eval-expr-source "(\\x y -> x) 1 (error \"never\")")
-    "(\\x y -> x) 1 (error \"never\")")
   1)
 
 (hk-test
   "first arg never forced"
-  (hk-eval-expr-source
+  (hk-eval-expr-source "(\\x y -> y) (error \"never\") 99")
-    "(\\x y -> y) (error \"never\") 99")
   99)
 
 (hk-test
@@ -251,28 +265,26 @@
 
 (hk-test
   "lazy: const drops its second argument"
-  (hk-prog-val
+  (hk-prog-val "const x y = x\nresult = const 5 (error \"boom\")" "result")
-    "const x y = x\nresult = const 5 (error \"boom\")"
-    "result")
   5)
 
+;; ── not / id built-ins ──
 (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}

plans/haskell-completeness.md

@@ -122,7 +122,11 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
 
 ### Phase 9 — `error` / `undefined`
 
-- [ ] `error :: String -> a` — raises `(raise (list "hk-error" msg))` in SX.
+- [x] `error :: String -> a` — raises `(raise "hk-error: <msg>")` in SX.
+  _Plan amended:_ SX's `apply` rewrites unhandled list raises to a string
+  `"Unhandled exception: <serialized>"` before any user handler sees them, so
+  the tag has to live in a string prefix rather than as the head of a list.
+  Catchers use `(index-of e "hk-error: ")` to detect.
 - [ ] `undefined :: a` = `error "Prelude.undefined"`.
 - [ ] Partial functions emit proper error messages: `head []` →
   `"Prelude.head: empty list"`, `tail []` → `"Prelude.tail: empty list"`,
@@ -289,6 +293,18 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
 
 _Newest first._
 
+**2026-05-07** — Phase 9 `error :: String -> a` raises with `hk-error:` prefix:
+- Pre-existing `error` builtin was raising `"*** Exception: <msg>"` (GHC
+  console convention). Renamed prefix to `"hk-error: "` so the wrap-around
+  string SX's `apply` produces (`"Unhandled exception: \"hk-error: ...\""`)
+  contains a stable, searchable tag.
+- Investigation confirmed that the plan's intended `(raise (list "hk-error" msg))`
+  format is mangled by SX `apply` to a string. Plan note added; tests use
+  `index-of` substring matching against the wrapped string.
+- 2 new tests in `tests/eval.sx` (string and computed-message form). Suite
+  is 57/57. Other test suites unchanged (match 31/31, stdlib 48/48, derive
+  15/15, do-io 16/16, class 14/14).
+
 **2026-05-07** — Phase 8 conformance: `showadt.hs` + `showio.hs` (both 5/5):
 - `program-showadt.sx`: `deriving (Show)` on the classic `Expr = Lit | Add | Mul`
   recursive ADT; tests `print` on three nested expressions and inline `show`