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

ocaml: phase 4 open / include (+5 tests, 220 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Details

Browse Source 
Parser: open Path and include Path top-level decls; Path is Ctor (.Ctor)*.
Eval resolves via ocaml-resolve-module-path (same :con-as-module-lookup
escape hatch used by :field). open extends the env with the module's
bindings; include also merges into the surrounding module's exports
(when inside a struct...end).

Path resolver lets M.Sub.x work for nested modules. Phase 4 LOC ~165.
This commit is contained in:
giles
2026-05-08 08:39:13 +00:00
parent 317f93b2af
commit d45e653a87
4 changed files with 125 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
lib/ocaml/eval.sx
View File

@@ -67,6 +67,42 @@
(fn (env name val)
(cons (list name val) env)))
;; Resolve a module path like `M` or `M.Sub` to a dict. Mirrors the
;; field-access escape hatch where `(:con NAME)` is treated as an env
;; lookup rather than a nullary ctor.
(define ocaml-resolve-module-path
(fn (path-expr env)
(let ((tag (ocaml-tag-of path-expr)))
(cond
((= tag "con")
(cond
((ocaml-env-has? env (nth path-expr 1))
(ocaml-env-lookup env (nth path-expr 1)))
(else (error (str "ocaml-eval: unknown module " (nth path-expr 1))))))
((= tag "field")
(let ((parent (ocaml-resolve-module-path (nth path-expr 1) env)))
(cond
((dict? parent) (get parent (nth path-expr 2)))
(else (error
(str "ocaml-eval: not a module on path: " parent))))))
(else (ocaml-eval path-expr env))))))
;; Merge a dict's bindings into an env (used by `open`/`include`).
;; Iterates keys; each (k, get d k) becomes a fresh env binding.
(define ocaml-env-merge-dict
(fn (env d)
(let ((result env) (ks (keys d)))
(begin
(define loop
(fn (xs)
(when (not (= xs (list)))
(let ((k (first xs)))
(begin
(set! result (cons (list k (get d k)) result))
(loop (rest xs)))))))
(loop ks)
result))))
(define ocaml-tag-of (fn (ast) (nth ast 0)))
(define ocaml-eval (fn (ast env) nil))
@@ -484,6 +520,24 @@
(begin
(set! env (ocaml-env-extend env mname mod-val))
(set! result (merge result (dict mname mod-val)))))))
((= tag "open")
(let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
(cond
((dict? mod-val)
(set! env (ocaml-env-merge-dict env mod-val)))
(else (error
(str "ocaml-eval: open on non-module: " mod-val))))))
((= tag "include")
;; `include M` brings M's bindings into scope AND into
;; the surrounding module's exports.
(let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
(cond
((dict? mod-val)
(begin
(set! env (ocaml-env-merge-dict env mod-val))
(set! result (merge result mod-val))))
(else (error
(str "ocaml-eval: include on non-module: " mod-val))))))
(else (error (str "ocaml-eval-module: bad decl " tag)))))))
(define loop
(fn (xs)
@@ -551,6 +605,15 @@
(begin
(set! env (ocaml-env-extend env mname mod-val))
(set! last mod-val)))))
((or (= tag "open") (= tag "include"))
;; open M / include M — bring M's bindings into scope.
(let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
(cond
((dict? mod-val)
(begin
(set! env (ocaml-env-merge-dict env mod-val))
(set! last mod-val)))
(else (error (str "ocaml-eval: open/include on non-module: " mod-val))))))
(else (error (str "ocaml-run-program: bad decl " tag)))))))
(define loop
(fn (xs)