diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index ca12fdda..22fa3b2c 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -780,6 +780,7 @@ (set! env (ocaml-env-extend env mname mod-val)) (set! result (merge result (dict mname mod-val)))))))) ((= tag "type-def") nil) + ((= tag "type-def-record") nil) ((= tag "exception-def") nil) ((= tag "module-type-def") nil) ((= tag "open") @@ -962,6 +963,10 @@ ;; exception E [of T] — purely declarative; raise+match ;; already work on tagged ctor values. nil) + ((= tag "type-def-record") + ;; type r = { x : T; y : T } — runtime no-op; records + ;; are already dynamic dicts. + nil) ((= tag "module-type-def") ;; module type S = sig … end — no-op at runtime. nil) diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index 67bedc65..cd9ef2f2 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -1186,42 +1186,85 @@ (let ((name (ocaml-tok-value (consume! "ident" nil)))) (begin (consume! "op" "=") - (when (at-op? "|") (advance-tok!)) - ;; Parse a sum-type: Ctor [of TYPE [* TYPE]*] (| Ctor …)* - (let ((ctors (list))) - (begin - (define one - (fn () - (let ((cname (ocaml-tok-value (consume! "ctor" nil))) - (arg-srcs (list))) - (begin - (when (at-kw? "of") - (begin - (advance-tok!) - (let ((arg-start (cur-pos))) - (begin - (define skip-type - (fn () - (cond - ((>= idx tok-len) nil) - ((= (ocaml-tok-type (peek-tok)) "eof") nil) - ((at-op? "|") nil) - ((at-op? ";;") nil) - ((at-kw? "let") nil) - ((at-kw? "type") nil) - ((at-kw? "and") nil) - ((at-kw? "module") nil) - (else (begin (advance-tok!) (skip-type)))))) - (skip-type) - (append! arg-srcs (slice src arg-start (cur-pos))))))) - (append! ctors (cons cname arg-srcs)))))) - (one) - (define more - (fn () - (when (at-op? "|") - (begin (advance-tok!) (one) (more))))) - (more) - (list :type-def name tparams ctors))))))))) + (cond + ;; Record type: type NAME = { f1 [: T1]; f2 [: T2]; ... } + ((at-op? "{") + (begin + (advance-tok!) + (let ((fields (list))) + (begin + (define field-one + (fn () + (let ((mut false)) + (begin + (when (at-kw? "mutable") + (begin (advance-tok!) (set! mut true))) + (let ((fname (ocaml-tok-value (consume! "ident" nil)))) + (begin + (when (at-op? ":") + (begin + (advance-tok!) + (define skip-fty + (fn () + (cond + ((>= idx tok-len) nil) + ((= (ocaml-tok-type (peek-tok)) "eof") nil) + ((at-op? ";") nil) + ((at-op? "}") nil) + (else (begin (advance-tok!) (skip-fty)))))) + (skip-fty))) + (append! fields + (if mut + (list :mutable fname) + (list fname))))))))) + (field-one) + (define field-more + (fn () + (when (at-op? ";") + (begin (advance-tok!) + (when (not (at-op? "}")) + (begin (field-one) (field-more))))))) + (field-more) + (consume! "op" "}") + (list :type-def-record name tparams fields))))) + (else + (begin + (when (at-op? "|") (advance-tok!)) + ;; Sum type: Ctor [of TYPE [* TYPE]*] (| Ctor …)* + (let ((ctors (list))) + (begin + (define one + (fn () + (let ((cname (ocaml-tok-value (consume! "ctor" nil))) + (arg-srcs (list))) + (begin + (when (at-kw? "of") + (begin + (advance-tok!) + (let ((arg-start (cur-pos))) + (begin + (define skip-type + (fn () + (cond + ((>= idx tok-len) nil) + ((= (ocaml-tok-type (peek-tok)) "eof") nil) + ((at-op? "|") nil) + ((at-op? ";;") nil) + ((at-kw? "let") nil) + ((at-kw? "type") nil) + ((at-kw? "and") nil) + ((at-kw? "module") nil) + (else (begin (advance-tok!) (skip-type)))))) + (skip-type) + (append! arg-srcs (slice src arg-start (cur-pos))))))) + (append! ctors (cons cname arg-srcs)))))) + (one) + (define more + (fn () + (when (at-op? "|") + (begin (advance-tok!) (one) (more))))) + (more) + (list :type-def name tparams ctors)))))))))))) ;; open M / include M — collect a path Ctor(.SubCtor)* and emit ;; (:open PATH) or (:include PATH). diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index 3c5f2114..bcf66f4a 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -1098,6 +1098,14 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 3901) (eval "(ocaml-run-program \"let x = 10 ;; let _ = x ;; x * 2\")") +;; ── Record type declarations ────────────────────────────────── +(epoch 4000) +(eval "(ocaml-parse-program \"type point = { x : int; y : int }\")") +(epoch 4001) +(eval "(ocaml-parse-program \"type r = { mutable x : int; y : string }\")") +(epoch 4002) +(eval "(ocaml-run-program \"type point = { x : int; y : int };; let p = { x = 3; y = 4 };; p.x + p.y\")") + EPOCHS OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -1738,6 +1746,11 @@ check 3802 "let-mut f and g" '"Int"' check 3900 "let _ = 1+2;; 42" '42' check 3901 "two top-level lets, _" '20' +# ── Record type declarations ────────────────────────────────── +check 4000 "record type decl" '("type-def-record" "point" () (("x") ("y")))' +check 4001 "mutable field decl" '("mutable" "x")' +check 4002 "record decl + use" '7' + TOTAL=$((PASS + FAIL)) if [ $FAIL -eq 0 ]; then echo "ok $PASS/$TOTAL OCaml-on-SX tests passed" diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index 7dd9e206..cb036366 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -403,6 +403,13 @@ _Newest first._ binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree`) with insert + in-order traversal. Tests parametric ADT, recursive match, List.append, List.fold_left. +- 2026-05-08 Phase 1+3 — record type declarations `type r = { x : int; + mutable y : string }` (+3 tests, 447 total). Parser dispatches on + `{` after `=` to parse field list (`mutable` keyword tracked). + AST: `(:type-def-record NAME PARAMS FIELDS)` with FIELDS each being + `(NAME)` or `(:mutable NAME)`. Runtime is no-op (records already + work as dynamic dicts). Field-type sources are skipped; HM type + registration deferred. - 2026-05-08 Phase 5.1 — fizzbuzz.ml baseline (12/12 pass). Classic fizzbuzz using ref-cell accumulator, for-loop, mod, if/elseif chain, String.concat, Int.to_string. Verifies output via String.length.