From 0e311f0c7dcb2225632fb694135a1316cbe4ff4d Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 5 Apr 2026 11:58:18 +0000 Subject: [PATCH] Step 10c: fix capabilities, closure-scope, define-library imports MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - 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) --- hosts/ocaml/lib/sx_ref.ml | 4 +- spec/evaluator.sx | 4 ++ spec/tests/test-scope.sx | 114 ++++++++++++++++++-------------------- 3 files changed, 62 insertions(+), 60 deletions(-) diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index 4fc83b38..c92a82f4 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/hosts/ocaml/lib/sx_ref.ml @@ -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 diff --git a/spec/evaluator.sx b/spec/evaluator.sx index c4a7b35a..acf8adf4 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -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)))) diff --git a/spec/tests/test-scope.sx b/spec/tests/test-scope.sx index 42bbf387..a5406e2c 100644 --- a/spec/tests/test-scope.sx +++ b/spec/tests/test-scope.sx @@ -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))))))