haskell: Phase 14 — record creation Foo { f = e, … } (parser + desugar)

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

lib/haskell/desugar.sx

@@ -142,6 +142,41 @@
               (list
                 :app (hk-desugar (nth node 1))
                 (hk-desugar (nth node 2))))
+            ((= tag "rec-create")
+              (let
+                ((cname (nth node 1))
+                  (field-pairs (nth node 2))
+                  (field-order (hk-record-field-names cname)))
+                (cond
+                  ((nil? field-order)
+                    (raise (str "rec-create: no record info for " cname)))
+                  (:else
+                    (let
+                      ((acc (list :con cname)))
+                      (begin
+                        (for-each
+                          (fn
+                            (fname)
+                            (let
+                              ((pair
+                                  (hk-find-rec-pair field-pairs fname)))
+                              (cond
+                                ((nil? pair)
+                                  (raise
+                                    (str
+                                      "rec-create: missing field "
+                                      fname
+                                      " for "
+                                      cname)))
+                                (:else
+                                  (set!
+                                    acc
+                                    (list
+                                      :app
+                                      acc
+                                      (hk-desugar (nth pair 1))))))))
+                          field-order)
+                        acc))))))
             ((= tag "op")
               (list
                 :op (nth node 1)
@@ -206,6 +241,46 @@
             (:else node)))))))
 
 ;; Convenience — tokenize + layout + parse + desugar.
+(define hk-record-fields (dict))
+
+(define
+  hk-register-record-fields!
+  (fn (cname fields) (dict-set! hk-record-fields cname fields)))
+
+(define
+  hk-record-field-names
+  (fn
+    (cname)
+    (if (has-key? hk-record-fields cname) (get hk-record-fields cname) nil)))
+
+(define
+  hk-record-field-index
+  (fn
+    (cname fname)
+    (let
+      ((fields (hk-record-field-names cname)))
+      (cond
+        ((nil? fields) -1)
+        (:else
+          (let
+            ((i 0) (idx -1))
+            (begin
+              (for-each
+                (fn
+                  (f)
+                  (begin (when (= f fname) (set! idx i)) (set! i (+ i 1))))
+                fields)
+              idx)))))))
+
+(define
+  hk-find-rec-pair
+  (fn
+    (pairs name)
+    (cond
+      ((empty? pairs) nil)
+      ((= (first (first pairs)) name) (first pairs))
+      (:else (hk-find-rec-pair (rest pairs) name)))))
+
 (define
   hk-record-accessors
   (fn
@@ -277,6 +352,9 @@
                           (let
                             ((cname (nth c 1)) (rec-fields (nth c 2)))
                             (begin
+                              (hk-register-record-fields!
+                                cname
+                                (map (fn (f) (first f)) rec-fields))
                               (append!
                                 new-cons
                                 (list

lib/haskell/parser.sx

@@ -210,7 +210,12 @@
               ((= (get t "type") "varid")
                 (do (hk-advance!) (list :var (get t "value"))))
               ((= (get t "type") "conid")
-                (do (hk-advance!) (list :con (get t "value"))))
+                (do
+                  (hk-advance!)
+                  (cond
+                    ((hk-match? "lbrace" nil)
+                      (hk-parse-rec-create (get t "value")))
+                    (:else (list :con (get t "value"))))))
               ((= (get t "type") "qvarid")
                 (do (hk-advance!) (list :var (get t "value"))))
               ((= (get t "type") "qconid")
@@ -456,6 +461,34 @@
                     (do
                       (hk-expect! "rbracket" nil)
                       (list :list (list first-e))))))))))
+      (define
+        hk-parse-rec-create
+        (fn
+          (cname)
+          (begin
+            (hk-expect! "lbrace" nil)
+            (let
+              ((fields (list)))
+              (define
+                hk-rc-loop
+                (fn
+                  ()
+                  (when
+                    (hk-match? "varid" nil)
+                    (let
+                      ((fname (get (hk-advance!) "value")))
+                      (begin
+                        (hk-expect! "reservedop" "=")
+                        (let
+                          ((fexpr (hk-parse-expr-inner)))
+                          (begin
+                            (append! fields (list fname fexpr))
+                            (when
+                              (hk-match? "comma" nil)
+                              (begin (hk-advance!) (hk-rc-loop))))))))))
+              (hk-rc-loop)
+              (hk-expect! "rbrace" nil)
+              (list :rec-create cname fields)))))
       (define
         hk-parse-fexp
         (fn

lib/haskell/runtime.sx

@@ -12,12 +12,7 @@
 
 (define
   hk-register-con!
-  (fn
+  (fn (cname arity type-name) (dict-set! hk-constructors cname {:arity arity :type type-name})))
-    (cname arity type-name)
-    (dict-set!
-      hk-constructors
-      cname
-      {:arity arity :type type-name})))
 
 (define hk-is-con? (fn (name) (has-key? hk-constructors name)))
 
@@ -48,26 +43,15 @@
   (fn
     (data-node)
     (let
-      ((type-name (nth data-node 1))
+      ((type-name (nth data-node 1)) (cons-list (nth data-node 3)))
-        (cons-list (nth data-node 3)))
       (for-each
-        (fn
+        (fn (cd) (hk-register-con! (nth cd 1) (len (nth cd 2)) type-name))
-          (cd)
-          (hk-register-con!
-            (nth cd 1)
-            (len (nth cd 2))
-            type-name))
         cons-list))))
 
 ;; (:newtype NAME TVARS CNAME FIELD)
 (define
   hk-register-newtype!
-  (fn
+  (fn (nt-node) (hk-register-con! (nth nt-node 3) 1 (nth nt-node 1))))
-    (nt-node)
-    (hk-register-con!
-      (nth nt-node 3)
-      1
-      (nth nt-node 1))))
 
 ;; Walk a decls list, registering every `data` / `newtype` decl.
 (define
@@ -78,15 +62,9 @@
       (fn
         (d)
         (cond
-          ((and
+          ((and (list? d) (not (empty? d)) (= (first d) "data"))
-              (list? d)
-              (not (empty? d))
-              (= (first d) "data"))
             (hk-register-data! d))
-          ((and
+          ((and (list? d) (not (empty? d)) (= (first d) "newtype"))
-              (list? d)
-              (not (empty? d))
-              (= (first d) "newtype"))
             (hk-register-newtype! d))
           (:else nil)))
       decls)))
@@ -99,16 +77,12 @@
       ((nil? ast) nil)
       ((not (list? ast)) nil)
       ((empty? ast) nil)
-      ((= (first ast) "program")
+      ((= (first ast) "program") (hk-register-decls! (nth ast 1)))
-        (hk-register-decls! (nth ast 1)))
+      ((= (first ast) "module") (hk-register-decls! (nth ast 4)))
-      ((= (first ast) "module")
-        (hk-register-decls! (nth ast 4)))
       (:else nil))))
 
 ;; Convenience: source → AST → desugar → register.
-(define
+(define hk-load-source! (fn (src) (hk-register-program! (hk-core src))))
-  hk-load-source!
-  (fn (src) (hk-register-program! (hk-core src))))
 
 ;; ── Built-in constructors pre-registered ─────────────────────
 ;; Bool — used implicitly by `if`, comparison operators.
@@ -122,9 +96,9 @@
 ;; Standard Prelude types — pre-registered so expression-level
 ;; programs can use them without a `data` decl.
 (hk-register-con! "Nothing" 0 "Maybe")
-(hk-register-con! "Just"    1 "Maybe")
+(hk-register-con! "Just" 1 "Maybe")
-(hk-register-con! "Left"    1 "Either")
+(hk-register-con! "Left" 1 "Either")
-(hk-register-con! "Right"   1 "Either")
+(hk-register-con! "Right" 1 "Either")
 (hk-register-con! "LT" 0 "Ordering")
 (hk-register-con! "EQ" 0 "Ordering")
 (hk-register-con! "GT" 0 "Ordering")

plans/haskell-completeness.md

@@ -251,7 +251,7 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
   constructor bodies. AST node: `(:con-rec CNAME [(FNAME TYPE) …])`.
 - [x] Desugar: `:con-rec` → positional `:con-def` plus generated accessor
   functions `(\rec -> case rec of …)` for each field name.
-- [ ] Record creation `Foo { bar = 1, baz = "x" }` parsed as
+- [x] Record creation `Foo { bar = 1, baz = "x" }` parsed as
   `(:rec-create CON [(FNAME EXPR) …])`. Eval builds the same tagged list as
   positional construction (field order from the data decl).
 - [ ] Record update `r { field = v }` parsed as `(:rec-update EXPR [(FNAME EXPR)])`.
@@ -313,6 +313,18 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
 
 _Newest first._
 
+**2026-05-07** — Phase 14 record-creation syntax `Foo { f = e, … }`:
+- Parser: post-`conid` peek for `{` triggers `hk-parse-rec-create`, returning
+  `(:rec-create cname [(fname expr) …])`.
+- `hk-record-fields` dict (in desugar.sx — load order requires it live there)
+  is populated by `hk-expand-records` when it sees a `con-rec`.
+- New `:rec-create` case in `hk-desugar` looks up the field order, builds an
+  `app` chain `(:app (:app (:con cname) e1) e2 …)` in declared order. Field-
+  pair lookup via new `hk-find-rec-pair` helper. Order in source doesn't
+  matter — `Person { age = 99, name = "bob" }` correctly produces a Person
+  with name="bob", age=99 regardless of source order.
+- Verified via direct execution; no regressions in parse/desugar/deriving.
+
 **2026-05-07** — Phase 14 record desugar (`:con-rec` → positional + accessors):
 - New `hk-record-accessors` helper in `desugar.sx` generates one fun-clause
   per field, pattern-matching on the constructor with wildcards in all other