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

ocaml: phase 4 def-mut / def-rec-mut inside modules (+2 tests, 475 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Details

Browse Source 
ocaml-eval-module now handles :def-mut and :def-rec-mut decls so
'module M = struct let rec a n = ... and b n = ... end' works. The
def-rec-mut version uses cell-based mutual recursion exactly as the
top-level version.
This commit is contained in:
giles
2026-05-08 21:14:07 +00:00
parent 6d9ac1e55a
commit 0530120bc7
3 changed files with 63 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
lib/ocaml/eval.sx
View File

@@ -782,6 +782,55 @@
(begin
(set! env (ocaml-env-extend env name v))
(set! result (merge result (dict name v))))))))))
((= tag "def-mut")
;; let x = ... and y = ... — sequential top-level binds.
(let ((bs (nth decl 1)))
(begin
(define run-one
(fn (b)
(let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
(let ((v (if (= (len ps) 0)
(ocaml-eval rh env)
(ocaml-make-curried ps rh env))))
(begin
(set! env (ocaml-env-extend env nm v))
(set! result (merge result (dict nm v))))))))
(define loop
(fn (xs)
(when (not (= xs (list)))
(begin (run-one (first xs)) (loop (rest xs))))))
(loop bs))))
((= tag "def-rec-mut")
;; let rec f = ... and g = ... — mutual recursion.
(let ((bs (nth decl 1)) (cells (list)))
(begin
(define alloc
(fn (xs)
(when (not (= xs (list)))
(let ((b (first xs)))
(let ((c (list nil)) (nm (nth b 0)))
(begin
(append! cells c)
(set! env (ocaml-env-extend env nm
(fn (a) ((nth c 0) a))))
(alloc (rest xs))))))))
(alloc bs)
(let ((idx 0))
(begin
(define fill
(fn (xs)
(when (not (= xs (list)))
(let ((b (first xs)))
(let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
(let ((v (if (= (len ps) 0)
(ocaml-eval rh env)
(ocaml-make-curried ps rh env))))
(begin
(set-nth! (nth cells idx) 0 v)
(set! result (merge result (dict nm v)))
(set! idx (+ idx 1))
(fill (rest xs)))))))))
(fill bs))))))
((= tag "expr")
(ocaml-eval (nth decl 1) env))
((= tag "module-def")

10
lib/ocaml/test.sh
View File

@@ -1172,6 +1172,12 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 4703)
(eval "(ocaml-run \"((1 + 2) : int) * 3\")")
;; ── Module body: def-mut / def-rec-mut ─────────────────────────
(epoch 4800)
(eval "(ocaml-run-program \"module M = struct let rec a n = if n = 0 then 0 else b (n - 1) and b n = if n = 0 then 1 else a (n - 1) end ;; M.a 5\")")
(epoch 4801)
(eval "(ocaml-run-program \"module M = struct let x = 1 and y = 2 end ;; M.x + M.y\")")
EPOCHS
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -1857,6 +1863,10 @@ check 4701 "let f (x : int) : int" '42'
check 4702 "(5 : int)" '5'
check 4703 "((1+2) : int) * 3" '9'
# ── Module body: def-mut / def-rec-mut ─────────────────────────
check 4800 "module rec a/b mutual" '1'
check 4801 "module x and y" '3'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"