diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 15a64de7..6ebc6ed4 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -99,6 +99,8 @@ let rec to_string = function | RawHTML s -> s | v -> inspect v +let gensym_counter = ref 0 + let () = (* === Arithmetic === *) register "+" (fun args -> @@ -2118,6 +2120,7 @@ let () = match v with | Nil -> List [] | List _ -> v + | ListRef { contents = items } -> List items | Vector arr -> List (Array.to_list arr) | String s -> let chars = ref [] in @@ -2197,4 +2200,29 @@ let () = if (step > 0 && i >= hi) || (step < 0 && i <= hi) then acc else build (i + step) (Integer i :: acc) in List (List.rev (build lo [])) - | _ -> raise (Eval_error "in-range: expected (end) or (start end) or (start end step)")) + | _ -> raise (Eval_error "in-range: expected (end) or (start end) or (start end step)")); + (* === gensym + symbol interning === *) + register "gensym" (fun args -> + let prefix = match args with + | [] -> "g" + | [String s] -> s + | [Symbol s] -> s + | _ -> raise (Eval_error "gensym: expected optional prefix string") in + incr gensym_counter; + Symbol (prefix ^ string_of_int !gensym_counter)); + register "string->symbol" (fun args -> + match args with + | [String s] -> Symbol s + | _ -> raise (Eval_error "string->symbol: expected 1 string")); + register "symbol->string" (fun args -> + match args with + | [Symbol s] -> String s + | _ -> raise (Eval_error "symbol->string: expected 1 symbol")); + register "intern" (fun args -> + match args with + | [String s] -> Symbol s + | _ -> raise (Eval_error "intern: expected 1 string")); + register "symbol-interned?" (fun args -> + match args with + | [Symbol _] -> Bool true + | _ -> raise (Eval_error "symbol-interned?: expected 1 symbol")) diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index 6327d635..545ddea7 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/hosts/ocaml/lib/sx_ref.ml @@ -29,6 +29,7 @@ let seq_to_list v = match v with | Nil -> List [] | List _ -> v + | ListRef { contents = items } -> List items | Vector arr -> List (Array.to_list arr) | String s -> let chars = ref [] in diff --git a/plans/agent-briefings/primitives-loop.md b/plans/agent-briefings/primitives-loop.md index 5ffe2568..226f5895 100644 --- a/plans/agent-briefings/primitives-loop.md +++ b/plans/agent-briefings/primitives-loop.md @@ -362,11 +362,18 @@ Primitives to add: the explicit interning operation for languages that distinguish interned vs uninterned) Steps: -- [ ] Spec: add `gensym` counter to evaluator state; implement in `spec/evaluator.sx`. +- [x] Spec: add `gensym` counter to evaluator state; implement in `spec/evaluator.sx`. `string->symbol` already exists — `gensym` is just a counter-suffixed variant. -- [ ] OCaml: add global gensym counter; implement primitives. -- [ ] JS bootstrapper: implement. -- [ ] Tests: 15+ tests in `spec/tests/test-gensym.sx` — uniqueness, prefix, symbol?, string->symbol round-trip. + Added *gensym-counter*/gensym/string->symbol/symbol->string/intern/symbol-interned? to + evaluator.sx. Added string->symbol/symbol->string transpiler renames + platform.py aliases. + JS 2186/+1. OCaml builds. Committed edf4e525. +- [x] OCaml: add global gensym counter; implement primitives. + gensym_counter ref + gensym/string->symbol/symbol->string/intern/symbol-interned? in sx_primitives.ml. + Also fixed ListRef case in seq_to_list (both sx_ref.ml + sx_primitives.ml). 4431/1080 (was 4385/1080). +- [x] JS bootstrapper: implement. + Already done in Spec step. JS 2186/2497, all sequence tests pass. +- [x] Tests: 15+ tests in `spec/tests/test-gensym.sx` — uniqueness, prefix, symbol?, string->symbol round-trip. + 19 tests. OCaml 4450/1080, JS 2205/2497, zero regressions. - [ ] Commit: `spec: gensym + symbol interning` --- diff --git a/spec/tests/test-gensym.sx b/spec/tests/test-gensym.sx new file mode 100644 index 00000000..4b85995f --- /dev/null +++ b/spec/tests/test-gensym.sx @@ -0,0 +1,78 @@ +(defsuite + "gensym" + (deftest "gensym returns a symbol" (assert= true (symbol? (gensym)))) + (deftest + "gensym default prefix is g" + (let + ((s (symbol-name (gensym)))) + (assert= true (string-contains? s "g")))) + (deftest + "gensym with prefix uses that prefix" + (let + ((s (symbol-name (gensym "var")))) + (assert= "var" (substring s 0 3)))) + (deftest + "gensym produces unique symbols" + (let + ((a (gensym)) (b (gensym))) + (assert= false (= (symbol-name a) (symbol-name b))))) + (deftest + "gensym same prefix produces unique symbols" + (let + ((a (gensym "x")) (b (gensym "x")) (c (gensym "x"))) + (assert= false (= (symbol-name a) (symbol-name b))) + (assert= false (= (symbol-name b) (symbol-name c))))) + (deftest + "gensym counter increases: names differ" + (let + ((a (gensym "k")) (b (gensym "k"))) + (assert= false (= (symbol-name a) (symbol-name b))))) + (deftest + "gensym no-arg and prefix-arg both unique" + (let + ((a (gensym)) (b (gensym "g"))) + (assert= false (= (symbol-name a) (symbol-name b))))) + (deftest + "string->symbol returns a symbol" + (assert= true (symbol? (string->symbol "hello")))) + (deftest + "string->symbol symbol has correct name" + (assert= "hello" (symbol-name (string->symbol "hello")))) + (deftest + "string->symbol empty string" + (assert= true (symbol? (string->symbol "")))) + (deftest + "symbol->string returns a string" + (assert= true (string? (symbol->string (quote foo))))) + (deftest + "symbol->string round-trips with string->symbol" + (assert= "hello" (symbol->string (string->symbol "hello")))) + (deftest + "string->symbol/symbol->string round-trip" + (let + ((sym (string->symbol "my-var"))) + (assert= "my-var" (symbol->string sym)))) + (deftest + "intern returns a symbol" + (assert= true (symbol? (intern "foo")))) + (deftest + "intern same as string->symbol" + (assert= "bar" (symbol-name (intern "bar")))) + (deftest + "symbol-interned? true for literal symbols" + (assert= true (symbol-interned? (quote hello)))) + (deftest + "symbol-interned? true for gensym'd symbol" + (assert= true (symbol-interned? (gensym "g")))) + (deftest + "symbol-interned? true for string->symbol" + (assert= true (symbol-interned? (string->symbol "test")))) + (deftest + "multiple gensym calls all unique" + (let + ((syms (map (fn (i) (gensym "t")) (in-range 5)))) + (let + ((names (map symbol-name syms))) + (let + ((unique-names (reduce (fn (acc n) (if (some (fn (x) (= x n)) acc) acc (cons n acc))) (list) names))) + (assert-equal 5 (len unique-names)))))))