diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index d28e950b..7c373c2a 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -314,6 +314,23 @@ ;; matches its argument against the clauses. (let ((clauses (nth ast 1)) (captured env)) (fn (arg) (ocaml-match-clauses arg clauses captured)))) + ((= tag "field") + ;; `e.name` — evaluate e, expect a dict (record/module), get name. + ;; Special case: `(:field (:con "M") "x")` looks up M as a module + ;; binding rather than evaluating it as a nullary ctor. + (let ((target-ast (nth ast 1)) (fname (nth ast 2))) + (let ((target + (cond + ((= (ocaml-tag-of target-ast) "con") + (cond + ((ocaml-env-has? env (nth target-ast 1)) + (ocaml-env-lookup env (nth target-ast 1))) + (else (list (nth target-ast 1))))) + (else (ocaml-eval target-ast env))))) + (cond + ((dict? target) (get target fname)) + (else (error + (str "ocaml-eval: not a record/module on .field: " target))))))) ((= tag "for") ;; (:for NAME LO HI DIR BODY) — DIR is "ascend" or "descend". (let ((name (nth ast 1)) @@ -417,6 +434,64 @@ (else (error (str "ocaml-eval: unknown AST tag " tag))))))) +;; ocaml-eval-module — evaluate a list of decls in a fresh sub-env layered +;; on top of the parent. Returns a dict mapping each declared name to its +;; value. Used by `module M = struct DECLS end`. +(define ocaml-eval-module + (fn (decls parent-env) + (let ((env parent-env) (result {})) + (begin + (define run-decl + (fn (decl) + (let ((tag (ocaml-tag-of decl))) + (cond + ((= tag "def") + (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3))) + (let ((v (if (= (len params) 0) + (ocaml-eval rhs env) + (ocaml-make-curried params rhs env)))) + (begin + (set! env (ocaml-env-extend env name v)) + (set! result (merge result (dict name v))))))) + ((= tag "def-rec") + (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3))) + (let ((rhs-fn? + (or (> (len params) 0) + (= (ocaml-tag-of rhs) "fun") + (= (ocaml-tag-of rhs) "function")))) + (cond + (rhs-fn? + (let ((cell (list nil))) + (let ((env2 (ocaml-env-extend env name + (fn (arg) ((nth cell 0) arg))))) + (let ((v (if (= (len params) 0) + (ocaml-eval rhs env2) + (ocaml-make-curried params rhs env2)))) + (begin + (set-nth! cell 0 v) + (set! env env2) + (set! result (merge result (dict name v)))))))) + (else + (let ((v (ocaml-eval rhs env))) + (begin + (set! env (ocaml-env-extend env name v)) + (set! result (merge result (dict name v)))))))))) + ((= tag "expr") + (ocaml-eval (nth decl 1) env)) + ((= tag "module-def") + (let ((mname (nth decl 1)) (mdecls (nth decl 2))) + (let ((mod-val (ocaml-eval-module mdecls env))) + (begin + (set! env (ocaml-env-extend env mname mod-val)) + (set! result (merge result (dict mname mod-val))))))) + (else (error (str "ocaml-eval-module: bad decl " tag))))))) + (define loop + (fn (xs) + (when (not (= xs (list))) + (begin (run-decl (first xs)) (loop (rest xs)))))) + (loop decls) + result)))) + ;; ocaml-run — convenience wrapper: parse + eval. (define ocaml-run (fn (src) @@ -466,6 +541,16 @@ (set! last v)))))))) ((= tag "expr") (set! last (ocaml-eval (nth decl 1) env))) + ((= tag "module-def") + ;; module M = struct DECLS end — evaluate the inner + ;; decls in a fresh sub-env layered on the current + ;; one, then collect the new bindings into a dict that + ;; we bind under M. + (let ((mname (nth decl 1)) (mdecls (nth decl 2))) + (let ((mod-val (ocaml-eval-module mdecls env))) + (begin + (set! env (ocaml-env-extend env mname mod-val)) + (set! last 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 d55d101e..30fb1263 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -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))))) diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index df1039aa..041709c8 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -531,6 +531,30 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 665) (eval "(ocaml-run \"let f x = if x < 0 then raise (NegArg x) else x * 2 in try f (-5) with | NegArg n -> n\")") +;; ── Phase 4: Modules + field access ──────────────────────────── +(epoch 700) +(eval "(ocaml-parse \"M.x\")") +(epoch 701) +(eval "(ocaml-parse \"r.field\")") +(epoch 702) +(eval "(ocaml-parse \"M.M2.x\")") +(epoch 703) +(eval "(ocaml-parse \"f r.x\")") +(epoch 710) +(eval "(ocaml-run-program \"module M = struct let x = 42 end ;; M.x\")") +(epoch 711) +(eval "(ocaml-run-program \"module M = struct let f x = x + 1 end ;; M.f 41\")") +(epoch 712) +(eval "(ocaml-run-program \"module M = struct let x = 1 let y = 2 end ;; M.x + M.y\")") +(epoch 713) +(eval "(ocaml-run-program \"module Math = struct let pi = 3.14 let square x = x * x end ;; Math.square 5\")") +(epoch 714) +(eval "(ocaml-run-program \"module Outer = struct module Inner = struct let v = 99 end end ;; Outer.Inner.v\")") +(epoch 715) +(eval "(ocaml-run-program \"module M = struct let rec fact n = if n = 0 then 1 else n * fact (n - 1) end ;; M.fact 5\")") +(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)\")") + EPOCHS OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -846,6 +870,19 @@ check 663 "try failwith" '"oops"' check 664 "try sequence raises" '101' check 665 "raise from function" '-5' +# ── Phase 4: Modules + field access ───────────────────────────── +check 700 "parse M.x" '("field" ("con" "M") "x")' +check 701 "parse r.field" '("field" ("var" "r") "field")' +check 702 "parse M.M2.x left-assoc" '("field" ("field" ("con" "M") "M2") "x")' +check 703 "parse f r.x bind tighter" '("app" ("var" "f") ("field" ("var" "r") "x"))' +check 710 "module M.x = 42" '42' +check 711 "module M.f 41 = 42" '42' +check 712 "module two values" '3' +check 713 "module fn: square 5" '25' +check 714 "nested module Outer.Inner" '99' +check 715 "module rec fact 5" '120' +check 716 "module Pair.swap" '("tuple" 2 1)' + 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 e9609dd7..13fcd8c6 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -179,7 +179,8 @@ SX CEK evaluator (both JS and OCaml hosts) ### Phase 4 — Modules + functors -- [ ] `module M = struct let x = 1 let f y = x + y end` → SX dict `{:x 1 :f }`. +- [x] `module M = struct let x = 1 let f y = x + y end` → SX dict + `{"x" 1 "f" }`. - [ ] `module type S = sig val x : int val f : int -> int end` → interface record (runtime stub; typed checking in Phase 5). - [ ] `module M : S = struct ... end` — coercive sealing (runtime: pass-through). @@ -187,7 +188,7 @@ SX CEK evaluator (both JS and OCaml hosts) - [ ] `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. -- [ ] `M.name` — dict get via `:name` key. +- [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`, `Int`, `Float`, `Bool`, `Unit`, `Printf`, `Format` (stubs, filled in Phase 6). @@ -321,6 +322,18 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means: _Newest first._ +- 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`, + tracking nesting via `struct`/`begin`/`sig`/`end`. Field access added + as 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 new `ocaml-eval-module` that runs decls in a sub-env; + `(:field EXPR NAME)` looks up the field, with the special case that + `(:con NAME)` heads are interpreted as module-name lookups instead of + nullary ctors. Tested: simple module, multi-decl module, nested modules + (`Outer.Inner.v`), `let rec` inside a module, module containing tuple + pattern match. Phase 4 LOC: ~110 (well under 2000 budget). - 2026-05-08 Phase 2 — `try`/`with` + `raise` builtin. Parser produces `(:try EXPR CLAUSES)`; eval delegates to SX `guard` with `else` matching the raised value against clause patterns and re-raising on