coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ocaml: phase 1+3 record type declarations (+3 tests, 447 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
Details

Browse Source 
type r = { x : int; mutable y : string } parses to
(:type-def-record NAME PARAMS FIELDS) with FIELDS each (NAME) or
(:mutable NAME). Parser dispatches on { after = to parse field list.
Field-type sources are skipped (HM registration TBD). Runtime no-op
since records already work as dynamic dicts.
This commit is contained in:
giles
2026-05-08 18:26:34 +00:00
parent f070bddb0e
commit 66da0e5b84
4 changed files with 104 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
lib/ocaml/eval.sx
View File

@@ -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)

115
lib/ocaml/parser.sx
View File

@@ -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).

13
lib/ocaml/test.sh
View File

@@ -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"

7
plans/ocaml-on-sx.md
View File

@@ -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.