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

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:
2026-05-08 08:39:13 +00:00
parent 317f93b2af
commit d45e653a87
4 changed files with 125 additions and 2 deletions

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)

View File

@@ -788,6 +788,8 @@
((at-op? ";;") nil)
((at-kw? "let") nil)
((at-kw? "module") nil)
((at-kw? "open") nil)
((at-kw? "include") nil)
(else (begin (advance-tok!) (skip-to-boundary!))))))
(define
parse-decl-let
@@ -842,6 +844,29 @@
;; module M = struct DECLS end
;; Parsed by sub-tokenising the body source between `struct` and
;; the matching `end`. Nested modules / sigs increment depth.
;; open M / include M — collect a path Ctor(.SubCtor)* and emit
;; (:open PATH) or (:include PATH).
(define
parse-decl-open
(fn (include?)
(advance-tok!)
(let ((path-start (cur-pos)))
(begin
;; Walk until end of the path. A path is Ctor (. Ctor)*.
(define skip-path
(fn ()
(cond
((>= idx tok-len) nil)
((= (ocaml-tok-type (peek-tok)) "ctor")
(begin (advance-tok!) (skip-path)))
((at-op? ".") (begin (advance-tok!) (skip-path)))
(else nil))))
(skip-path)
(let ((path-src (slice src path-start (cur-pos))))
(let ((path-expr (ocaml-parse path-src)))
(if include?
(list :include path-expr)
(list :open path-expr))))))))
(define
parse-decl-module
(fn ()
@@ -890,6 +915,10 @@
(begin (append! decls (parse-decl-let)) (loop)))
((at-kw? "module")
(begin (append! decls (parse-decl-module)) (loop)))
((at-kw? "open")
(begin (append! decls (parse-decl-open false)) (loop)))
((at-kw? "include")
(begin (append! decls (parse-decl-open true)) (loop)))
(else (begin (append! decls (parse-decl-expr)) (loop))))))))
(loop)
(cons :program decls)))))

View File

@@ -555,6 +555,18 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 716)
(eval "(ocaml-run-program \"module Pair = struct let make a b = (a, b) let swap p = match p with | (x, y) -> (y, x) end ;; Pair.swap (Pair.make 1 2)\")")
;; ── open / include ─────────────────────────────────────────────
(epoch 730)
(eval "(ocaml-run-program \"module M = struct let x = 42 let f y = y + 1 end ;; open M ;; f x\")")
(epoch 731)
(eval "(ocaml-run-program \"module Math = struct let pi = 3 let sq x = x * x end ;; module Sphere = struct include Math let area r = 4 * pi * sq r end ;; Sphere.area 2\")")
(epoch 732)
(eval "(ocaml-run-program \"module M = struct let x = 1 end ;; module N = struct open M let y = x + 10 end ;; N.y\")")
(epoch 733)
(eval "(ocaml-run-program \"module Math = struct let pi = 3 let sq x = x * x end ;; module Sphere = struct include Math let area r = 4 * pi * sq r end ;; Sphere.pi\")")
(epoch 734)
(eval "(ocaml-run-program \"module M = struct let x = 1 let y = 2 end ;; module N = struct include M let z = x + y end ;; N.z\")")
EPOCHS
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -883,6 +895,13 @@ check 714 "nested module Outer.Inner" '99'
check 715 "module rec fact 5" '120'
check 716 "module Pair.swap" '("tuple" 2 1)'
# ── open / include ──────────────────────────────────────────────
check 730 "open M; f x" '43'
check 731 "include Math; area" '48'
check 732 "module open inside" '11'
check 733 "Sphere.pi via include" '3'
check 734 "include M; N.z = x+y" '3'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"