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

Step 5.5 phases 5-6: primitive :body specs + runtime trimming

Browse Source 
Phase 5: Added :body implementations to 13 more primitives in
spec/primitives.sx (26/94 total, up from 13). New bodies for:
- Type predicates: nil?, boolean?, number?, string?, list?, dict?,
  continuation? — all via (= (type-of x) "typename")
- Comparisons: <=, >=, eq?, equal? — composed from <, >, =, identical?
- Logic: not — via (if x false true)
- Collections: empty? — via (or (nil? coll) (= (len coll) 0))

Remaining 68 are genuinely native (host string/list/dict/math ops).

Phase 6: Removed 43 unused wrapper functions from sx_runtime.ml
(489 → 414 lines, -78 lines). Dead code from pre-transpilation era:
predicate wrappers (nil_p, keyword_p, contains_p, etc.), signal
accessors (signal_set_value, notify_subscribers, etc.), scope
delegates (sx_collect, sx_emit, etc.), HO form stubs (map_indexed,
map_dict, for_each), handler def stubs (sf_defquery, sf_defaction,
sf_defpage).

2598/2598 tests passing.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-03 20:27:31 +00:00
parent cfc697821f
commit 9257b6a2d8
2 changed files with 217 additions and 218 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
hosts/ocaml/lib/sx_runtime.ml
View File

@@ -155,29 +155,17 @@ let sort' a = _prim "sort" [a]
let range' a = _prim "range" [a]
let unique a = _prim "unique" [a]
let zip a b = _prim "zip" [a; b]
let zip_pairs a = _prim "zip-pairs" [a]
let take a b = _prim "take" [a; b]
let drop a b = _prim "drop" [a; b]
let chunk_every a b = _prim "chunk-every" [a; b]
(* Predicates *)
let empty_p a = _prim "empty?" [a]
let nil_p a = _prim "nil?" [a]
let number_p a = _prim "number?" [a]
let string_p a = _prim "string?" [a]
let boolean_p a = _prim "boolean?" [a]
let list_p a = _prim "list?" [a]
let dict_p a = _prim "dict?" [a]
let symbol_p a = _prim "symbol?" [a]
let keyword_p a = _prim "keyword?" [a]
let contains_p a b = _prim "contains?" [a; b]
let has_key_p a b = _prim "has-key?" [a; b]
let starts_with_p a b = _prim "starts-with?" [a; b]
let ends_with_p a b = _prim "ends-with?" [a; b]
let string_contains_p a b = _prim "string-contains?" [a; b]
let odd_p a = _prim "odd?" [a]
let even_p a = _prim "even?" [a]
let zero_p a = _prim "zero?" [a]
(* String ops *)
let str' args = String (sx_str args)
@@ -189,10 +177,7 @@ let trim a = _prim "trim" [a]
let split a b = _prim "split" [a; b]
let join a b = _prim "join" [a; b]
let replace a b c = _prim "replace" [a; b; c]
let index_of a b = _prim "index-of" [a; b]
let substring a b c = _prim "substring" [a; b; c]
let string_length a = _prim "string-length" [a]
let char_from_code a = _prim "char-from-code" [a]
(* Dict ops *)
let assoc d k v = _prim "assoc" [d; k; v]
@@ -202,7 +187,6 @@ let keys a = _prim "keys" [a]
let vals a = _prim "vals" [a]
let dict_set a b c = _prim "dict-set!" [a; b; c]
let dict_get a b = _prim "dict-get" [a; b]
let dict_has_p a b = _prim "dict-has?" [a; b]
let dict_delete a b = _prim "dict-delete!" [a; b]
(* Math *)
@@ -215,8 +199,6 @@ let round' a = _prim "round" [a]
let min' a b = _prim "min" [a; b]
let max' a b = _prim "max" [a; b]
let clamp a b c = _prim "clamp" [a; b; c]
let parse_int a = _prim "parse-int" [a]
let parse_float a = _prim "parse-float" [a]
(* Misc *)
let error msg = raise (Eval_error (value_to_str msg))
@@ -224,17 +206,8 @@ let error msg = raise (Eval_error (value_to_str msg))
(* inspect wrapper — returns String value instead of OCaml string *)
let inspect v = String (Sx_types.inspect v)
let apply' f args = sx_apply f args
let identical_p a b = _prim "identical?" [a; b]
let _is_spread_prim a = _prim "spread?" [a]
let spread_attrs a = _prim "spread-attrs" [a]
let make_spread a = _prim "make-spread" [a]
(* Scope primitives — delegate to sx_ref.py's shared scope stacks *)
let sx_collect a b = prim_call "collect!" [a; b]
let sx_collected a = prim_call "collected" [a]
let sx_clear_collected a = prim_call "clear-collected!" [a]
let sx_emit a b = prim_call "emit!" [a; b]
let sx_emitted a = prim_call "emitted" [a]
let sx_context a b = prim_call "context" [a; b]
(* Trampoline — forward-declared in sx_ref.ml, delegates to CEK eval_expr *)
@@ -280,10 +253,8 @@ let is_island v = Bool (Sx_types.is_island v)
let is_macro v = Bool (Sx_types.is_macro v)
let is_signal v = Bool (Sx_types.is_signal v)
let is_callable v = Bool (Sx_types.is_callable v)
let is_identical a b = Bool (a == b)
let is_primitive name = Bool (Sx_primitives.is_primitive (value_to_str name))
let get_primitive name = Sx_primitives.get_primitive (value_to_str name)
let is_spread v = match v with Spread _ -> Bool true | _ -> Bool false
(* Stubs for functions defined in sx_ref.ml — resolved at link time *)
(* These are forward-declared here; sx_ref.ml defines the actual implementations *)
@@ -293,21 +264,6 @@ let is_spread v = match v with Spread _ -> Bool true | _ -> Bool false
sometimes referenced before their definition via forward calls.
These get overridden by the actual transpiled definitions. *)
let map_indexed fn coll =
List (List.mapi (fun i x -> sx_call fn [Number (float_of_int i); x]) (sx_to_list coll))
let map_dict fn d =
match d with
| Dict tbl ->
let result = Hashtbl.create (Hashtbl.length tbl) in
Hashtbl.iter (fun k v -> Hashtbl.replace result k (sx_call fn [String k; v])) tbl;
Dict result
| _ -> raise (Eval_error "map-dict: expected dict")
let for_each fn coll =
List.iter (fun x -> ignore (sx_call fn [x])) (sx_to_list coll);
Nil
let for_each_indexed fn coll =
List.iteri (fun i x -> ignore (sx_call fn [Number (float_of_int i); x])) (sx_to_list coll);
Nil
@@ -380,8 +336,6 @@ let signal_value s = match s with
| Signal sig' -> sig'.s_value
| Dict d -> (match Hashtbl.find_opt d "value" with Some v -> v | None -> Nil)
| _ -> raise (Eval_error "not a signal")
let signal_set_value s v = match s with Signal sig' -> sig'.s_value <- v; v | _ -> raise (Eval_error "not a signal")
let signal_subscribers s = match s with Signal sig' -> List (List.map (fun _ -> Nil) sig'.s_subscribers) | _ -> List []
let signal_add_sub_b s f =
match s with
| Dict d ->
@@ -400,29 +354,6 @@ let signal_remove_sub_b s f =
| _ -> Nil)
| _ -> Nil
let signal_deps s =
match s with
| Dict d -> (match Hashtbl.find_opt d "deps" with Some v -> v | None -> List [])
| _ -> List []
let signal_set_deps s d =
match s with
| Dict tbl -> Hashtbl.replace tbl "deps" d; Nil
| _ -> Nil
let notify_subscribers s =
let subs = match s with
| Dict d -> (match Hashtbl.find_opt d "subscribers" with
| Some (ListRef { contents = items }) | Some (List items) -> items
| _ -> [])
| _ -> []
in
List.iter (fun f -> ignore (sx_call f [])) subs;
Nil
let flush_subscribers _s = Nil
let dispose_computed _s = Nil
(* Island scope stubs — accept both bare OCaml fns and NativeFn values
from transpiled code (NativeFn wrapping for value-storable lambdas). *)
let with_island_scope _register_fn body_fn =
@@ -444,20 +375,14 @@ let parse_keyword_args _raw_args _env =
(* Stub — the real implementation is transpiled from evaluator.sx *)
List [Dict (Hashtbl.create 0); List []]
(* Make handler/query/action/page def stubs *)
(* Make handler def — used by custom_special_forms *)
let make_handler_def name params body _env = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "handler"); Hashtbl.replace d "name" name; Hashtbl.replace d "params" params; Hashtbl.replace d "body" body; d)
let make_query_def name params body _env = make_handler_def name params body _env
let make_action_def name params body _env = make_handler_def name params body _env
let make_page_def name _opts = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "page"); Hashtbl.replace d "name" name; d)
(* sf-def* stubs — platform-specific def-forms, not in the SX spec *)
(* sf_defhandler — used by custom_special_forms *)
let sf_defhandler args env =
let name = first args in let rest_args = rest args in
make_handler_def name (first rest_args) (nth rest_args (Number 1.0)) env
let sf_defquery args env = sf_defhandler args env
let sf_defaction args env = sf_defhandler args env
let sf_defpage args _env =
let name = first args in make_page_def name (rest args)
let strip_prefix s prefix =
match s, prefix with