Compare commits
2 Commits
da4b526abb
...
c3d2b9d87d
| Author | SHA1 | Date | |
|---|---|---|---|
| c3d2b9d87d | |||
| 7286629cf7 |
@@ -2112,4 +2112,89 @@ let () =
|
|||||||
| [HashTable dst; HashTable src] ->
|
| [HashTable dst; HashTable src] ->
|
||||||
Hashtbl.iter (fun k v -> Hashtbl.replace dst k v) src;
|
Hashtbl.iter (fun k v -> Hashtbl.replace dst k v) src;
|
||||||
Nil
|
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)"))
|
||||||
|
|||||||
@@ -24,6 +24,18 @@ let _protocol_registry_ = Dict (Hashtbl.create 0)
|
|||||||
|
|
||||||
(* === Transpiled from evaluator (frames + eval + CEK) === *)
|
(* === Transpiled from evaluator (frames + eval + CEK) === *)
|
||||||
|
|
||||||
|
(* seq-to-list: coerce list/vector/string/nil to list for HO dispatch *)
|
||||||
|
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
|
||||||
|
|
||||||
(* make-cek-state *)
|
(* make-cek-state *)
|
||||||
let rec make_cek_state control env kont =
|
let rec make_cek_state control env kont =
|
||||||
(CekState { cs_control = control; cs_env = env; cs_kont = kont; cs_phase = "eval"; cs_value = Nil })
|
(CekState { cs_control = control; cs_env = env; cs_kont = kont; cs_phase = "eval"; cs_value = Nil })
|
||||||
@@ -890,7 +902,7 @@ and ho_swap_args ho_type evaled =
|
|||||||
|
|
||||||
(* ho-setup-dispatch *)
|
(* ho-setup-dispatch *)
|
||||||
and ho_setup_dispatch ho_type evaled env kont =
|
and ho_setup_dispatch ho_type evaled env kont =
|
||||||
(let ordered = (ho_swap_args (ho_type) (evaled)) in (let f = (first (ordered)) in (let _match_val = ho_type in (if sx_truthy ((prim_call "=" [_match_val; (String "map")])) then (if sx_truthy ((prim_call ">" [(len (ordered)); (Number 2.0)])) then (let colls = (rest (ordered)) in (if sx_truthy ((Bool (List.exists (fun c -> sx_truthy ((empty_p (c)))) (sx_to_list colls)))) then (make_cek_value ((List [])) (env) (kont)) else (let heads = (List (List.map (fun c -> (first (c))) (sx_to_list colls))) in let tails = (List (List.map (fun c -> (rest (c))) (sx_to_list colls))) in (continue_with_call (f) (heads) (env) ((List [])) ((kont_push ((make_multi_map_frame (f) (tails) ((List [])) (env))) (kont))))))) else (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_map_frame (f) ((rest (coll))) ((List [])) (env))) (kont))))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "map-indexed")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(Number 0.0); (first (coll))])) (env) ((List [])) ((kont_push ((make_map_indexed_frame (f) ((rest (coll))) ((List [])) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "filter")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_filter_frame (f) ((rest (coll))) ((List [])) ((first (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "reduce")])) then (let init = (nth (ordered) ((Number 1.0))) in let coll = (nth (ordered) ((Number 2.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value (init) (env) (kont)) else (continue_with_call (f) ((List [init; (first (coll))])) (env) ((List [])) ((kont_push ((make_reduce_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "some")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((Bool false)) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_some_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "every")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((Bool true)) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_every_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "for-each")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value (Nil) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_for_each_frame (f) ((rest (coll))) (env))) (kont)))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Unknown HO type: "); ho_type])))))))))))))))
|
(let ordered = (ho_swap_args (ho_type) (evaled)) in (let f = (first (ordered)) in (let _match_val = ho_type in (if sx_truthy ((prim_call "=" [_match_val; (String "map")])) then (if sx_truthy ((prim_call ">" [(len (ordered)); (Number 2.0)])) then (let colls = (rest (ordered)) in (if sx_truthy ((Bool (List.exists (fun c -> sx_truthy ((empty_p (c)))) (sx_to_list colls)))) then (make_cek_value ((List [])) (env) (kont)) else (let heads = (List (List.map (fun c -> (first (c))) (sx_to_list colls))) in let tails = (List (List.map (fun c -> (rest (c))) (sx_to_list colls))) in (continue_with_call (f) (heads) (env) ((List [])) ((kont_push ((make_multi_map_frame (f) (tails) ((List [])) (env))) (kont))))))) else (let coll = seq_to_list (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_map_frame (f) ((rest (coll))) ((List [])) (env))) (kont))))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "map-indexed")])) then (let coll = seq_to_list (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(Number 0.0); (first (coll))])) (env) ((List [])) ((kont_push ((make_map_indexed_frame (f) ((rest (coll))) ((List [])) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "filter")])) then (let coll = seq_to_list (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_filter_frame (f) ((rest (coll))) ((List [])) ((first (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "reduce")])) then (let init = (nth (ordered) ((Number 1.0))) in let coll = seq_to_list (nth (ordered) ((Number 2.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value (init) (env) (kont)) else (continue_with_call (f) ((List [init; (first (coll))])) (env) ((List [])) ((kont_push ((make_reduce_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "some")])) then (let coll = seq_to_list (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((Bool false)) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_some_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "every")])) then (let coll = seq_to_list (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((Bool true)) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_every_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [_match_val; (String "for-each")])) then (let coll = seq_to_list (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value (Nil) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_for_each_frame (f) ((rest (coll))) (env))) (kont)))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Unknown HO type: "); ho_type])))))))))))))))
|
||||||
|
|
||||||
(* step-ho-map *)
|
(* step-ho-map *)
|
||||||
and step_ho_map args env kont =
|
and step_ho_map args env kont =
|
||||||
|
|||||||
@@ -331,8 +331,11 @@ on type (list → existing path, vector → index loop, string → char iteratio
|
|||||||
Steps:
|
Steps:
|
||||||
- [x] Spec: extend `map`/`filter`/`reduce`/`for-each`/`some`/`every?` in `spec/evaluator.sx`
|
- [x] Spec: extend `map`/`filter`/`reduce`/`for-each`/`some`/`every?` in `spec/evaluator.sx`
|
||||||
to type-dispatch; add `in-range` lazy sequence type + helpers.
|
to type-dispatch; add `in-range` lazy sequence type + helpers.
|
||||||
- [ ] OCaml: update HO form dispatch; add `SxRange` or use lazy list; implement `sequence-*`
|
- [x] OCaml: update HO form dispatch; add `SxRange` or use lazy list; implement `sequence-*`
|
||||||
primitives.
|
primitives.
|
||||||
|
seq_to_list helper before let-rec block; ho_setup_dispatch wraps all 7 coll bindings;
|
||||||
|
seq-to-list/sequence-to-list/vector/length/ref/append/in-range in sx_primitives.ml.
|
||||||
|
4385/1080 (all failures pre-existing hs-*/regex; 0 regressions).
|
||||||
- [ ] JS bootstrapper: update.
|
- [ ] JS bootstrapper: update.
|
||||||
- [ ] Tests: 30+ tests in `spec/tests/test-sequences.sx` — map over vector, filter over
|
- [ ] Tests: 30+ tests in `spec/tests/test-sequences.sx` — map over vector, filter over
|
||||||
range, for-each over string chars, sequence-append, sequence->list/vector coercions.
|
range, for-each over string chars, sequence-append, sequence->list/vector coercions.
|
||||||
@@ -732,4 +735,5 @@ _Newest first._
|
|||||||
- 2026-04-25: Phase 1 spec step done — all 10 vector primitives in spec/primitives.sx have full :as type annotations, :returns, :doc; make-vector optional fill param added.
|
- 2026-04-25: Phase 1 spec step done — all 10 vector primitives in spec/primitives.sx have full :as type annotations, :returns, :doc; make-vector optional fill param added.
|
||||||
- 2026-04-25: Phase 1 OCaml step done — bounds-checked vector-ref/set!, vector-copy now accepts optional start/end, spec/primitives.sx doc updated. 10/10 r7rs vector tests pass, 4747 total (394 pre-existing hs-upstream fails unchanged).
|
- 2026-04-25: Phase 1 OCaml step done — bounds-checked vector-ref/set!, vector-copy now accepts optional start/end, spec/primitives.sx doc updated. 10/10 r7rs vector tests pass, 4747 total (394 pre-existing hs-upstream fails unchanged).
|
||||||
- 2026-04-25: Phase 0 complete — stopped CL/APL/Ruby/Tcl loops (all 4 idle at shell); confirmed E38 (tokenizer :end/:line) and E39 (WebWorker stub) both have implementation commits.
|
- 2026-04-25: Phase 0 complete — stopped CL/APL/Ruby/Tcl loops (all 4 idle at shell); confirmed E38 (tokenizer :end/:line) and E39 (WebWorker stub) both have implementation commits.
|
||||||
|
- 2026-05-01: Phase 11 OCaml step done — seq_to_list helper added before let-rec; ho_setup_dispatch wraps all 7 coll bindings with seq_to_list; seq-to-list/sequence-to-list/to-vector/length/ref/append + in-range primitives in sx_primitives.ml. 4385/4385 baseline unchanged, 0 regressions. Committed 7286629c.
|
||||||
- 2026-05-01: Phase 11 Spec step done — seq-to-list coercion helper; ho-setup-dispatch extended with seqToList on all collection args; sequence-to-list/vector/length/ref/append + in-range added to evaluator.sx. Restored 3 accidentally-deleted make-cek-state/value/suspended definitions. Fixed 8 shorthand define forms + added vector->list/list->vector transpiler renames. JS: 2137 passing (+28 vs HEAD baseline of 2109).
|
- 2026-05-01: Phase 11 Spec step done — seq-to-list coercion helper; ho-setup-dispatch extended with seqToList on all collection args; sequence-to-list/vector/length/ref/append + in-range added to evaluator.sx. Restored 3 accidentally-deleted make-cek-state/value/suspended definitions. Fixed 8 shorthand define forms + added vector->list/list->vector transpiler renames. JS: 2137 passing (+28 vs HEAD baseline of 2109).
|
||||||
|
|||||||
Reference in New Issue
Block a user