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

Step 10c: fix capabilities, closure-scope, define-library imports

Browse Source 
- Initialize _cek_call_ref in sx_ref.ml — fixes 8 capabilities tests
- Rename test variable 'peek' to 'get-val' — collides with new peek
  special form. Fixes closure-scope-edge test.
- Add import clause handling to define-library — was silently skipping
  (import ...) inside library definitions. Fixes 4 define-library tests.

2767/2768 OCaml (1 pre-existing aser/render-to-sx issue).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-05 11:58:18 +00:00
parent fb262aa49b
commit 0e311f0c7d
3 changed files with 62 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
hosts/ocaml/lib/sx_ref.ml
View File

@@ -611,7 +611,7 @@ and sf_syntax_rules args env =
(* step-sf-define-library *)
and step_sf_define_library args env kont =
(let lib_spec = (first (args)) in let decls = (rest (args)) in (let lib_env = (env_extend (env)) in let exports = ref ((List [])) in let body_forms = ref ((List [])) in (let () = ignore ((List.iter (fun decl -> ignore ((if sx_truthy ((let _and = (list_p (decl)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (decl)))))) in if not (sx_truthy _and) then _and else (symbol_p ((first (decl))))))) then (let kind = (symbol_name ((first (decl)))) in (if sx_truthy ((prim_call "=" [kind; (String "export")])) then (exports := (prim_call "append" [!exports; (List (List.map (fun s -> (if sx_truthy ((symbol_p (s))) then (symbol_name (s)) else (String (sx_str [s])))) (sx_to_list (rest (decl)))))]); Nil) else (if sx_truthy ((prim_call "=" [kind; (String "begin")])) then (body_forms := (prim_call "append" [!body_forms; (rest (decl))]); Nil) else Nil))) else Nil))) (sx_to_list decls); Nil)) in (let () = ignore ((List.iter (fun form -> ignore ((eval_expr (form) (lib_env)))) (sx_to_list !body_forms); Nil)) in (let export_dict = (Dict (Hashtbl.create 0)) in (let () = ignore ((List.iter (fun name -> ignore ((if sx_truthy ((env_has (lib_env) (name))) then (sx_dict_set_b export_dict name (env_get (lib_env) (name))) else Nil))) (sx_to_list !exports); Nil)) in (let () = ignore ((register_library (lib_spec) (export_dict))) in (make_cek_value (Nil) (env) (kont)))))))))
(let lib_spec = (first (args)) in let decls = (rest (args)) in (let lib_env = (env_extend (env)) in let exports = ref ((List [])) in let body_forms = ref ((List [])) in (let () = ignore ((List.iter (fun decl -> ignore ((if sx_truthy ((let _and = (list_p (decl)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (decl)))))) in if not (sx_truthy _and) then _and else (symbol_p ((first (decl))))))) then (let kind = (symbol_name ((first (decl)))) in (if sx_truthy ((prim_call "=" [kind; (String "export")])) then (exports := (prim_call "append" [!exports; (List (List.map (fun s -> (if sx_truthy ((symbol_p (s))) then (symbol_name (s)) else (String (sx_str [s])))) (sx_to_list (rest (decl)))))]); Nil) else (if sx_truthy ((prim_call "=" [kind; (String "import")])) then (List.iter (fun import_set -> ignore (bind_import_set import_set lib_env)) (sx_to_list (rest decl)); Nil) else (if sx_truthy ((prim_call "=" [kind; (String "begin")])) then (body_forms := (prim_call "append" [!body_forms; (rest (decl))]); Nil) else Nil)))) else Nil))) (sx_to_list decls); Nil)) in (let () = ignore ((List.iter (fun form -> ignore ((eval_expr (form) (lib_env)))) (sx_to_list !body_forms); Nil)) in (let export_dict = (Dict (Hashtbl.create 0)) in (let () = ignore ((List.iter (fun name -> ignore ((if sx_truthy ((env_has (lib_env) (name))) then (sx_dict_set_b export_dict name (env_get (lib_env) (name))) else Nil))) (sx_to_list !exports); Nil)) in (let () = ignore ((register_library (lib_spec) (export_dict))) in (make_cek_value (Nil) (env) (kont)))))))))
(* bind-import-set *)
and bind_import_set import_set env =
@@ -916,3 +916,5 @@ let enhance_error_with_trace msg =
let () = Sx_types._cek_call_ref := cek_call

4
spec/evaluator.sx
View File

@@ -1986,6 +1986,10 @@
(map
(fn (s) (if (symbol? s) (symbol-name s) (str s)))
(rest decl))))
(= kind "import")
(for-each
(fn (import-set) (bind-import-set import-set lib-env))
(rest decl))
(= kind "begin")
(set! body-forms (append body-forms (rest decl)))
:else nil))))

114
spec/tests/test-scope.sx
View File

@@ -223,84 +223,80 @@
;; closure scope edge cases
;; --------------------------------------------------------------------------
(defsuite "closure-scope-edge"
(deftest "for-each captures independent value per iteration"
;; Each fn closure captures the loop variable value at call time.
;; Build thunks from map so each one sees its own x.
(let ((thunks (map (fn (x) (fn () x)) (list 10 20 30))))
(defsuite
"closure-scope-edge"
(deftest
"for-each captures independent value per iteration"
(let
((thunks (map (fn (x) (fn () x)) (list 10 20 30))))
(assert-equal 10 ((nth thunks 0)))
(assert-equal 20 ((nth thunks 1)))
(assert-equal 30 ((nth thunks 2)))))
(deftest "multiple closures from same let are independent"
;; Two closures from one let have separate parameter environments
;; but share the same closed-over bindings.
(define make-pair
(fn (init)
(let ((state init))
(list
(fn (v) (set! state v)) ;; setter
(fn () state))))) ;; getter
(let ((pair-a (make-pair 0))
(pair-b (make-pair 100)))
(let ((set-a (nth pair-a 0)) (get-a (nth pair-a 1))
(set-b (nth pair-b 0)) (get-b (nth pair-b 1)))
(deftest
"multiple closures from same let are independent"
(define
make-pair
(fn
(init)
(let
((state init))
(list (fn (v) (set! state v)) (fn () state)))))
(let
((pair-a (make-pair 0)) (pair-b (make-pair 100)))
(let
((set-a (nth pair-a 0))
(get-a (nth pair-a 1))
(set-b (nth pair-b 0))
(get-b (nth pair-b 1)))
(set-a 7)
(set-b 42)
;; Each pair is independent — no crosstalk
(assert-equal 7 (get-a))
(assert-equal 7 (get-a))
(assert-equal 42 (get-b))
(set-a 99)
(assert-equal 99 (get-a))
(assert-equal 42 (get-b)))))
(deftest "closure over closure — function returning a function"
(define make-adder-factory
(fn (base)
(fn (offset)
(fn (x) (+ base offset x)))))
(let ((factory (make-adder-factory 100)))
(let ((add-10 (factory 10))
(add-20 (factory 20)))
(deftest
"closure over closure — function returning a function"
(define
make-adder-factory
(fn (base) (fn (offset) (fn (x) (+ base offset x)))))
(let
((factory (make-adder-factory 100)))
(let
((add-10 (factory 10)) (add-20 (factory 20)))
(assert-equal 115 (add-10 5))
(assert-equal 125 (add-20 5))
;; base=100 is shared by both; offset differs
(assert-equal 130 (add-10 20))
(assert-equal 140 (add-20 20)))))
(deftest "closure survives after creating scope is gone"
(define make-frozen-adder
(fn (n)
(fn (x) (+ n x))))
(let ((add5 (make-frozen-adder 5))
(add99 (make-frozen-adder 99)))
;; make-frozen-adder's local env is gone; closures still work
(assert-equal 10 (add5 5))
(deftest
"closure survives after creating scope is gone"
(define make-frozen-adder (fn (n) (fn (x) (+ n x))))
(let
((add5 (make-frozen-adder 5)) (add99 (make-frozen-adder 99)))
(assert-equal 10 (add5 5))
(assert-equal 105 (add5 100))
(assert-equal 100 (add99 1))
(assert-equal 199 (add99 100))))
(deftest "closure sees set! mutations from sibling closure"
;; Two closures close over the same let-bound variable.
;; When one mutates it, the other sees the new value.
(let ((shared 0))
(let ((inc! (fn () (set! shared (+ shared 1))))
(peek (fn () shared)))
(assert-equal 0 (peek))
(deftest
"closure sees set! mutations from sibling closure"
(let
((shared 0))
(let
((inc! (fn () (set! shared (+ shared 1))))
(get-val (fn () shared)))
(assert-equal 0 (get-val))
(inc!)
(assert-equal 1 (peek))
(assert-equal 1 (get-val))
(inc!)
(inc!)
(assert-equal 3 (peek)))))
(deftest "closure captures value not reference for immutable bindings"
;; Create closure when x=1, then shadow x=99 in an inner let.
;; The closure should see the x it closed over (1), not the shadowed one.
(let ((x 1))
(let ((f (fn () x)))
(let ((x 99))
(assert-equal 1 (f)))
;; Even after inner let ends, f still returns 1
(assert-equal 3 (get-val)))))
(deftest
"closure captures value not reference for immutable bindings"
(let
((x 1))
(let
((f (fn () x)))
(let ((x 99)) (assert-equal 1 (f)))
(assert-equal 1 (f))))))