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")