Add cek-call, context primitive, forms.sx, regex-find-all stubs
- cek-call/cek-run: dispatch through Sx_ref.cek_call for signal tests - context: registered as both env binding and Sx_primitives primitive so signals.sx can resolve it through the primitive table - forms.sx: loaded before other web modules — provides defpage special form, stream-chunk-id, normalize-binding-key, etc. - regex-find-all: substring-based stub for component scanning - now-ms: stub returning 1000 1525 → 1578 passing tests (+53). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -332,6 +332,14 @@ let make_test_env () =
|
|||||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||||
(match stack with v :: _ -> v | [] -> Nil)
|
(match stack with v :: _ -> v | [] -> Nil)
|
||||||
| _ -> Nil);
|
| _ -> Nil);
|
||||||
|
let context_fn = (fun args ->
|
||||||
|
match args with
|
||||||
|
| String name :: rest ->
|
||||||
|
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||||
|
(match stack with v :: _ -> v | [] -> (match rest with d :: _ -> d | [] -> Nil))
|
||||||
|
| _ -> Nil) in
|
||||||
|
bind "context" context_fn;
|
||||||
|
Sx_primitives.register "context" context_fn;
|
||||||
bind "scope-emit!" (fun args ->
|
bind "scope-emit!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [String name; value] ->
|
| [String name; value] ->
|
||||||
@@ -398,6 +406,49 @@ let make_test_env () =
|
|||||||
eval_expr m.m_body (Env local)
|
eval_expr m.m_body (Env local)
|
||||||
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
|
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
|
||||||
|
|
||||||
|
bind "cek-call" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [fn_val; List call_args] -> Sx_ref.cek_call fn_val (List call_args)
|
||||||
|
| [fn_val; ListRef { contents = call_args }] -> Sx_ref.cek_call fn_val (List call_args)
|
||||||
|
| [fn_val; Nil] -> Sx_ref.cek_call fn_val (List [])
|
||||||
|
| [fn_val] -> Sx_ref.cek_call fn_val (List [])
|
||||||
|
| _ -> Nil);
|
||||||
|
bind "cek-run" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [state] -> Sx_ref.cek_run state
|
||||||
|
| _ -> Nil);
|
||||||
|
bind "now-ms" (fun _args -> Number 1000.0);
|
||||||
|
bind "regex-find-all" (fun args ->
|
||||||
|
(* Stub: supports simple ~name pattern for component scanning *)
|
||||||
|
match args with
|
||||||
|
| [String pattern; String text] ->
|
||||||
|
let prefix = if String.length pattern > 2 && pattern.[0] = '(' then
|
||||||
|
(* Extract literal prefix from pattern like "(~[a-z/.-]+" → "~" *)
|
||||||
|
let s = String.sub pattern 1 (String.length pattern - 1) in
|
||||||
|
let p = try String.sub s 0 (String.index s '[')
|
||||||
|
with Not_found -> try String.sub s 0 (String.index s '(')
|
||||||
|
with Not_found -> s in
|
||||||
|
if String.length p > 0 then p else "~"
|
||||||
|
else pattern in
|
||||||
|
let results = ref [] in
|
||||||
|
let len = String.length text in
|
||||||
|
let plen = String.length prefix in
|
||||||
|
let i = ref 0 in
|
||||||
|
while !i <= len - plen do
|
||||||
|
if String.sub text !i plen = prefix then begin
|
||||||
|
(* Find end of identifier *)
|
||||||
|
let j = ref (!i + plen) in
|
||||||
|
while !j < len && let c = text.[!j] in
|
||||||
|
(c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9')
|
||||||
|
|| c = '-' || c = '/' || c = '_' || c = '.' do
|
||||||
|
incr j
|
||||||
|
done;
|
||||||
|
results := String (String.sub text !i (!j - !i)) :: !results;
|
||||||
|
i := !j
|
||||||
|
end else incr i
|
||||||
|
done;
|
||||||
|
List (List.rev !results)
|
||||||
|
| _ -> List []);
|
||||||
bind "callable?" (fun args ->
|
bind "callable?" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
|
| [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
|
||||||
@@ -962,6 +1013,7 @@ let run_spec_tests env test_files =
|
|||||||
load_module "adapter-html.sx" web_dir;
|
load_module "adapter-html.sx" web_dir;
|
||||||
load_module "adapter-sx.sx" web_dir;
|
load_module "adapter-sx.sx" web_dir;
|
||||||
(* Web modules for web/tests/ *)
|
(* Web modules for web/tests/ *)
|
||||||
|
load_module "forms.sx" web_dir;
|
||||||
load_module "engine.sx" web_dir;
|
load_module "engine.sx" web_dir;
|
||||||
load_module "page-helpers.sx" web_dir;
|
load_module "page-helpers.sx" web_dir;
|
||||||
load_module "request-handler.sx" web_dir;
|
load_module "request-handler.sx" web_dir;
|
||||||
|
|||||||
Reference in New Issue
Block a user