ocaml: phase 4 'let open M in body' local opens (+3 tests, 478 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
Parser detects 'let open' as a separate let-form, parses M as a path (Ctor(.Ctor)*) directly via inline AST construction (no source slicing since cur-pos is only available in ocaml-parse-program), and emits (:let-open PATH BODY). Eval resolves the path to a module dict and merges its bindings into the env for body evaluation. Now: let open List in map (fun x -> x * 2) [1;2;3] = [2;4;6] let open Option in map (fun x -> x + 1) (Some 5) = Some 6
This commit is contained in:
@@ -697,6 +697,14 @@
|
|||||||
(fill (rest xs)))))))))
|
(fill (rest xs)))))))))
|
||||||
(fill bindings)
|
(fill bindings)
|
||||||
(ocaml-eval body env2))))))
|
(ocaml-eval body env2))))))
|
||||||
|
((= tag "let-open")
|
||||||
|
;; `let open M in body` — extend env with M's bindings, eval body.
|
||||||
|
(let ((path-expr (nth ast 1)) (body (nth ast 2)))
|
||||||
|
(let ((mod-val (ocaml-resolve-module-path path-expr env)))
|
||||||
|
(cond
|
||||||
|
((dict? mod-val)
|
||||||
|
(ocaml-eval body (ocaml-env-merge-dict env mod-val)))
|
||||||
|
(else (error (str "ocaml-eval: let open on non-module: " mod-val)))))))
|
||||||
((= tag "let-rec")
|
((= tag "let-rec")
|
||||||
;; Tie the knot via a mutable cell when rhs is function-typed.
|
;; Tie the knot via a mutable cell when rhs is function-typed.
|
||||||
;; The placeholder closure dereferences the cell on each call.
|
;; The placeholder closure dereferences the cell on each call.
|
||||||
|
|||||||
@@ -682,6 +682,37 @@
|
|||||||
(define
|
(define
|
||||||
parse-let
|
parse-let
|
||||||
(fn ()
|
(fn ()
|
||||||
|
;; `let open M in body` — local open. Detect early so the
|
||||||
|
;; rest of the let-handler doesn't try to parse `open` as
|
||||||
|
;; an ident name.
|
||||||
|
(cond
|
||||||
|
((at-kw? "open")
|
||||||
|
(begin
|
||||||
|
(advance-tok!)
|
||||||
|
;; Read path as Ctor(.Ctor)* and build :field-chain AST.
|
||||||
|
(let ((path nil))
|
||||||
|
(begin
|
||||||
|
(when (= (ocaml-tok-type (peek-tok)) "ctor")
|
||||||
|
(begin
|
||||||
|
(set! path (list :con (ocaml-tok-value (peek-tok))))
|
||||||
|
(advance-tok!)))
|
||||||
|
(define more
|
||||||
|
(fn ()
|
||||||
|
(when (and (at-op? ".")
|
||||||
|
(= (ocaml-tok-type
|
||||||
|
(nth tokens (+ idx 1))) "ctor"))
|
||||||
|
(begin
|
||||||
|
(advance-tok!) ;; .
|
||||||
|
(let ((nm (ocaml-tok-value (peek-tok))))
|
||||||
|
(begin
|
||||||
|
(advance-tok!)
|
||||||
|
(set! path (list :field path nm))))
|
||||||
|
(more)))))
|
||||||
|
(more)
|
||||||
|
(consume! "keyword" "in")
|
||||||
|
(let ((body (parse-expr)))
|
||||||
|
(list :let-open path body))))))
|
||||||
|
(else
|
||||||
(let ((reccy false) (bindings (list)))
|
(let ((reccy false) (bindings (list)))
|
||||||
(begin
|
(begin
|
||||||
(when (at-kw? "rec")
|
(when (at-kw? "rec")
|
||||||
@@ -729,7 +760,7 @@
|
|||||||
(else
|
(else
|
||||||
(if reccy
|
(if reccy
|
||||||
(list :let-rec-mut bindings body)
|
(list :let-rec-mut bindings body)
|
||||||
(list :let-mut bindings body)))))))))
|
(list :let-mut bindings body)))))))))))
|
||||||
(define
|
(define
|
||||||
parse-if
|
parse-if
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -1178,6 +1178,14 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(epoch 4801)
|
(epoch 4801)
|
||||||
(eval "(ocaml-run-program \"module M = struct let x = 1 and y = 2 end ;; M.x + M.y\")")
|
(eval "(ocaml-run-program \"module M = struct let x = 1 and y = 2 end ;; M.x + M.y\")")
|
||||||
|
|
||||||
|
;; ── let open M in body ────────────────────────────────────────
|
||||||
|
(epoch 4900)
|
||||||
|
(eval "(ocaml-run \"let open List in length [1;2;3]\")")
|
||||||
|
(epoch 4901)
|
||||||
|
(eval "(ocaml-run \"let open List in map (fun x -> x * 2) [1;2;3]\")")
|
||||||
|
(epoch 4902)
|
||||||
|
(eval "(ocaml-run \"let open Option in map (fun x -> x + 1) (Some 5)\")")
|
||||||
|
|
||||||
EPOCHS
|
EPOCHS
|
||||||
|
|
||||||
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||||
@@ -1867,6 +1875,11 @@ check 4703 "((1+2) : int) * 3" '9'
|
|||||||
check 4800 "module rec a/b mutual" '1'
|
check 4800 "module rec a/b mutual" '1'
|
||||||
check 4801 "module x and y" '3'
|
check 4801 "module x and y" '3'
|
||||||
|
|
||||||
|
# ── let open M in body ─────────────────────────────────────────
|
||||||
|
check 4900 "let open List; length" '3'
|
||||||
|
check 4901 "let open List; map" '(2 4 6)'
|
||||||
|
check 4902 "let open Option; map" '("Some" 6)'
|
||||||
|
|
||||||
TOTAL=$((PASS + FAIL))
|
TOTAL=$((PASS + FAIL))
|
||||||
if [ $FAIL -eq 0 ]; then
|
if [ $FAIL -eq 0 ]; then
|
||||||
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
||||||
|
|||||||
@@ -407,6 +407,12 @@ _Newest first._
|
|||||||
binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree *
|
binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree *
|
||||||
'a tree`) with insert + in-order traversal. Tests parametric ADT,
|
'a tree`) with insert + in-order traversal. Tests parametric ADT,
|
||||||
recursive match, List.append, List.fold_left.
|
recursive match, List.append, List.fold_left.
|
||||||
|
- 2026-05-08 Phase 4 — `let open M in body` local opens (+3 tests, 478
|
||||||
|
total). Parser detects `let open` as a separate let-form, parses M
|
||||||
|
as a path (Ctor(.Ctor)*), and emits `(:let-open PATH BODY)`. Eval
|
||||||
|
resolves the path to a module dict and merges its bindings into the
|
||||||
|
env for body evaluation. `let open List in map (fun x -> x * 2)
|
||||||
|
[1;2;3]` → `[2;4;6]`.
|
||||||
- 2026-05-08 Phase 4 — `:def-mut` / `:def-rec-mut` inside module
|
- 2026-05-08 Phase 4 — `:def-mut` / `:def-rec-mut` inside module
|
||||||
bodies (+2 tests, 475 total). `ocaml-eval-module` now handles
|
bodies (+2 tests, 475 total). `ocaml-eval-module` now handles
|
||||||
multi-binding `let .. and ..` decls. `module M = struct let rec a n =
|
multi-binding `let .. and ..` decls. `module M = struct let rec a n =
|
||||||
|
|||||||
Reference in New Issue
Block a user