diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index 7c373c2a..1066bc70 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -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) diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index 30fb1263..f905711d 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -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))))) diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index 041709c8..dff83522 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -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" diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index 13fcd8c6..f6255ee3 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -186,8 +186,11 @@ SX CEK evaluator (both JS and OCaml hosts) - [ ] `module M : S = struct ... end` — coercive sealing (runtime: pass-through). - [ ] `functor (M : S) -> struct ... end` → SX `(fn (M) ...)`. - [ ] `module F = Functor(Base)` — functor application. -- [ ] `open M` — merge M's dict into current env (`env-merge`). -- [ ] `include M` — same as open at structure level. +- [x] `open M` — merge M's dict into current env (via + `ocaml-env-merge-dict`). Module path `M.Sub` resolves via + `ocaml-resolve-module-path`. +- [x] `include M` — at top level same as `open`; inside a module also + copies M's bindings into the surrounding module's exports. - [x] `M.name` — dict get via field access. - [ ] First-class modules (pack/unpack) — deferred to Phase 5. - [ ] Standard module hierarchy: `List`, `Option`, `Result`, `String`, `Char`, @@ -322,6 +325,15 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means: _Newest first._ +- 2026-05-08 Phase 4 — `open M` / `include M` (+5 tests, 220 total). + Parser: top-level `open Path` / `include Path` decls; path is `Ctor (. + Ctor)*`. Eval resolves the path via `ocaml-resolve-module-path` (the + same `:con`-as-module-lookup escape hatch used for `:field`); merges + the dict bindings into the current env via `ocaml-env-merge-dict`. + `include` inside a module also adds the bindings to the module's + resulting dict, so `module Sphere = struct include Math let area r = + ... end` exposes both Math's `pi` and Sphere's `area`. Phase 4 LOC + cumulative: ~165. - 2026-05-08 Phase 4 — modules + field access (+11 tests, 215 total). Parser: `module M = struct DECLS end` decl in `ocaml-parse-program`. Body parsed by sub-tokenising the source between `struct` and the matching `end`,