From a6e0e84521f205dd4d7cef5e4c03265059ab490b Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 24 Mar 2026 18:31:37 +0000 Subject: [PATCH] Split setup_type_operations into 6 focused functions 125-line monolith split into: - setup_core_operations (assert, append!, apply, equal?, primitive?) - setup_type_constructors (make-keyword, make-symbol, escape-string, etc.) - setup_character_classification (ident-start?, ident-char?, char-numeric?) - setup_env_operations (env-get, env-has?, env-bind!, env-set!, etc.) - setup_strict_mode (gradual type system support) - setup_io_bridges (json-encode, into, sleep, response headers) make_server_env now calls 12 focused setup functions total. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/bin/sx_server.ml | 90 ++++++++++++++++++++++-------------- 1 file changed, 56 insertions(+), 34 deletions(-) diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index cc5b1b3..47d62e2 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -460,7 +460,8 @@ let setup_introspection env = | _ -> Nil) (* ---- Type operations, string/number/env helpers ---- *) -let setup_type_operations env = +(* ---- Core runtime operations (assert, append!, apply, etc.) ---- *) +let setup_core_operations env = let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in bind "assert" (fun args -> match args with @@ -486,18 +487,6 @@ let setup_type_operations env = ignore (Sx_ref.eval_expr (List [fn_val; Number (float_of_int i); item]) (Env env)) ) items; Nil | _ -> Nil); - bind "upcase" (fun args -> match args with [String s] -> String (String.uppercase_ascii s) | _ -> raise (Eval_error "upcase: expected string")); - bind "downcase" (fun args -> match args with [String s] -> String (String.lowercase_ascii s) | _ -> raise (Eval_error "downcase: expected string")); - bind "make-keyword" (fun args -> match args with [String s] -> Keyword s | _ -> raise (Eval_error "make-keyword: expected string")); - bind "keyword-name" (fun args -> match args with [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name: expected keyword")); - bind "symbol-name" (fun args -> match args with [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name: expected symbol")); - bind "make-symbol" (fun args -> match args with [String s] -> Symbol s | [v] -> Symbol (value_to_string v) | _ -> raise (Eval_error "make-symbol: expected 1 arg")); - bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string")); - bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string")); - bind "make-continuation" (fun args -> - match args with [f] -> Continuation ((fun v -> Sx_runtime.sx_call f [v]), None) | _ -> raise (Eval_error "make-continuation: expected 1 arg")); - bind "sx-serialize" (fun args -> match args with [v] -> String (inspect v) | _ -> raise (Eval_error "sx-serialize: expected 1 arg")); - bind "is-html-tag?" (fun args -> match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false); bind "equal?" (fun args -> match args with [a; b] -> Bool (a = b) | _ -> raise (Eval_error "equal?: expected 2 args")); bind "identical?" (fun args -> match args with [a; b] -> Bool (a == b) | _ -> raise (Eval_error "identical?: expected 2 args")); bind "apply" (fun args -> @@ -517,6 +506,34 @@ let setup_type_operations env = match args with | [String name] -> (try Sx_primitives.get_primitive name with _ -> try env_get env name with _ -> Nil) | _ -> Nil); + bind "make-continuation" (fun args -> + match args with [f] -> Continuation ((fun v -> Sx_runtime.sx_call f [v]), None) | _ -> raise (Eval_error "make-continuation: expected 1 arg")) + +(* ---- Type constructors and symbol operations ---- *) +let setup_type_constructors env = + let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in + bind "upcase" (fun args -> match args with [String s] -> String (String.uppercase_ascii s) | _ -> raise (Eval_error "upcase: expected string")); + bind "downcase" (fun args -> match args with [String s] -> String (String.lowercase_ascii s) | _ -> raise (Eval_error "downcase: expected string")); + bind "make-keyword" (fun args -> match args with [String s] -> Keyword s | _ -> raise (Eval_error "make-keyword: expected string")); + bind "keyword-name" (fun args -> match args with [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name: expected keyword")); + bind "symbol-name" (fun args -> match args with [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name: expected symbol")); + bind "make-symbol" (fun args -> match args with [String s] -> Symbol s | [v] -> Symbol (value_to_string v) | _ -> raise (Eval_error "make-symbol: expected 1 arg")); + bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string")); + bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string")); + bind "sx-serialize" (fun args -> match args with [v] -> String (inspect v) | _ -> raise (Eval_error "sx-serialize: expected 1 arg")); + bind "is-html-tag?" (fun args -> match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false); + bind "string-length" (fun args -> match args with [String s] -> Number (float_of_int (String.length s)) | _ -> raise (Eval_error "string-length: expected string")); + bind "dict-get" (fun args -> match args with [Dict d; String k] -> dict_get d k | [Dict d; Keyword k] -> dict_get d k | _ -> raise (Eval_error "dict-get: expected dict and key")); + bind "escape-string" (fun args -> + match args with + | [String s] -> + let buf = Buffer.create (String.length s) in + String.iter (fun c -> match c with + | '"' -> Buffer.add_string buf "\\\"" | '\\' -> Buffer.add_string buf "\\\\" + | '\n' -> Buffer.add_string buf "\\n" | '\r' -> Buffer.add_string buf "\\r" + | '\t' -> Buffer.add_string buf "\\t" | c -> Buffer.add_char buf c) s; + String (Buffer.contents buf) + | _ -> raise (Eval_error "escape-string: expected string")); bind "random-int" (fun args -> match args with | [Number lo; Number hi] -> @@ -529,20 +546,11 @@ let setup_type_operations env = | [String s; default_val] -> (try Number (float_of_int (int_of_string s)) with _ -> default_val) | [Number n] | [Number n; _] -> Number (Float.round n) | [_; default_val] -> default_val | _ -> Nil); - bind "parse-number" (fun args -> match args with [String s] -> (try Number (float_of_string s) with _ -> Nil) | _ -> Nil); - bind "escape-string" (fun args -> - match args with - | [String s] -> - let buf = Buffer.create (String.length s) in - String.iter (fun c -> match c with - | '"' -> Buffer.add_string buf "\\\"" | '\\' -> Buffer.add_string buf "\\\\" - | '\n' -> Buffer.add_string buf "\\n" | '\r' -> Buffer.add_string buf "\\r" - | '\t' -> Buffer.add_string buf "\\t" | c -> Buffer.add_char buf c) s; - String (Buffer.contents buf) - | _ -> raise (Eval_error "escape-string: expected string")); - bind "string-length" (fun args -> match args with [String s] -> Number (float_of_int (String.length s)) | _ -> raise (Eval_error "string-length: expected string")); - bind "dict-get" (fun args -> match args with [Dict d; String k] -> dict_get d k | [Dict d; Keyword k] -> dict_get d k | _ -> raise (Eval_error "dict-get: expected dict and key")); - (* Character classification — platform primitives for spec/parser.sx *) + bind "parse-number" (fun args -> match args with [String s] -> (try Number (float_of_string s) with _ -> Nil) | _ -> Nil) + +(* ---- Character classification (platform primitives for spec/parser.sx) ---- *) +let setup_character_classification env = + let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in bind "ident-start?" (fun args -> match args with | [String s] when String.length s = 1 -> @@ -563,23 +571,32 @@ let setup_type_operations env = || c >= '0' && c <= '9' || c = '.' || c = ':') | _ -> Bool false); bind "char-numeric?" (fun args -> - match args with [String s] when String.length s = 1 -> Bool (s.[0] >= '0' && s.[0] <= '9') | _ -> Bool false); - (* Env operations *) + match args with [String s] when String.length s = 1 -> Bool (s.[0] >= '0' && s.[0] <= '9') | _ -> Bool false) + +(* ---- Env operations (env-get, env-has?, env-bind!, etc.) ---- *) +let setup_env_operations env = + let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in let uw = Sx_runtime.unwrap_env in bind "env-get" (fun args -> match args with [e; String k] -> Sx_types.env_get (uw e) k | [e; Keyword k] -> Sx_types.env_get (uw e) k | _ -> raise (Eval_error "env-get: expected env and string")); bind "env-has?" (fun args -> match args with [e; String k] -> Bool (Sx_types.env_has (uw e) k) | [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k) | _ -> raise (Eval_error "env-has?: expected env and string")); bind "env-bind!" (fun args -> match args with [e; String k; v] -> Sx_types.env_bind (uw e) k v | [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v | _ -> raise (Eval_error "env-bind!: expected env, key, value")); bind "env-set!" (fun args -> match args with [e; String k; v] -> Sx_types.env_set (uw e) k v | [e; Keyword k; v] -> Sx_types.env_set (uw e) k v | _ -> raise (Eval_error "env-set!: expected env, key, value")); bind "env-extend" (fun args -> match args with [e] -> Env (Sx_types.env_extend (uw e)) | _ -> raise (Eval_error "env-extend: expected env")); - bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge: expected 2 envs")); - (* Strict mode *) + bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge: expected 2 envs")) + +(* ---- Strict mode (gradual type system support) ---- *) +let setup_strict_mode env = + let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in ignore (env_bind env "*strict*" (Bool false)); ignore (env_bind env "*prim-param-types*" Nil); bind "set-strict!" (fun args -> match args with [v] -> Sx_ref._strict_ref := v; ignore (env_set env "*strict*" v); Nil | _ -> raise (Eval_error "set-strict!: expected 1 arg")); bind "set-prim-param-types!" (fun args -> match args with [v] -> Sx_ref._prim_param_types_ref := v; ignore (env_set env "*prim-param-types*" v); Nil | _ -> raise (Eval_error "set-prim-param-types!: expected 1 arg")); bind "component-param-types" (fun _args -> Nil); - bind "component-set-param-types!" (fun _args -> Nil); - (* IO helpers routed to Python bridge *) + bind "component-set-param-types!" (fun _args -> Nil) + +(* ---- IO helpers routed to Python bridge ---- *) +let setup_io_bridges env = + let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in bind "json-encode" (fun args -> io_request "helper" (String "json-encode" :: args)); bind "into" (fun args -> io_request "helper" (String "into" :: args)); bind "sleep" (fun args -> io_request "sleep" args); @@ -605,7 +622,12 @@ let make_server_env () = setup_scope_env env; setup_evaluator_bridge env; setup_introspection env; - setup_type_operations env; + setup_core_operations env; + setup_type_constructors env; + setup_character_classification env; + setup_env_operations env; + setup_strict_mode env; + setup_io_bridges env; setup_html_tags env; setup_io_env env; (* Initialize trampoline ref so HO primitives (map, filter, etc.)