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

OCaml bootstrapper Phase 2: HTML renderer, SX server, Python bridge

Browse Source 
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-15 23:28:48 +00:00
parent 16fa813d6d
commit 313f7d6be1
18 changed files with 2541 additions and 191 deletions
Download Patch File Download Diff File Expand all files Collapse all files

118
hosts/ocaml/lib/sx_primitives.ml
View File

@@ -20,6 +20,10 @@ let get_primitive name =
let as_number = function
| Number n -> n
| Bool true -> 1.0
| Bool false -> 0.0
| Nil -> 0.0
| String s -> (match float_of_string_opt s with Some n -> n | None -> Float.nan)
| v -> raise (Eval_error ("Expected number, got " ^ type_of v))
let as_string = function
@@ -28,6 +32,8 @@ let as_string = function
let as_list = function
| List l -> l
| ListRef r -> !r
| Nil -> []
| v -> raise (Eval_error ("Expected list, got " ^ type_of v))
let as_bool = function
@@ -116,18 +122,40 @@ let () =
| _ -> Nil);
(* === Comparison === *)
(* Normalize ListRef to List for structural equality *)
let rec normalize_for_eq = function
| ListRef { contents = items } -> List (List.map normalize_for_eq items)
| List items -> List (List.map normalize_for_eq items)
| v -> v
in
register "=" (fun args ->
match args with [a; b] -> Bool (a = b) | _ -> raise (Eval_error "=: 2 args"));
match args with
| [a; b] -> Bool (normalize_for_eq a = normalize_for_eq b)
| _ -> raise (Eval_error "=: 2 args"));
register "!=" (fun args ->
match args with [a; b] -> Bool (a <> b) | _ -> raise (Eval_error "!=: 2 args"));
match args with
| [a; b] -> Bool (normalize_for_eq a <> normalize_for_eq b)
| _ -> raise (Eval_error "!=: 2 args"));
register "<" (fun args ->
match args with [a; b] -> Bool (as_number a < as_number b) | _ -> raise (Eval_error "<: 2 args"));
match args with
| [String a; String b] -> Bool (a < b)
| [a; b] -> Bool (as_number a < as_number b)
| _ -> raise (Eval_error "<: 2 args"));
register ">" (fun args ->
match args with [a; b] -> Bool (as_number a > as_number b) | _ -> raise (Eval_error ">: 2 args"));
match args with
| [String a; String b] -> Bool (a > b)
| [a; b] -> Bool (as_number a > as_number b)
| _ -> raise (Eval_error ">: 2 args"));
register "<=" (fun args ->
match args with [a; b] -> Bool (as_number a <= as_number b) | _ -> raise (Eval_error "<=: 2 args"));
match args with
| [String a; String b] -> Bool (a <= b)
| [a; b] -> Bool (as_number a <= as_number b)
| _ -> raise (Eval_error "<=: 2 args"));
register ">=" (fun args ->
match args with [a; b] -> Bool (as_number a >= as_number b) | _ -> raise (Eval_error ">=: 2 args"));
match args with
| [String a; String b] -> Bool (a >= b)
| [a; b] -> Bool (as_number a >= as_number b)
| _ -> raise (Eval_error ">=: 2 args"));
(* === Logic === *)
register "not" (fun args ->
@@ -143,7 +171,7 @@ let () =
register "boolean?" (fun args ->
match args with [Bool _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "boolean?: 1 arg"));
register "list?" (fun args ->
match args with [List _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "list?: 1 arg"));
match args with [List _] | [ListRef _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "list?: 1 arg"));
register "dict?" (fun args ->
match args with [Dict _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "dict?: 1 arg"));
register "symbol?" (fun args ->
@@ -152,7 +180,8 @@ let () =
match args with [Keyword _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "keyword?: 1 arg"));
register "empty?" (fun args ->
match args with
| [List []] -> Bool true | [List _] -> Bool false
| [List []] | [ListRef { contents = [] }] -> Bool true
| [List _] | [ListRef _] -> Bool false
| [String ""] -> Bool true | [String _] -> Bool false
| [Dict d] -> Bool (Hashtbl.length d = 0)
| [Nil] -> Bool true
@@ -240,7 +269,8 @@ let () =
| _ -> raise (Eval_error "split: 2 args"));
register "join" (fun args ->
match args with
| [String sep; List items] -> String (String.concat sep (List.map to_string items))
| [String sep; (List items | ListRef { contents = items })] ->
String (String.concat sep (List.map to_string items))
| _ -> raise (Eval_error "join: 2 args"));
register "replace" (fun args ->
match args with
@@ -271,48 +301,58 @@ let () =
| _ -> raise (Eval_error "char-from-code: 1 arg"));
(* === Collections === *)
register "list" (fun args -> List args);
register "list" (fun args -> ListRef (ref args));
register "len" (fun args ->
match args with
| [List l] -> Number (float_of_int (List.length l))
| [List l] | [ListRef { contents = l }] -> Number (float_of_int (List.length l))
| [String s] -> Number (float_of_int (String.length s))
| [Dict d] -> Number (float_of_int (Hashtbl.length d))
| [Nil] -> Number 0.0
| _ -> raise (Eval_error "len: 1 arg"));
register "first" (fun args ->
match args with
| [List (x :: _)] -> x | [List []] -> Nil
| [List (x :: _)] | [ListRef { contents = x :: _ }] -> x
| [List []] | [ListRef { contents = [] }] -> Nil | [Nil] -> Nil
| _ -> raise (Eval_error "first: 1 list arg"));
register "rest" (fun args ->
match args with
| [List (_ :: xs)] -> List xs | [List []] -> List []
| [List (_ :: xs)] | [ListRef { contents = _ :: xs }] -> List xs
| [List []] | [ListRef { contents = [] }] -> List [] | [Nil] -> List []
| _ -> raise (Eval_error "rest: 1 list arg"));
register "last" (fun args ->
match args with
| [List l] -> (match List.rev l with x :: _ -> x | [] -> Nil)
| [List l] | [ListRef { contents = l }] ->
(match List.rev l with x :: _ -> x | [] -> Nil)
| _ -> raise (Eval_error "last: 1 list arg"));
register "nth" (fun args ->
match args with
| [List l; Number n] -> (try List.nth l (int_of_float n) with _ -> Nil)
| [List l; Number n] | [ListRef { contents = l }; Number n] ->
(try List.nth l (int_of_float n) with _ -> Nil)
| _ -> raise (Eval_error "nth: list and number"));
register "cons" (fun args ->
match args with
| [x; List l] -> List (x :: l)
| [x; List l] | [x; ListRef { contents = l }] -> List (x :: l)
| [x; Nil] -> List [x]
| _ -> raise (Eval_error "cons: value and list"));
register "append" (fun args ->
let all = List.concat_map (fun a -> as_list a) args in
List all);
register "reverse" (fun args ->
match args with [List l] -> List (List.rev l) | _ -> raise (Eval_error "reverse: 1 list"));
match args with
| [List l] | [ListRef { contents = l }] -> List (List.rev l)
| _ -> raise (Eval_error "reverse: 1 list"));
register "flatten" (fun args ->
let rec flat = function
| List items -> List.concat_map flat items
| List items | ListRef { contents = items } -> List.concat_map flat items
| x -> [x]
in
match args with [List l] -> List (List.concat_map flat l) | _ -> raise (Eval_error "flatten: 1 list"));
match args with
| [List l] | [ListRef { contents = l }] -> List (List.concat_map flat l)
| _ -> raise (Eval_error "flatten: 1 list"));
register "concat" (fun args -> List (List.concat_map as_list args));
register "contains?" (fun args ->
match args with
| [List l; item] -> Bool (List.mem item l)
| [List l; item] | [ListRef { contents = l }; item] -> Bool (List.mem item l)
| [String s; String sub] ->
let rec find i =
if i + String.length sub > String.length s then false
@@ -329,14 +369,25 @@ let () =
let s = int_of_float start and e = int_of_float stop in
let len = max 0 (e - s) in
List (List.init len (fun i -> Number (float_of_int (s + i))))
| _ -> raise (Eval_error "range: 1-2 args"));
| [Number start; Number stop; Number step] ->
let s = start and e = stop and st = step in
if st = 0.0 then List []
else
let items = ref [] in
let i = ref s in
if st > 0.0 then
(while !i < e do items := Number !i :: !items; i := !i +. st done)
else
(while !i > e do items := Number !i :: !items; i := !i +. st done);
List (List.rev !items)
| _ -> raise (Eval_error "range: 1-3 args"));
register "slice" (fun args ->
match args with
| [List l; Number start] ->
| [(List l | ListRef { contents = l }); Number start] ->
let i = max 0 (int_of_float start) in
let rec drop n = function _ :: xs when n > 0 -> drop (n-1) xs | l -> l in
List (drop i l)
| [List l; Number start; Number end_] ->
| [(List l | ListRef { contents = l }); Number start; Number end_] ->
let i = max 0 (int_of_float start) and j = int_of_float end_ in
let len = List.length l in
let j = min j len in
@@ -358,19 +409,21 @@ let () =
| _ -> raise (Eval_error "slice: 2-3 args"));
register "sort" (fun args ->
match args with
| [List l] -> List (List.sort compare l)
| [List l] | [ListRef { contents = l }] -> List (List.sort compare l)
| _ -> raise (Eval_error "sort: 1 list"));
register "zip" (fun args ->
match args with
| [List a; List b] ->
| [a; b] ->
let la = as_list a and lb = as_list b in
let rec go l1 l2 acc = match l1, l2 with
| x :: xs, y :: ys -> go xs ys (List [x; y] :: acc)
| _ -> List.rev acc
in List (go a b [])
in List (go la lb [])
| _ -> raise (Eval_error "zip: 2 lists"));
register "zip-pairs" (fun args ->
match args with
| [List l] ->
| [v] ->
let l = as_list v in
let rec go = function
| a :: b :: rest -> List [a; b] :: go rest
| _ -> []
@@ -378,7 +431,7 @@ let () =
| _ -> raise (Eval_error "zip-pairs: 1 list"));
register "take" (fun args ->
match args with
| [List l; Number n] ->
| [(List l | ListRef { contents = l }); Number n] ->
let rec take_n i = function
| x :: xs when i > 0 -> x :: take_n (i-1) xs
| _ -> []
@@ -386,7 +439,7 @@ let () =
| _ -> raise (Eval_error "take: list and number"));
register "drop" (fun args ->
match args with
| [List l; Number n] ->
| [(List l | ListRef { contents = l }); Number n] ->
let rec drop_n i = function
| _ :: xs when i > 0 -> drop_n (i-1) xs
| l -> l
@@ -394,7 +447,7 @@ let () =
| _ -> raise (Eval_error "drop: list and number"));
register "chunk-every" (fun args ->
match args with
| [List l; Number n] ->
| [(List l | ListRef { contents = l }); Number n] ->
let size = int_of_float n in
let rec go = function
| [] -> []
@@ -412,7 +465,7 @@ let () =
| _ -> raise (Eval_error "chunk-every: list and number"));
register "unique" (fun args ->
match args with
| [List l] ->
| [(List l | ListRef { contents = l })] ->
let seen = Hashtbl.create 16 in
let result = List.filter (fun x ->
let key = inspect x in
@@ -435,7 +488,8 @@ let () =
match args with
| [Dict d; String k] -> dict_get d k
| [Dict d; Keyword k] -> dict_get d k
| [List l; Number n] -> (try List.nth l (int_of_float n) with _ -> Nil)
| [List l; Number n] | [ListRef { contents = l }; Number n] ->
(try List.nth l (int_of_float n) with _ -> Nil)
| _ -> raise (Eval_error "get: dict+key or list+index"));
register "has-key?" (fun args ->
match args with