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

ocaml: phase 4 modules + field access (+11 tests, 215 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Details

Browse Source 
module M = struct DECLS end parsed by sub-tokenising the body source
between struct and the matching end (nesting tracked via struct/begin/
sig/end). Field access is a postfix layer above parse-atom, binding
tighter than application: f r.x -> (:app f (:field r "x")).

Eval (:module-def NAME DECLS) builds a dict via ocaml-eval-module
running decls in a sub-env. (:field EXPR NAME) looks up dict fields,
treating (:con NAME) heads as module-name lookups instead of nullary
ctors so M.x works with M as a module.

Phase 4 LOC so far: ~110 lines (well under 2000 budget).
This commit is contained in:
giles
2026-05-08 08:33:34 +00:00
parent 6a1f63f0d1
commit 317f93b2af
4 changed files with 199 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
lib/ocaml/parser.sx
View File

@@ -377,12 +377,32 @@
true)
((and (= tt "op") (or (= tv "(") (= tv "["))) true)
(else false)))))
(define parse-atom-postfix
(fn ()
;; After a primary atom, consume `.field` chains. Field name
;; may be lower (record field, module value) or upper (module
;; or constructor reference). Note: `M.x.y` is left-assoc:
;; `(:field (:field M "x") "y")`.
(let ((head (parse-atom)))
(begin
(define loop
(fn ()
(when (at-op? ".")
(begin
(advance-tok!)
(let ((tok (peek-tok)))
(begin
(advance-tok!)
(set! head (list :field head (ocaml-tok-value tok)))
(loop)))))))
(loop)
head))))
(set!
parse-app
(fn
()
(let
((head (parse-atom)))
((head (parse-atom-postfix)))
(begin
(define
loop
@@ -391,7 +411,7 @@
(when
(at-app-start?)
(let
((arg (parse-atom)))
((arg (parse-atom-postfix)))
(begin (set! head (list :app head arg)) (loop))))))
(loop)
head))))
@@ -767,6 +787,7 @@
((= (ocaml-tok-type (peek-tok)) "eof") nil)
((at-op? ";;") nil)
((at-kw? "let") nil)
((at-kw? "module") nil)
(else (begin (advance-tok!) (skip-to-boundary!))))))
(define
parse-decl-let
@@ -818,6 +839,43 @@
(let
((expr-src (slice src expr-start (cur-pos))))
(let ((expr (ocaml-parse expr-src))) (list :expr expr)))))))
;; module M = struct DECLS end
;; Parsed by sub-tokenising the body source between `struct` and
;; the matching `end`. Nested modules / sigs increment depth.
(define
parse-decl-module
(fn ()
(advance-tok!)
(let ((name (ocaml-tok-value (consume! "ctor" nil))))
(begin
(consume! "op" "=")
(consume! "keyword" "struct")
(let ((body-start (cur-pos)) (depth 1))
(begin
(define skip
(fn ()
(cond
((>= idx tok-len) nil)
((= (ocaml-tok-type (peek-tok)) "eof") nil)
((at-kw? "struct")
(begin (set! depth (+ depth 1)) (advance-tok!) (skip)))
((at-kw? "begin")
(begin (set! depth (+ depth 1)) (advance-tok!) (skip)))
((at-kw? "sig")
(begin (set! depth (+ depth 1)) (advance-tok!) (skip)))
((at-kw? "end")
(cond
((= depth 1) nil)
(else
(begin (set! depth (- depth 1)) (advance-tok!) (skip)))))
(else (begin (advance-tok!) (skip))))))
(skip)
(let ((body-end (cur-pos)))
(begin
(consume! "keyword" "end")
(let ((body-src (slice src body-start body-end)))
(let ((body-prog (ocaml-parse-program body-src)))
(list :module-def name (rest body-prog))))))))))))
(define
loop
(fn
@@ -830,6 +888,8 @@
((= (ocaml-tok-type (peek-tok)) "eof") nil)
((at-kw? "let")
(begin (append! decls (parse-decl-let)) (loop)))
((at-kw? "module")
(begin (append! decls (parse-decl-module)) (loop)))
(else (begin (append! decls (parse-decl-expr)) (loop))))))))
(loop)
(cons :program decls)))))