ocaml: sequence protocol — seq_to_list coercion in HO dispatch + sequence-* primitives
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -2112,4 +2112,89 @@ let () =
|
||||
| [HashTable dst; HashTable src] ->
|
||||
Hashtbl.iter (fun k v -> Hashtbl.replace dst k v) src;
|
||||
Nil
|
||||
| _ -> raise (Eval_error "hash-table-merge!: expected (dst src)"))
|
||||
| _ -> raise (Eval_error "hash-table-merge!: expected (dst src)"));
|
||||
(* Phase 11: sequence protocol *)
|
||||
let seq_to_list v =
|
||||
match v with
|
||||
| Nil -> List []
|
||||
| List _ -> v
|
||||
| Vector arr -> List (Array.to_list arr)
|
||||
| String s ->
|
||||
let chars = ref [] in
|
||||
String.iter (fun c -> chars := String (String.make 1 c) :: !chars) s;
|
||||
List (List.rev !chars)
|
||||
| _ -> v
|
||||
in
|
||||
register "seq-to-list" (fun args ->
|
||||
match args with
|
||||
| [v] -> seq_to_list v
|
||||
| _ -> raise (Eval_error "seq-to-list: expected 1 arg"));
|
||||
register "sequence-to-list" (fun args ->
|
||||
match args with
|
||||
| [v] -> seq_to_list v
|
||||
| _ -> raise (Eval_error "sequence-to-list: expected 1 arg"));
|
||||
register "sequence-to-vector" (fun args ->
|
||||
match args with
|
||||
| [v] -> (match seq_to_list v with List xs -> Vector (Array.of_list xs) | x -> x)
|
||||
| _ -> raise (Eval_error "sequence-to-vector: expected 1 arg"));
|
||||
register "sequence-length" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Integer (String.length s)
|
||||
| [Vector arr] -> Integer (Array.length arr)
|
||||
| [v] -> (match seq_to_list v with
|
||||
| List xs -> Integer (List.length xs)
|
||||
| _ -> raise (Eval_error "sequence-length: expected sequence"))
|
||||
| _ -> raise (Eval_error "sequence-length: expected 1 arg"));
|
||||
register "sequence-ref" (fun args ->
|
||||
match args with
|
||||
| [String s; Integer i] ->
|
||||
if i < 0 || i >= String.length s
|
||||
then raise (Eval_error (Printf.sprintf "sequence-ref: index %d out of bounds" i))
|
||||
else String (String.make 1 (String.get s i))
|
||||
| [String s; Number n] ->
|
||||
let i = int_of_float n in
|
||||
if i < 0 || i >= String.length s
|
||||
then raise (Eval_error (Printf.sprintf "sequence-ref: index %d out of bounds" i))
|
||||
else String (String.make 1 (String.get s i))
|
||||
| [v; idx] ->
|
||||
let lst = seq_to_list v in
|
||||
let i = (match idx with Integer n -> n | Number n -> int_of_float n | _ -> raise (Eval_error "sequence-ref: index must be number")) in
|
||||
(match lst with
|
||||
| List xs ->
|
||||
(try List.nth xs i
|
||||
with _ -> raise (Eval_error (Printf.sprintf "sequence-ref: index %d out of bounds" i)))
|
||||
| _ -> raise (Eval_error "sequence-ref: expected sequence"))
|
||||
| _ -> raise (Eval_error "sequence-ref: expected (seq index)"));
|
||||
register "sequence-append" (fun args ->
|
||||
match args with
|
||||
| [String s1; String s2] -> String (s1 ^ s2)
|
||||
| [v1; v2] ->
|
||||
let l1 = seq_to_list v1 in
|
||||
let l2 = seq_to_list v2 in
|
||||
(match l1, l2 with
|
||||
| List xs1, List xs2 -> List (xs1 @ xs2)
|
||||
| _ -> raise (Eval_error "sequence-append: expected sequences"))
|
||||
| _ -> raise (Eval_error "sequence-append: expected 2 args"));
|
||||
register "in-range" (fun args ->
|
||||
match args with
|
||||
| [Integer n] ->
|
||||
let rec build i acc = if i < 0 then acc else build (i-1) (Integer i :: acc) in
|
||||
List (build (n-1) [])
|
||||
| [Number n] ->
|
||||
let hi = int_of_float n in
|
||||
let rec build i acc = if i < 0 then acc else build (i-1) (Integer i :: acc) in
|
||||
List (build (hi-1) [])
|
||||
| [Integer lo; Integer hi] ->
|
||||
let rec build i acc = if i < lo then acc else build (i-1) (Integer i :: acc) in
|
||||
List (build (hi-1) [])
|
||||
| [Number lo; Number hi] ->
|
||||
let lo_i = int_of_float lo and hi_i = int_of_float hi in
|
||||
let rec build i acc = if i < lo_i then acc else build (i-1) (Integer i :: acc) in
|
||||
List (build (hi_i-1) [])
|
||||
| [Integer lo; Integer hi; Integer step] ->
|
||||
if step = 0 then raise (Eval_error "in-range: step cannot be zero");
|
||||
let rec build i acc =
|
||||
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)"))
|
||||
|
||||
Reference in New Issue
Block a user