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

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