HS: extend parser/runtime + new node test runner; ignore test-results/
- Parser: `--` line comments, `|` op, `result` → `the-result`, query-scoped `<sel> in <expr>`, `is a/an <type>` predicate, multi-`as` chaining with `|`, `match`/`precede` keyword aliases, `[attr]` add/toggle, between attr forms - Runtime: per-element listener registry + hs-deactivate!, attr toggle variants, set-inner-html boots subtree, hs-append polymorphic on string/list/element, default? / array-set! / query-all-in / list-set via take+drop, hs-script idempotence guard - Integration: skip reserved (me/it/event/you/yourself) when collecting vars - Tokenizer: emit `--` comments and `|` op - Test framework + conformance runner updates; new tests/hs-run-filtered.js (single-process Node runner using OCaml VM step-limit to bound infinite loops); generate-sx-conformance-dev.py improvements - mcp_tree.ml + run_tests.ml: harness extensions - .gitignore: top-level test-results/ (Playwright artifacts) Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
1
.gitignore
vendored
1
.gitignore
vendored
@@ -23,6 +23,7 @@ hosts/ocaml/test-results/
|
||||
shared/static/wasm/sx_browser.bc.wasm.assets/
|
||||
.claude/worktrees/
|
||||
tests/playwright/test-results/
|
||||
test-results/
|
||||
test-case-define.sx
|
||||
test-case-define.txt
|
||||
test_all.js
|
||||
|
||||
@@ -155,6 +155,192 @@ let register_mcp_jit_hook () =
|
||||
| None -> None))
|
||||
| _ -> None)
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* Native tree-tools helpers — avoid CEK overhead on big trees. *)
|
||||
(* Mirror the SX semantics from lib/tree-tools.sx but run as direct *)
|
||||
(* OCaml recursion. Used by read-subtree / validate / find-all / *)
|
||||
(* find-across / comp-usage handlers. *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
let native_path_str path =
|
||||
"[" ^ String.concat "," (List.map string_of_int path) ^ "]"
|
||||
|
||||
let rec native_node_display (node : value) : string =
|
||||
match node with
|
||||
| Nil -> "nil"
|
||||
| Symbol s -> s
|
||||
| Keyword k -> ":" ^ k
|
||||
| String s -> "\"" ^ s ^ "\""
|
||||
| Number n ->
|
||||
if Float.is_integer n then string_of_int (int_of_float n)
|
||||
else Printf.sprintf "%g" n
|
||||
| Bool true -> "true"
|
||||
| Bool false -> "false"
|
||||
| List [] | ListRef { contents = [] } -> "()"
|
||||
| List (h :: t) | ListRef { contents = h :: t } ->
|
||||
if t = [] then "(" ^ native_node_display h ^ ")"
|
||||
else "(" ^ native_node_display h ^ " ...)"
|
||||
| Dict _ -> "{...}"
|
||||
| v -> Sx_runtime.value_to_str v
|
||||
|
||||
(* node-summary-short: "(head)" for singletons, "(head second ...)" for >3,
|
||||
"(all node-displays joined)" for small lists. Mirrors lib/tree-tools.sx. *)
|
||||
let native_node_summary_short node =
|
||||
match node with
|
||||
| List [] | ListRef { contents = [] } -> "()"
|
||||
| List items | ListRef { contents = items } ->
|
||||
let n = List.length items in
|
||||
if n > 3 then
|
||||
let head = native_node_display (List.hd items) in
|
||||
let second = native_node_display (List.nth items 1) in
|
||||
Printf.sprintf "(%s %s ...)" head second
|
||||
else
|
||||
"(" ^ String.concat " " (List.map native_node_display items) ^ ")"
|
||||
| _ -> native_node_display node
|
||||
|
||||
let rec native_node_matches node pattern =
|
||||
match node with
|
||||
| Symbol s | String s ->
|
||||
(try ignore (Str.search_forward (Str.regexp_string pattern) s 0); true
|
||||
with Not_found -> false)
|
||||
| List items | ListRef { contents = items } ->
|
||||
List.exists (fun c -> native_node_matches c pattern) items
|
||||
| _ -> false
|
||||
|
||||
(* Raw find: returns reversed list of (path, summary) pairs — caller reverses. *)
|
||||
let native_find_all_raw exprs pattern =
|
||||
let nodes = match exprs with
|
||||
| List xs | ListRef { contents = xs } -> xs
|
||||
| x -> [x] in
|
||||
let acc = ref [] in
|
||||
let rec go node path =
|
||||
if native_node_matches node pattern then
|
||||
acc := (List.rev path, native_node_summary_short node) :: !acc;
|
||||
match node with
|
||||
| List items | ListRef { contents = items } ->
|
||||
List.iteri (fun i child -> go child (i :: path)) items
|
||||
| _ -> ()
|
||||
in
|
||||
List.iteri (fun i node -> go node [i]) nodes;
|
||||
List.rev !acc
|
||||
|
||||
(* SX-value-returning wrapper — kept for any SX code that still calls find-all. *)
|
||||
let native_find_all_sx exprs pattern =
|
||||
let pairs = native_find_all_raw exprs pattern in
|
||||
List (List.map (fun (path, summary) ->
|
||||
List [List (List.map (fun i -> Number (float_of_int i)) path);
|
||||
String summary]
|
||||
) pairs)
|
||||
|
||||
(* navigate: walk a tree by a list of indices. Wraps exprs into a list on entry
|
||||
(mirrors SX navigate). Returns Nil if any index is out of range. *)
|
||||
let native_navigate exprs path =
|
||||
let init = match exprs with
|
||||
| List _ | ListRef _ -> exprs
|
||||
| x -> List [x] in
|
||||
let rec step current = function
|
||||
| [] -> current
|
||||
| i :: rest ->
|
||||
(match current with
|
||||
| List items when i >= 0 && i < List.length items ->
|
||||
step (List.nth items i) rest
|
||||
| ListRef { contents = items } when i >= 0 && i < List.length items ->
|
||||
step (List.nth items i) rest
|
||||
| _ -> Nil) in
|
||||
step init path
|
||||
|
||||
(* annotate-tree: render a list of exprs as an indented path-annotated string.
|
||||
Mirrors the `annotate-node` dispatch from lib/tree-tools.sx:
|
||||
- small lists (len<=4, no list children) render inline
|
||||
- others render head on first line, children indented, closing ")"
|
||||
Path annotations use [i,j,k,...] form. *)
|
||||
let native_annotate_tree exprs =
|
||||
let nodes = match exprs with
|
||||
| List xs | ListRef { contents = xs } -> xs
|
||||
| x -> [x] in
|
||||
let out = Buffer.create 1024 in
|
||||
let first = ref true in
|
||||
let emit s =
|
||||
if !first then first := false else Buffer.add_char out '\n';
|
||||
Buffer.add_string out s in
|
||||
let rec ann node path depth =
|
||||
let indent = String.make (depth * 2) ' ' in
|
||||
let label = native_path_str (List.rev path) in
|
||||
match node with
|
||||
| List [] | ListRef { contents = [] } ->
|
||||
emit (indent ^ label ^ " ()")
|
||||
| List items | ListRef { contents = items } ->
|
||||
let n = List.length items in
|
||||
let rest = List.tl items in
|
||||
let any_child_list = List.exists
|
||||
(fun c -> match c with List _ | ListRef _ -> true | _ -> false) rest in
|
||||
if n <= 4 && not any_child_list then
|
||||
emit (indent ^ label ^ " (" ^
|
||||
String.concat " " (List.map native_node_display items) ^ ")")
|
||||
else begin
|
||||
let head_str = native_node_display (List.hd items) in
|
||||
emit (indent ^ label ^ " (" ^ head_str);
|
||||
List.iteri (fun i child ->
|
||||
if i > 0 then ann child (i :: path) (depth + 1)
|
||||
) items;
|
||||
emit (indent ^ " )")
|
||||
end
|
||||
| _ ->
|
||||
emit (indent ^ label ^ " " ^ native_node_display node)
|
||||
in
|
||||
List.iteri (fun i node -> ann node [i] 0) nodes;
|
||||
Buffer.contents out
|
||||
|
||||
let native_read_subtree exprs path =
|
||||
let node = native_navigate exprs path in
|
||||
match node with
|
||||
| Nil -> "Error: path " ^ native_path_str path ^ " not found"
|
||||
| _ -> native_annotate_tree (List [node])
|
||||
|
||||
(* validate: walk the tree, emit WARNING for malformed letrec bindings and
|
||||
ERROR for defisland/defcomp with fewer than 3 args. *)
|
||||
let native_validate exprs =
|
||||
let errors = ref [] in
|
||||
let emit s = errors := s :: !errors in
|
||||
let rec go node path =
|
||||
(match node with
|
||||
| List items | ListRef { contents = items } ->
|
||||
(match items with
|
||||
| [] -> ()
|
||||
| head :: _ ->
|
||||
let head_name = match head with Symbol s -> Some s | _ -> None in
|
||||
(match head_name with
|
||||
| Some "letrec" when List.length items >= 2 ->
|
||||
let bindings = List.nth items 1 in
|
||||
(match bindings with
|
||||
| List pairs | ListRef { contents = pairs } ->
|
||||
List.iteri (fun i pair ->
|
||||
let ok = match pair with
|
||||
| List (Symbol _ :: _ :: _) -> true
|
||||
| ListRef { contents = Symbol _ :: _ :: _ } -> true
|
||||
| _ -> false in
|
||||
if not ok then
|
||||
emit (Printf.sprintf
|
||||
"WARNING %s: letrec binding %d is not a (name value) pair: %s"
|
||||
(native_path_str (List.rev (i :: 1 :: path)))
|
||||
i
|
||||
(native_node_display pair))
|
||||
) pairs
|
||||
| _ -> ())
|
||||
| Some (("defisland" | "defcomp") as nm) when List.length items < 4 ->
|
||||
emit (Printf.sprintf
|
||||
"ERROR %s: %s has fewer than 3 args (name params b..."
|
||||
(native_path_str (List.rev path)) nm)
|
||||
| _ -> ()));
|
||||
List.iteri (fun i child -> go child (i :: path)) items
|
||||
| _ -> ())
|
||||
in
|
||||
let nodes = match exprs with
|
||||
| List xs | ListRef { contents = xs } -> xs
|
||||
| x -> [x] in
|
||||
List.iteri (fun i node -> go node [i]) nodes;
|
||||
if !errors = [] then "OK" else String.concat "\n" (List.rev !errors)
|
||||
|
||||
let setup_env () =
|
||||
let e = make_env () in
|
||||
(* Primitives are auto-registered at module init *)
|
||||
@@ -439,6 +625,30 @@ let setup_env () =
|
||||
try load_sx_file e (Filename.concat lib_dir "compiler.sx");
|
||||
register_mcp_jit_hook ()
|
||||
with exn -> Printf.eprintf "[mcp] Warning: compiler.sx load failed (JIT disabled): %s\n%!" (Printexc.to_string exn));
|
||||
|
||||
(* Native-impl the hot tree-tools ops — replaces SX versions to avoid CEK
|
||||
overhead on big trees. See native_* helpers defined above setup_env. *)
|
||||
ignore (Sx_types.env_bind e "find-all" (NativeFn ("find-all", fun args ->
|
||||
match args with
|
||||
| [exprs; String pattern] -> native_find_all_sx exprs pattern
|
||||
| _ -> List [])));
|
||||
ignore (Sx_types.env_bind e "read-subtree" (NativeFn ("read-subtree", fun args ->
|
||||
match args with
|
||||
| [exprs; List path] | [exprs; ListRef { contents = path }] ->
|
||||
let ints = List.map (fun v -> match v with Number n -> int_of_float n | _ -> 0) path in
|
||||
String (native_read_subtree exprs ints)
|
||||
| _ -> String "")));
|
||||
ignore (Sx_types.env_bind e "validate" (NativeFn ("validate", fun args ->
|
||||
match args with
|
||||
| [exprs] -> String (native_validate exprs)
|
||||
| _ -> String "")));
|
||||
ignore (Sx_types.env_bind e "path-str" (NativeFn ("path-str", fun args ->
|
||||
match args with
|
||||
| [List path] | [ListRef { contents = path }] ->
|
||||
let ints = List.map (fun v -> match v with Number n -> int_of_float n | _ -> 0) path in
|
||||
String (native_path_str ints)
|
||||
| _ -> String "[]")));
|
||||
|
||||
Printf.eprintf "[mcp] Ready in %.0fms\n%!" ((Unix.gettimeofday () -. t0) *. 1000.0);
|
||||
env := e
|
||||
|
||||
@@ -804,7 +1014,11 @@ let handle_sx_read_subtree args =
|
||||
let open Yojson.Safe.Util in
|
||||
let tree = parse_file (require_file args "file") in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
text_result (value_to_string (call_sx "read-subtree" [tree; path]))
|
||||
let ints = match path with
|
||||
| List xs | ListRef { contents = xs } ->
|
||||
List.map (fun v -> match v with Number n -> int_of_float n | _ -> 0) xs
|
||||
| _ -> [] in
|
||||
text_result (native_read_subtree tree ints)
|
||||
|
||||
let handle_sx_get_context args =
|
||||
let open Yojson.Safe.Util in
|
||||
@@ -816,17 +1030,8 @@ let handle_sx_find_all args =
|
||||
let open Yojson.Safe.Util in
|
||||
let tree = parse_file (require_file args "file") in
|
||||
let pattern = args |> member "pattern" |> to_string in
|
||||
let results = call_sx "find-all" [tree; String pattern] in
|
||||
let lines = match results with
|
||||
| List items | ListRef { contents = items } ->
|
||||
List.map (fun item ->
|
||||
match item with
|
||||
| List [p; s] | ListRef { contents = [p; s] } ->
|
||||
value_to_string (call_sx "path-str" [p]) ^ " " ^ value_to_string s
|
||||
| _ -> value_to_string item
|
||||
) items
|
||||
| _ -> [value_to_string results]
|
||||
in
|
||||
let results = native_find_all_raw tree pattern in
|
||||
let lines = List.map (fun (p, s) -> native_path_str p ^ " " ^ s) results in
|
||||
text_result (String.concat "\n" lines)
|
||||
|
||||
let handle_sx_get_siblings args =
|
||||
@@ -843,7 +1048,7 @@ let handle_sx_get_siblings args =
|
||||
|
||||
let handle_sx_validate args =
|
||||
let tree = parse_file (require_file args "file") in
|
||||
text_result (value_to_string (call_sx "validate" [tree]))
|
||||
text_result (native_validate tree)
|
||||
|
||||
let handle_sx_replace_node args =
|
||||
let open Yojson.Safe.Util in
|
||||
@@ -1912,16 +2117,8 @@ let handle_sx_find_across args =
|
||||
let rel = relative_path ~base:dir path in
|
||||
try
|
||||
let tree = parse_file path in
|
||||
let results = call_sx "find-all" [tree; String pattern] in
|
||||
(match results with
|
||||
| List items | ListRef { contents = items } ->
|
||||
List.map (fun item ->
|
||||
match item with
|
||||
| List [p; s] | ListRef { contents = [p; s] } ->
|
||||
rel ^ " " ^ value_to_string (call_sx "path-str" [p]) ^ " " ^ value_to_string s
|
||||
| _ -> rel ^ " " ^ value_to_string item
|
||||
) items
|
||||
| _ -> [])
|
||||
let results = native_find_all_raw tree pattern in
|
||||
List.map (fun (p, s) -> rel ^ " " ^ native_path_str p ^ " " ^ s) results
|
||||
with _ -> []
|
||||
) files in
|
||||
if all_lines = [] then text_result "(no matches)"
|
||||
@@ -1948,16 +2145,8 @@ let handle_sx_comp_usage args =
|
||||
let rel = relative_path ~base:dir path in
|
||||
try
|
||||
let tree = parse_file path in
|
||||
let results = call_sx "find-all" [tree; String name] in
|
||||
(match results with
|
||||
| List items | ListRef { contents = items } ->
|
||||
List.map (fun item ->
|
||||
match item with
|
||||
| List [p; s] | ListRef { contents = [p; s] } ->
|
||||
rel ^ " " ^ value_to_string (call_sx "path-str" [p]) ^ " " ^ value_to_string s
|
||||
| _ -> rel ^ " " ^ value_to_string item
|
||||
) items
|
||||
| _ -> [])
|
||||
let results = native_find_all_raw tree name in
|
||||
List.map (fun (p, s) -> rel ^ " " ^ native_path_str p ^ " " ^ s) results
|
||||
with _ -> []
|
||||
) files in
|
||||
if all_lines = [] then text_result "(no usages found)"
|
||||
|
||||
@@ -25,6 +25,9 @@ open Sx_ref
|
||||
let pass_count = ref 0
|
||||
let fail_count = ref 0
|
||||
let suite_stack : string list ref = ref []
|
||||
(* Test filter: when Some, only run tests (suite, name) in the set.
|
||||
Populated by --only-failing=FILE from lines like "FAIL: suite > name: error". *)
|
||||
let suite_filter : (string * string, unit) Hashtbl.t option ref = ref None
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Deep equality — SX structural comparison *)
|
||||
@@ -176,6 +179,17 @@ let make_test_env () =
|
||||
suite_stack := (match !suite_stack with _ :: t -> t | [] -> []);
|
||||
Nil);
|
||||
|
||||
bind "test-allowed?" (fun args ->
|
||||
match !suite_filter with
|
||||
| None -> Bool true
|
||||
| Some filter ->
|
||||
let name = match args with
|
||||
| [String s] -> s
|
||||
| [v] -> Sx_types.value_to_string v
|
||||
| _ -> "" in
|
||||
let suite = match !suite_stack with [] -> "" | s :: _ -> s in
|
||||
Bool (Hashtbl.mem filter (suite, name)));
|
||||
|
||||
(* --- Test helpers --- *)
|
||||
|
||||
bind "sx-parse" (fun args ->
|
||||
@@ -1563,6 +1577,131 @@ let run_spec_tests env test_files =
|
||||
| _ -> child
|
||||
in
|
||||
|
||||
(* Minimal HTML parser for test mock.
|
||||
Parses an HTML string into mock child elements and appends them to `parent`.
|
||||
Handles: <tag attr="v" attr='v' attr=v attr>content</tag>, nested elements,
|
||||
self-closing tags, text content. No comments, CDATA, DOCTYPE, or entities. *)
|
||||
let parse_html_into parent_d html =
|
||||
let len = String.length html in
|
||||
let pos = ref 0 in
|
||||
let is_name_char c =
|
||||
(c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
|
||||
(c >= '0' && c <= '9') || c = '-' || c = '_' || c = ':'
|
||||
in
|
||||
let skip_ws () =
|
||||
while !pos < len && (let c = html.[!pos] in c = ' ' || c = '\n' || c = '\t' || c = '\r') do
|
||||
incr pos
|
||||
done
|
||||
in
|
||||
let parse_name () =
|
||||
let start = !pos in
|
||||
while !pos < len && is_name_char html.[!pos] do incr pos done;
|
||||
String.sub html start (!pos - start)
|
||||
in
|
||||
let parse_attr_value () =
|
||||
if !pos >= len then ""
|
||||
else if html.[!pos] = '"' then begin
|
||||
incr pos;
|
||||
let start = !pos in
|
||||
while !pos < len && html.[!pos] <> '"' do incr pos done;
|
||||
let v = String.sub html start (!pos - start) in
|
||||
if !pos < len then incr pos;
|
||||
v
|
||||
end
|
||||
else if html.[!pos] = '\'' then begin
|
||||
incr pos;
|
||||
let start = !pos in
|
||||
while !pos < len && html.[!pos] <> '\'' do incr pos done;
|
||||
let v = String.sub html start (!pos - start) in
|
||||
if !pos < len then incr pos;
|
||||
v
|
||||
end
|
||||
else begin
|
||||
let start = !pos in
|
||||
while !pos < len && (let c = html.[!pos] in
|
||||
c <> ' ' && c <> '\t' && c <> '\n' && c <> '\r'
|
||||
&& c <> '>' && c <> '/') do
|
||||
incr pos
|
||||
done;
|
||||
String.sub html start (!pos - start)
|
||||
end
|
||||
in
|
||||
let parse_attrs (elem : (string, Sx_types.value) Hashtbl.t) =
|
||||
skip_ws ();
|
||||
while !pos < len && html.[!pos] <> '>' && html.[!pos] <> '/' do
|
||||
let name = parse_name () in
|
||||
if name = "" then begin
|
||||
(* Avoid infinite loop on unexpected char *)
|
||||
if !pos < len then incr pos
|
||||
end else begin
|
||||
let value =
|
||||
if !pos < len && html.[!pos] = '=' then begin
|
||||
incr pos; parse_attr_value ()
|
||||
end else ""
|
||||
in
|
||||
let attrs = match Hashtbl.find_opt elem "attributes" with
|
||||
| Some (Dict a) -> a
|
||||
| _ -> let a = Hashtbl.create 4 in Hashtbl.replace elem "attributes" (Dict a); a in
|
||||
Hashtbl.replace attrs name (String value);
|
||||
if name = "id" then Hashtbl.replace elem "id" (String value);
|
||||
if name = "class" then Hashtbl.replace elem "className" (String value);
|
||||
if name = "value" then Hashtbl.replace elem "value" (String value);
|
||||
skip_ws ()
|
||||
end
|
||||
done
|
||||
in
|
||||
let void_tags = ["br"; "hr"; "img"; "input"; "meta"; "link"; "area";
|
||||
"base"; "col"; "embed"; "source"; "track"; "wbr"] in
|
||||
let rec parse_children parent_elem =
|
||||
while !pos < len && not (!pos + 1 < len && html.[!pos] = '<' && html.[!pos + 1] = '/') do
|
||||
if !pos < len && html.[!pos] = '<' && !pos + 1 < len && is_name_char html.[!pos + 1] then
|
||||
parse_element parent_elem
|
||||
else if !pos < len && html.[!pos] = '<' then begin
|
||||
(* Unknown/comment — skip to next '>' *)
|
||||
while !pos < len && html.[!pos] <> '>' do incr pos done;
|
||||
if !pos < len then incr pos
|
||||
end
|
||||
else begin
|
||||
let start = !pos in
|
||||
while !pos < len && html.[!pos] <> '<' do incr pos done;
|
||||
let text = String.sub html start (!pos - start) in
|
||||
if String.trim text <> "" then begin
|
||||
let cur = match Hashtbl.find_opt parent_elem "textContent" with
|
||||
| Some (String s) -> s | _ -> "" in
|
||||
Hashtbl.replace parent_elem "textContent" (String (cur ^ text))
|
||||
end
|
||||
end
|
||||
done
|
||||
and parse_element parent_elem =
|
||||
incr pos; (* skip '<' *)
|
||||
let tag = parse_name () in
|
||||
if tag = "" then () else begin
|
||||
let el = make_mock_element tag in
|
||||
let eld = match el with Dict d -> d | _ -> Hashtbl.create 0 in
|
||||
parse_attrs eld;
|
||||
skip_ws ();
|
||||
let self_closing =
|
||||
if !pos < len && html.[!pos] = '/' then begin incr pos; true end else false
|
||||
in
|
||||
if !pos < len && html.[!pos] = '>' then incr pos;
|
||||
let is_void = List.mem (String.lowercase_ascii tag) void_tags in
|
||||
if not self_closing && not is_void then begin
|
||||
parse_children eld;
|
||||
if !pos + 1 < len && html.[!pos] = '<' && html.[!pos + 1] = '/' then begin
|
||||
pos := !pos + 2;
|
||||
let _ = parse_name () in
|
||||
skip_ws ();
|
||||
if !pos < len && html.[!pos] = '>' then incr pos
|
||||
end
|
||||
end;
|
||||
ignore (mock_append_child (Dict parent_elem) el)
|
||||
end
|
||||
in
|
||||
pos := 0;
|
||||
parse_children parent_d
|
||||
in
|
||||
let _ = parse_html_into in
|
||||
|
||||
(* Helper: remove child from parent *)
|
||||
let mock_remove_child parent child =
|
||||
match parent, child with
|
||||
@@ -1578,11 +1717,21 @@ let run_spec_tests env test_files =
|
||||
in
|
||||
|
||||
(* Helper: querySelector - find element matching selector in tree *)
|
||||
let mock_matches el sel =
|
||||
let rec mock_matches el sel =
|
||||
match el with
|
||||
| Dict d ->
|
||||
let sel = String.trim sel in
|
||||
if String.length sel > 0 && sel.[0] = '#' then
|
||||
(* Compound selector: tag[attr=value] or tag.class or tag#id — split into parts *)
|
||||
if String.length sel > 1 &&
|
||||
((sel.[0] >= 'a' && sel.[0] <= 'z') || (sel.[0] >= 'A' && sel.[0] <= 'Z')) &&
|
||||
(String.contains sel '[' || String.contains sel '.' || String.contains sel '#') then
|
||||
let i = ref 0 in
|
||||
let n = String.length sel in
|
||||
while !i < n && ((sel.[!i] >= 'a' && sel.[!i] <= 'z') || (sel.[!i] >= 'A' && sel.[!i] <= 'Z') || (sel.[!i] >= '0' && sel.[!i] <= '9') || sel.[!i] = '-') do incr i done;
|
||||
let tag_part = String.sub sel 0 !i in
|
||||
let rest_part = String.sub sel !i (n - !i) in
|
||||
(mock_matches el tag_part) && (mock_matches el rest_part)
|
||||
else if String.length sel > 0 && sel.[0] = '#' then
|
||||
let id = String.sub sel 1 (String.length sel - 1) in
|
||||
(match Hashtbl.find_opt d "id" with Some (String i) -> i = id | _ -> false)
|
||||
else if String.length sel > 0 && sel.[0] = '.' then
|
||||
@@ -1590,7 +1739,8 @@ let run_spec_tests env test_files =
|
||||
List.mem cls (get_classes d)
|
||||
else if String.length sel > 0 && sel.[0] = '[' then
|
||||
(* [attr] or [attr="value"] *)
|
||||
let inner = String.sub sel 1 (String.length sel - 2) in
|
||||
let end_bracket = try String.index sel ']' with Not_found -> String.length sel - 1 in
|
||||
let inner = String.sub sel 1 (end_bracket - 1) in
|
||||
(match String.split_on_char '=' inner with
|
||||
| [attr] ->
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
|
||||
@@ -1621,19 +1771,51 @@ let run_spec_tests env test_files =
|
||||
| found -> mock_query_selector found (String.concat " " rest))
|
||||
| [] -> Nil
|
||||
and mock_query_selector_single el sel =
|
||||
match el with
|
||||
| Dict d ->
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
let rec search = function
|
||||
| [] -> Nil
|
||||
| child :: rest ->
|
||||
if mock_matches child sel then child
|
||||
else match mock_query_selector_single child sel with
|
||||
| Nil -> search rest
|
||||
| found -> found
|
||||
in
|
||||
search kids
|
||||
| _ -> Nil
|
||||
(* Handle tag:nth-of-type(N): find Nth child of same tag under parent *)
|
||||
let nth_match = try
|
||||
let idx = String.index sel ':' in
|
||||
let tag = String.sub sel 0 idx in
|
||||
let rest = String.sub sel idx (String.length sel - idx) in
|
||||
if String.length rest > String.length ":nth-of-type(" &&
|
||||
String.sub rest 0 (String.length ":nth-of-type(") = ":nth-of-type(" &&
|
||||
rest.[String.length rest - 1] = ')'
|
||||
then
|
||||
let n_str = String.sub rest (String.length ":nth-of-type(")
|
||||
(String.length rest - String.length ":nth-of-type(" - 1) in
|
||||
(try Some (tag, int_of_string (String.trim n_str)) with _ -> None)
|
||||
else None
|
||||
with Not_found -> None in
|
||||
(match nth_match with
|
||||
| Some (tag, n) ->
|
||||
(* Walk tree; collect matching-tag elements in document order; return nth *)
|
||||
let found = ref [] in
|
||||
let rec walk node =
|
||||
match node with
|
||||
| Dict d ->
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
List.iter (fun child ->
|
||||
if mock_matches child tag then found := child :: !found;
|
||||
walk child
|
||||
) kids
|
||||
| _ -> ()
|
||||
in
|
||||
walk el;
|
||||
let matches = List.rev !found in
|
||||
(try List.nth matches (n - 1) with _ -> Nil)
|
||||
| None ->
|
||||
(match el with
|
||||
| Dict d ->
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
let rec search = function
|
||||
| [] -> Nil
|
||||
| child :: rest ->
|
||||
if mock_matches child sel then child
|
||||
else match mock_query_selector_single child sel with
|
||||
| Nil -> search rest
|
||||
| found -> found
|
||||
in
|
||||
search kids
|
||||
| _ -> Nil))
|
||||
in
|
||||
|
||||
let rec mock_query_all el sel =
|
||||
@@ -1742,7 +1924,7 @@ let run_spec_tests env test_files =
|
||||
| "addEventListener" | "removeEventListener" | "dispatchEvent"
|
||||
| "appendChild" | "removeChild" | "insertBefore" | "replaceChild"
|
||||
| "querySelector" | "querySelectorAll" | "closest" | "matches"
|
||||
| "contains" | "cloneNode" | "remove" | "focus" | "blur" | "click"
|
||||
| "contains" | "compareDocumentPosition" | "cloneNode" | "remove" | "focus" | "blur" | "click"
|
||||
| "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close"
|
||||
| "getBoundingClientRect" | "getAnimations" | "scrollIntoView"
|
||||
| "scrollTo" | "scroll" | "reset" -> Bool true
|
||||
@@ -1841,16 +2023,19 @@ let run_spec_tests env test_files =
|
||||
| Some (Dict _cl) -> () (* classes live in className *)
|
||||
| _ -> ())
|
||||
| "innerHTML" ->
|
||||
(* Setting innerHTML clears children and syncs textContent (like a browser) *)
|
||||
(* Setting innerHTML clears existing children, parses the HTML, and
|
||||
creates new mock child elements (approximating browser behavior). *)
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
List.iter (fun c -> match c with Dict cd ->
|
||||
Hashtbl.replace cd "parentElement" Nil;
|
||||
Hashtbl.replace cd "parentNode" Nil | _ -> ()) kids;
|
||||
Hashtbl.replace d "children" (List []);
|
||||
Hashtbl.replace d "childNodes" (List []);
|
||||
(* Approximate textContent: strip HTML tags from innerHTML *)
|
||||
Hashtbl.replace d "textContent" (String "");
|
||||
(match stored with
|
||||
| String s ->
|
||||
| String s when String.contains s '<' ->
|
||||
parse_html_into d s;
|
||||
(* Strip tags for a best-effort textContent *)
|
||||
let buf = Buffer.create (String.length s) in
|
||||
let in_tag = ref false in
|
||||
String.iter (fun c ->
|
||||
@@ -1859,6 +2044,7 @@ let run_spec_tests env test_files =
|
||||
else if not !in_tag then Buffer.add_char buf c
|
||||
) s;
|
||||
Hashtbl.replace d "textContent" (String (Buffer.contents buf))
|
||||
| String s -> Hashtbl.replace d "textContent" (String s)
|
||||
| _ -> Hashtbl.replace d "textContent" (String ""))
|
||||
| "textContent" ->
|
||||
(* Setting textContent clears children *)
|
||||
@@ -1887,6 +2073,8 @@ let run_spec_tests env test_files =
|
||||
| "setTimeout" -> (match rest with fn :: _ -> ignore (Sx_ref.cek_call fn (List [])); Nil | _ -> Nil)
|
||||
| "clearTimeout" -> Nil
|
||||
| _ -> Nil)
|
||||
| Dict d :: String "hasOwnProperty" :: [String k] ->
|
||||
Bool (Hashtbl.mem d k)
|
||||
| Dict d :: String m :: rest ->
|
||||
let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in
|
||||
|
||||
@@ -2139,6 +2327,33 @@ let run_spec_tests env test_files =
|
||||
| _ -> Nil
|
||||
in up (Dict d)
|
||||
| _ -> Nil)
|
||||
| "compareDocumentPosition" ->
|
||||
(match rest with
|
||||
| [other] ->
|
||||
let self = Dict d in
|
||||
let body = Dict mock_body in
|
||||
let found_self = ref false in
|
||||
let found_other = ref false in
|
||||
let self_first = ref false in
|
||||
let rec walk node =
|
||||
if !found_self && !found_other then ()
|
||||
else begin
|
||||
if mock_el_eq node self then begin
|
||||
if not !found_other then self_first := true;
|
||||
found_self := true
|
||||
end;
|
||||
if mock_el_eq node other then found_other := true;
|
||||
(match node with
|
||||
| Dict dd -> let kids = match Hashtbl.find_opt dd "children" with Some (List l) -> l | _ -> [] in
|
||||
List.iter walk kids
|
||||
| _ -> ())
|
||||
end
|
||||
in
|
||||
walk body;
|
||||
if !found_self && !found_other then
|
||||
Number (if !self_first then 4.0 else 2.0)
|
||||
else Number 0.0
|
||||
| _ -> Number 0.0)
|
||||
| "matches" ->
|
||||
(match rest with [String sel] -> Bool (mock_matches (Dict d) sel) | _ -> Bool false)
|
||||
| "contains" ->
|
||||
@@ -2213,25 +2428,62 @@ let run_spec_tests env test_files =
|
||||
Hashtbl.replace r "right" (Number 100.0); Hashtbl.replace r "bottom" (Number 100.0);
|
||||
Dict r
|
||||
| "insertAdjacentHTML" ->
|
||||
(* Position-aware insertion, coerce value to string *)
|
||||
(* Position-aware insertion. Parse the new HTML into a scratch
|
||||
container, then splice the resulting children into the target
|
||||
position WITHOUT disturbing sibling nodes. *)
|
||||
(match rest with
|
||||
| [String pos; value] ->
|
||||
| [String pos_kind; value] ->
|
||||
let html = match dom_stringify value with String s -> s | _ -> "" in
|
||||
let cur = match Hashtbl.find_opt d "innerHTML" with Some (String s) -> s | _ -> "" in
|
||||
let new_html = match pos with
|
||||
| "afterbegin" -> html ^ cur (* prepend *)
|
||||
| _ -> cur ^ html (* beforeend / default: append *)
|
||||
(* Parse new HTML into scratch container to get new child list.
|
||||
For pure-text content, wrap into the target's innerHTML path. *)
|
||||
let scratch = make_mock_element "div" in
|
||||
let scratch_d = match scratch with Dict sd -> sd | _ -> Hashtbl.create 0 in
|
||||
if String.contains html '<' then parse_html_into scratch_d html;
|
||||
let new_kids = match Hashtbl.find_opt scratch_d "children" with Some (List l) -> l | _ -> [] in
|
||||
let prepend = pos_kind = "beforebegin" || pos_kind = "afterbegin" in
|
||||
let insert_into container_d index =
|
||||
List.iter (fun c -> match c with
|
||||
| Dict cd ->
|
||||
Hashtbl.replace cd "parentElement" (Dict container_d);
|
||||
Hashtbl.replace cd "parentNode" (Dict container_d)
|
||||
| _ -> ()) new_kids;
|
||||
let kids = match Hashtbl.find_opt container_d "children" with Some (List l) -> l | _ -> [] in
|
||||
let before = List.filteri (fun i _ -> i < index) kids in
|
||||
let after = List.filteri (fun i _ -> i >= index) kids in
|
||||
let all = before @ new_kids @ after in
|
||||
Hashtbl.replace container_d "children" (List all);
|
||||
Hashtbl.replace container_d "childNodes" (List all);
|
||||
(* Update container innerHTML based on position kind, not index *)
|
||||
let cur = match Hashtbl.find_opt container_d "innerHTML" with Some (String s) -> s | _ -> "" in
|
||||
let new_html = if prepend then html ^ cur else cur ^ html in
|
||||
Hashtbl.replace container_d "innerHTML" (String new_html);
|
||||
let buf = Buffer.create (String.length new_html) in
|
||||
let in_tag = ref false in
|
||||
String.iter (fun c ->
|
||||
if c = '<' then in_tag := true
|
||||
else if c = '>' then in_tag := false
|
||||
else if not !in_tag then Buffer.add_char buf c
|
||||
) new_html;
|
||||
Hashtbl.replace container_d "textContent" (String (Buffer.contents buf))
|
||||
in
|
||||
Hashtbl.replace d "innerHTML" (String new_html);
|
||||
(* Sync textContent *)
|
||||
let buf = Buffer.create (String.length new_html) in
|
||||
let in_tag = ref false in
|
||||
String.iter (fun c ->
|
||||
if c = '<' then in_tag := true
|
||||
else if c = '>' then in_tag := false
|
||||
else if not !in_tag then Buffer.add_char buf c
|
||||
) new_html;
|
||||
Hashtbl.replace d "textContent" (String (Buffer.contents buf));
|
||||
(match pos_kind with
|
||||
| "beforebegin" | "afterend" ->
|
||||
(match Hashtbl.find_opt d "parentElement" with
|
||||
| Some (Dict pd) ->
|
||||
let siblings = match Hashtbl.find_opt pd "children" with Some (List l) -> l | _ -> [] in
|
||||
let rec find_idx i = function
|
||||
| [] -> List.length siblings
|
||||
| x :: _ when mock_el_eq x (Dict d) -> i
|
||||
| _ :: rest -> find_idx (i+1) rest
|
||||
in
|
||||
let self_idx = find_idx 0 siblings in
|
||||
let insert_idx = if pos_kind = "beforebegin" then self_idx else self_idx + 1 in
|
||||
insert_into pd insert_idx
|
||||
| _ -> ())
|
||||
| "afterbegin" -> insert_into d 0
|
||||
| _ (* "beforeend" *) ->
|
||||
let kids_len = match Hashtbl.find_opt d "children" with Some (List l) -> List.length l | _ -> 0 in
|
||||
insert_into d kids_len);
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
| "showModal" | "show" ->
|
||||
@@ -2341,6 +2593,8 @@ let run_spec_tests env test_files =
|
||||
Hashtbl.replace ev "_stopped" (Bool false);
|
||||
Hashtbl.replace ev "_stopImmediate" (Bool false);
|
||||
Dict ev
|
||||
| [String "Object"] ->
|
||||
Dict (Hashtbl.create 4)
|
||||
| _ -> Nil);
|
||||
|
||||
reg "host-callback" (fun args ->
|
||||
@@ -2823,7 +3077,39 @@ let () =
|
||||
let args = Array.to_list Sys.argv |> List.tl in
|
||||
let foundation_only = List.mem "--foundation" args in
|
||||
let jit_enabled = List.mem "--jit" args in
|
||||
let test_files = List.filter (fun a -> not (String.length a > 0 && a.[0] = '-')) args in
|
||||
(* --only-failing=PATH : read lines of form "FAIL: suite > name: ..." and
|
||||
restrict test runs to those (suite, name) pairs. *)
|
||||
List.iter (fun a ->
|
||||
let prefix = "--only-failing=" in
|
||||
if String.length a > String.length prefix
|
||||
&& String.sub a 0 (String.length prefix) = prefix then begin
|
||||
let path = String.sub a (String.length prefix) (String.length a - String.length prefix) in
|
||||
let filter = Hashtbl.create 64 in
|
||||
let ic = open_in path in
|
||||
(try while true do
|
||||
let line = input_line ic in
|
||||
(* Match " FAIL: <suite> > <name>: <err>" or "FAIL: <suite> > <name>: <err>" *)
|
||||
let line = String.trim line in
|
||||
if String.length line > 6 && String.sub line 0 6 = "FAIL: " then begin
|
||||
let rest = String.sub line 6 (String.length line - 6) in
|
||||
match String.index_opt rest '>' with
|
||||
| Some gt ->
|
||||
let suite = String.trim (String.sub rest 0 gt) in
|
||||
let after = String.sub rest (gt + 1) (String.length rest - gt - 1) in
|
||||
(match String.index_opt after ':' with
|
||||
| Some colon ->
|
||||
let name = String.trim (String.sub after 0 colon) in
|
||||
Hashtbl.replace filter (suite, name) ()
|
||||
| None -> ())
|
||||
| None -> ()
|
||||
end
|
||||
done with End_of_file -> ());
|
||||
close_in ic;
|
||||
Printf.eprintf "[filter] %d tests loaded from %s\n%!" (Hashtbl.length filter) path;
|
||||
suite_filter := Some filter
|
||||
end) args;
|
||||
let test_files = List.filter (fun a ->
|
||||
not (String.length a > 0 && a.[0] = '-')) args in
|
||||
|
||||
(* Always run foundation tests *)
|
||||
run_foundation_tests ();
|
||||
|
||||
@@ -77,7 +77,11 @@
|
||||
((= th (quote ref))
|
||||
(list (quote set!) (make-symbol (nth target 1)) value))
|
||||
((= th (quote local))
|
||||
(list (quote define) (make-symbol (nth target 1)) value))
|
||||
(list
|
||||
(quote hs-scoped-set!)
|
||||
(quote me)
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote dom-ref))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
@@ -85,18 +89,18 @@
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote me))
|
||||
(list (quote dom-set-inner-html) (quote me) value))
|
||||
(list (quote hs-set-inner-html!) (quote me) value))
|
||||
((= th (quote it)) (list (quote set!) (quote it) value))
|
||||
((= th (quote query))
|
||||
(list (quote dom-set-inner-html) (hs-to-sx target) value))
|
||||
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
|
||||
((= th (quote array-index))
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote hs-array-set!)
|
||||
(hs-to-sx (nth target 1))
|
||||
(hs-to-sx (nth target 2))
|
||||
value))
|
||||
((or (= th (quote next)) (= th (quote previous)) (= th (quote closest)))
|
||||
(list (quote dom-set-inner-html) (hs-to-sx target) value))
|
||||
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
|
||||
((= th (quote of))
|
||||
(let
|
||||
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
|
||||
@@ -162,10 +166,19 @@
|
||||
(let
|
||||
((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))
|
||||
(handler
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote event))
|
||||
wrapped-body)))
|
||||
(let
|
||||
((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false)))))
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote event))
|
||||
(if
|
||||
(uses-the-result? wrapped-body)
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list (quote the-result) nil))
|
||||
wrapped-body)
|
||||
wrapped-body)))))
|
||||
(if
|
||||
every?
|
||||
(list
|
||||
@@ -443,9 +456,7 @@
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
(list (quote nth) var-sym (quote __hs-idx))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
@@ -463,10 +474,7 @@
|
||||
((t (hs-to-sx expr)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote +) (list (quote hs-to-number) t) amount)))
|
||||
(list (list (quote __hs-new) (list (quote +) t amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
@@ -564,9 +572,7 @@
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
(list (quote nth) var-sym (quote __hs-idx))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
@@ -584,10 +590,7 @@
|
||||
((t (hs-to-sx expr)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote -) (list (quote hs-to-number) t) amount)))
|
||||
(list (list (quote __hs-new) (list (quote -) t amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
@@ -754,35 +757,53 @@
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote pick-first))
|
||||
(list
|
||||
(quote hs-pick-first)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-first)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote pick-last))
|
||||
(list
|
||||
(quote hs-pick-last)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-last)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote pick-random))
|
||||
(list
|
||||
(quote hs-pick-random)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-random)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2))))))
|
||||
((= head (quote pick-items))
|
||||
(list
|
||||
(quote hs-pick-items)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-items)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3)))))
|
||||
((= head (quote pick-match))
|
||||
(list
|
||||
(quote regex-match)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote regex-match)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote pick-matches))
|
||||
(list
|
||||
(quote regex-find-all)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote regex-find-all)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote prop-is))
|
||||
(list
|
||||
(quote hs-prop-is)
|
||||
@@ -870,6 +891,11 @@
|
||||
((= head (quote ref)) (make-symbol (nth ast 1)))
|
||||
((= head (quote query))
|
||||
(list (quote hs-query-first) (nth ast 1)))
|
||||
((= head (quote query-scoped))
|
||||
(list
|
||||
(quote hs-query-all-in)
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote attr))
|
||||
(list
|
||||
(quote dom-get-attr)
|
||||
@@ -890,7 +916,8 @@
|
||||
(quote dom-has-class?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(nth ast 2)))
|
||||
((= head (quote local)) (make-symbol (nth ast 1)))
|
||||
((= head (quote local))
|
||||
(list (quote hs-scoped-get) (quote me) (nth ast 1)))
|
||||
((= head (quote array))
|
||||
(cons (quote list) (map hs-to-sx (rest ast))))
|
||||
((= head (quote not))
|
||||
@@ -1163,6 +1190,14 @@
|
||||
(quote set!)
|
||||
(hs-to-sx tgt)
|
||||
(list (quote hs-add-to!) val (hs-to-sx tgt)))))
|
||||
((= head (quote add-attr))
|
||||
(let
|
||||
((tgt (nth ast 3)))
|
||||
(list
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx tgt)
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote remove-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
@@ -1296,6 +1331,20 @@
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote toggle-attr-val))
|
||||
(list
|
||||
(quote hs-toggle-attr-val!)
|
||||
(hs-to-sx (nth ast 3))
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote toggle-attr-diff))
|
||||
(list
|
||||
(quote hs-toggle-attr-diff!)
|
||||
(hs-to-sx (nth ast 5))
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 3)
|
||||
(hs-to-sx (nth ast 4))))
|
||||
((= head (quote set!))
|
||||
(emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
|
||||
((= head (quote put!))
|
||||
@@ -1358,14 +1407,49 @@
|
||||
nil))
|
||||
((= head (quote hide))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 1)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||
(list (quote hs-hide!) tgt strategy)))
|
||||
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-hide!) tgt strategy)
|
||||
(list
|
||||
(quote hs-hide-when!)
|
||||
tgt
|
||||
strategy
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx when-cond))))))
|
||||
((= head (quote show))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 1)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||
(list (quote hs-show!) tgt strategy)))
|
||||
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-show!) tgt strategy)
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-show-r)
|
||||
(list
|
||||
(quote hs-show-when!)
|
||||
tgt
|
||||
strategy
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx when-cond)))))
|
||||
(list
|
||||
(quote begin)
|
||||
(list
|
||||
(quote set!)
|
||||
(quote the-result)
|
||||
(quote __hs-show-r))
|
||||
(list (quote set!) (quote it) (quote __hs-show-r))
|
||||
(quote __hs-show-r))))))
|
||||
((= head (quote transition)) (emit-transition ast))
|
||||
((= head (quote transition-from))
|
||||
(let
|
||||
@@ -1424,6 +1508,14 @@
|
||||
(list (quote hs-settle) (quote me)))
|
||||
((= head (quote go))
|
||||
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote __get-cmd))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))))
|
||||
(list
|
||||
(quote begin)
|
||||
(list (quote set!) (quote the-result) val)
|
||||
(list (quote set!) (quote it) val)
|
||||
val)))
|
||||
((= head (quote append!))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 2)))
|
||||
@@ -1648,11 +1740,13 @@
|
||||
(list (quote hs-reset!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote default!))
|
||||
(let
|
||||
((t (hs-to-sx (nth ast 1))) (v (hs-to-sx (nth ast 2))))
|
||||
((tgt-ast (nth ast 1))
|
||||
(read (hs-to-sx (nth ast 1)))
|
||||
(v (hs-to-sx (nth ast 2))))
|
||||
(list
|
||||
(quote when)
|
||||
(list (quote nil?) t)
|
||||
(list (quote set!) t v))))
|
||||
(list (quote hs-default?) read)
|
||||
(emit-set tgt-ast v))))
|
||||
((= head (quote hs-is))
|
||||
(list
|
||||
(quote hs-is)
|
||||
|
||||
@@ -16,6 +16,14 @@
|
||||
(fn
|
||||
(sx)
|
||||
(define vars (list))
|
||||
(define
|
||||
reserved
|
||||
(list
|
||||
(quote me)
|
||||
(quote it)
|
||||
(quote event)
|
||||
(quote you)
|
||||
(quote yourself)))
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
@@ -30,7 +38,9 @@
|
||||
(let
|
||||
((name (nth node 1)))
|
||||
(when
|
||||
(not (some (fn (v) (= v name)) vars))
|
||||
(and
|
||||
(not (some (fn (v) (= v name)) vars))
|
||||
(not (some (fn (v) (= v name)) reserved)))
|
||||
(set! vars (cons name vars)))))
|
||||
(for-each walk node))))
|
||||
(walk sx)
|
||||
@@ -67,9 +77,10 @@
|
||||
(fn
|
||||
(el)
|
||||
(let
|
||||
((src (dom-get-attr el "_")))
|
||||
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
|
||||
(when
|
||||
(and src (not (dom-get-data el "hs-active")))
|
||||
(and src (not (= src prev)))
|
||||
(dom-set-data el "hs-script" src)
|
||||
(dom-set-data el "hs-active" true)
|
||||
(let ((handler (hs-handler src))) (handler el))))))
|
||||
|
||||
@@ -77,6 +88,21 @@
|
||||
;; Called once at page load. Finds all elements with _ attribute,
|
||||
;; compiles their hyperscript, and activates them.
|
||||
|
||||
(define
|
||||
hs-deactivate!
|
||||
(fn
|
||||
(el)
|
||||
(let
|
||||
((unlisteners (or (dom-get-data el "hs-unlisteners") (list))))
|
||||
(for-each (fn (u) (when u (u))) unlisteners)
|
||||
(dom-set-data el "hs-unlisteners" (list))
|
||||
(dom-set-data el "hs-active" false)
|
||||
(dom-set-data el "hs-script" nil))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-boot!
|
||||
(fn
|
||||
@@ -85,10 +111,6 @@
|
||||
((elements (dom-query-all (host-get (host-global "document") "body") "[_]")))
|
||||
(for-each (fn (el) (hs-activate! el)) elements))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-boot-subtree!
|
||||
(fn
|
||||
|
||||
@@ -95,6 +95,13 @@
|
||||
(do (adv!) (list kind (str "." val) (list (quote me)))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list kind (str "#" val) (list (quote me)))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote attr)
|
||||
val
|
||||
(list kind (str "[" val "]") (list (quote me))))))
|
||||
(true (list kind "*" (list (quote me))))))))
|
||||
(define
|
||||
parse-pos-kw
|
||||
@@ -146,8 +153,10 @@
|
||||
(do (adv!) (list (quote me))))
|
||||
((and (= typ "keyword") (= val "I"))
|
||||
(do (adv!) (list (quote me))))
|
||||
((and (= typ "keyword") (or (= val "it") (= val "result")))
|
||||
((and (= typ "keyword") (= val "it"))
|
||||
(do (adv!) (list (quote it))))
|
||||
((and (= typ "keyword") (= val "result"))
|
||||
(do (adv!) (quote the-result)))
|
||||
((and (= typ "keyword") (= val "event"))
|
||||
(do (adv!) (list (quote event))))
|
||||
((and (= typ "keyword") (= val "target"))
|
||||
@@ -174,7 +183,18 @@
|
||||
(do (adv!) (parse-pos-kw (quote last))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list (quote query) (str "#" val))))
|
||||
((= typ "selector") (do (adv!) (list (quote query) val)))
|
||||
((= typ "selector")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote query-scoped)
|
||||
val
|
||||
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(list (quote query) val))))
|
||||
((= typ "attr")
|
||||
(do (adv!) (list (quote attr) val (list (quote me)))))
|
||||
((= typ "style")
|
||||
@@ -426,7 +446,7 @@
|
||||
(list (quote type-check) left type-name)))))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
((right (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
@@ -530,6 +550,14 @@
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi))))))
|
||||
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote type-check) left type-name)))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
@@ -546,6 +574,10 @@
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi)))))
|
||||
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(do (adv!) (list (quote type-check) left type-name))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
@@ -576,7 +608,7 @@
|
||||
(match-kw "case")
|
||||
(list (quote ends-with-ic?) left rhs))
|
||||
(list (quote ends-with?) left rhs)))))
|
||||
((and (= typ "keyword") (= val "matches"))
|
||||
((and (= typ "keyword") (or (= val "matches") (= val "match")))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
@@ -618,7 +650,22 @@
|
||||
(quote as)
|
||||
left
|
||||
(str type-name ":" param)))))
|
||||
(list (quote as) left type-name))))))
|
||||
(let
|
||||
loop
|
||||
((result (list (quote as) left type-name)))
|
||||
(if
|
||||
(and (= (tp-type) "op") (= (tp-val) "|"))
|
||||
(do
|
||||
(adv!)
|
||||
(when
|
||||
(or (= (tp-val) "a") (= (tp-val) "an"))
|
||||
(adv!))
|
||||
(let
|
||||
((next-type (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(loop (list (quote as) result next-type)))))
|
||||
result)))))))
|
||||
((and (= typ "colon"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -693,7 +740,7 @@
|
||||
(list (quote strict-eq) left (parse-expr))))
|
||||
((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes")))
|
||||
(do (adv!) (list (quote contains?) left (parse-expr))))
|
||||
((and (= typ "keyword") (= val "precedes"))
|
||||
((and (= typ "keyword") (or (= val "precedes") (= val "precede")))
|
||||
(do (adv!) (list (quote precedes?) left (parse-atom))))
|
||||
((and (= typ "keyword") (= val "follows"))
|
||||
(do (adv!) (list (quote follows?) left (parse-atom))))
|
||||
@@ -772,7 +819,7 @@
|
||||
(= (tp-val) "starts")
|
||||
(= (tp-val) "ends")
|
||||
(= (tp-val) "contains")
|
||||
(= (tp-val) "matches")
|
||||
(or (= (tp-val) "matches") (= (tp-val) "match"))
|
||||
(= (tp-val) "is")
|
||||
(= (tp-val) "does")
|
||||
(= (tp-val) "in")
|
||||
@@ -892,6 +939,18 @@
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(list (quote set-styles) (reverse pairs) tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
||||
(let
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(list (quote add-attr) attr-name attr-val tgt))))))
|
||||
(true
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
@@ -978,20 +1037,58 @@
|
||||
()
|
||||
(cond
|
||||
((match-kw "between")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls1 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(expect-kw! "and")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls1 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(expect-kw! "and")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil))
|
||||
nil))
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil)))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n1 (get (adv!) "value")))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) "="))
|
||||
(adv!))
|
||||
(let
|
||||
((v1 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(expect-kw! "and")
|
||||
(when (= (tp-type) "bracket-open") (adv!))
|
||||
(let
|
||||
((n2 (get (adv!) "value")))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) "="))
|
||||
(adv!))
|
||||
(let
|
||||
((v2 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
(= n1 n2)
|
||||
(list
|
||||
(quote toggle-attr-between)
|
||||
n1
|
||||
v1
|
||||
v2
|
||||
tgt)
|
||||
(list
|
||||
(quote toggle-attr-diff)
|
||||
n1
|
||||
v1
|
||||
n2
|
||||
v2
|
||||
tgt)))))))))
|
||||
(true nil)))
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls (do (let ((v (tp-val))) (adv!) v))))
|
||||
@@ -1012,38 +1109,67 @@
|
||||
(match-kw "between")
|
||||
(let
|
||||
((val1 (parse-atom)))
|
||||
(expect-kw! "and")
|
||||
(let
|
||||
((val2 (parse-atom)))
|
||||
(do
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(if
|
||||
(match-kw "and")
|
||||
(let
|
||||
((val3 (parse-atom)))
|
||||
(if
|
||||
(match-kw "and")
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "and"))
|
||||
(adv!)
|
||||
nil)
|
||||
(let
|
||||
((val2 (parse-atom)))
|
||||
(if
|
||||
(or
|
||||
(= (tp-type) "comma")
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and")))
|
||||
(do
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and"))
|
||||
(adv!)
|
||||
nil)
|
||||
(let
|
||||
((val4 (parse-atom)))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3
|
||||
val4))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3)))
|
||||
(list
|
||||
(quote toggle-style-between)
|
||||
prop
|
||||
val1
|
||||
val2
|
||||
tgt))))
|
||||
((val3 (parse-atom)))
|
||||
(if
|
||||
(or
|
||||
(= (tp-type) "comma")
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and")))
|
||||
(do
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and"))
|
||||
(adv!)
|
||||
nil)
|
||||
(let
|
||||
((val4 (parse-atom)))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3
|
||||
val4)))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3))))
|
||||
(list
|
||||
(quote toggle-style-between)
|
||||
prop
|
||||
val1
|
||||
val2
|
||||
tgt)))))
|
||||
(list (quote toggle-style) prop tgt)))))
|
||||
((= (tp-type) "attr")
|
||||
(let
|
||||
@@ -1064,6 +1190,18 @@
|
||||
val2
|
||||
tgt)))
|
||||
(list (quote toggle-attr) attr-name tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
||||
(let
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
|
||||
((and (= (tp-type) "keyword") (= (tp-val) "my"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -1338,19 +1476,23 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||
(list (quote hide) tgt strategy)))))
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
||||
(list (quote hide) tgt strategy when-cond))))))
|
||||
(define
|
||||
parse-show-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||
(list (quote show) tgt strategy)))))
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
||||
(list (quote show) tgt strategy when-cond))))))
|
||||
(define
|
||||
parse-transition-cmd
|
||||
(fn
|
||||
@@ -1493,7 +1635,7 @@
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define parse-call-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (list (quote __get-cmd) (parse-expr))))
|
||||
(define
|
||||
parse-take-cmd
|
||||
(fn
|
||||
@@ -1501,12 +1643,34 @@
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls (do (let ((v (tp-val))) (adv!) v))))
|
||||
((classes (list)))
|
||||
(let
|
||||
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
||||
((collect (fn () (when (= (tp-type) "class") (let ((v (tp-val))) (adv!) (set! classes (append classes (list v))) (collect))))))
|
||||
(collect)
|
||||
(let
|
||||
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
||||
(list (quote take!) "class" cls from-sel for-tgt)))))
|
||||
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
||||
(let
|
||||
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
||||
(if
|
||||
(= (len classes) 1)
|
||||
(list
|
||||
(quote take!)
|
||||
"class"
|
||||
(first classes)
|
||||
from-sel
|
||||
for-tgt)
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn
|
||||
(cls)
|
||||
(list
|
||||
(quote take!)
|
||||
"class"
|
||||
cls
|
||||
from-sel
|
||||
for-tgt))
|
||||
classes))))))))
|
||||
((= (tp-type) "attr")
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
@@ -1540,7 +1704,9 @@
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error (str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-first) coll n))))))
|
||||
@@ -1550,7 +1716,9 @@
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error (str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-last) coll n))))))
|
||||
@@ -1558,14 +1726,17 @@
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(or (match-kw "of") (match-kw "from"))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll nil))
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error
|
||||
(str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll n)))))))
|
||||
@@ -1579,7 +1750,10 @@
|
||||
(let
|
||||
((end-expr (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error
|
||||
(str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-items) coll start-expr end-expr))))))))
|
||||
@@ -1588,7 +1762,7 @@
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
((regex (parse-atom)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
@@ -1606,7 +1780,7 @@
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
((regex (parse-atom)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
@@ -1619,10 +1793,26 @@
|
||||
(let
|
||||
((haystack (parse-expr)))
|
||||
(list (quote pick-matches) regex haystack))))))
|
||||
((and (= typ "ident") (= val "item"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n (parse-expr)))
|
||||
(do
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error (str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list
|
||||
(quote pick-items)
|
||||
coll
|
||||
n
|
||||
(list (quote +) n 1)))))))
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected first/last/random/items/match/matches after 'pick' at "
|
||||
"Expected first/last/random/item/items/match/matches after 'pick' at "
|
||||
p)))))))
|
||||
(define
|
||||
parse-go-cmd
|
||||
@@ -1697,7 +1887,7 @@
|
||||
(match-kw "of")
|
||||
(list (make-symbol ".") (parse-expr) val)
|
||||
(cond
|
||||
((= val "result") (list (quote it)))
|
||||
((= val "result") (quote the-result))
|
||||
((= val "first") (parse-pos-kw (quote first)))
|
||||
((= val "last") (parse-pos-kw (quote last)))
|
||||
((= val "closest") (parse-trav (quote closest)))
|
||||
|
||||
@@ -22,7 +22,13 @@
|
||||
;; Stock hyperscript queues by default; "every" disables queuing.
|
||||
(define
|
||||
hs-on
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
(fn
|
||||
(target event-name handler)
|
||||
(let
|
||||
((unlisten (dom-listen target event-name handler))
|
||||
(prev (or (dom-get-data target "hs-unlisteners") (list))))
|
||||
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
|
||||
unlisten)))
|
||||
|
||||
;; Run an initializer function immediately.
|
||||
;; (hs-init thunk) — called at element boot time
|
||||
@@ -88,7 +94,7 @@
|
||||
((or (= prop "display") (= prop "opacity"))
|
||||
(if
|
||||
(or (= cur "none") (= cur "0"))
|
||||
(dom-set-style target prop (if (= prop "opacity") "1" ""))
|
||||
(dom-set-style target prop (if (= prop "opacity") "1" "block"))
|
||||
(dom-set-style target prop (if (= prop "display") "none" "0"))))
|
||||
(true
|
||||
(if
|
||||
@@ -167,6 +173,45 @@
|
||||
(fn
|
||||
(el name val)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(define
|
||||
hs-toggle-attr!
|
||||
(fn
|
||||
(el name)
|
||||
(if
|
||||
(dom-has-attr? el name)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name ""))))
|
||||
(define
|
||||
hs-toggle-attr-val!
|
||||
(fn
|
||||
(el name val)
|
||||
(if
|
||||
(= (dom-get-attr el name) val)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name val))))
|
||||
(define
|
||||
hs-toggle-attr-between!
|
||||
(fn
|
||||
(el name val1 val2)
|
||||
(if
|
||||
(= (dom-get-attr el name) val1)
|
||||
(dom-set-attr el name val2)
|
||||
(dom-set-attr el name val1))))
|
||||
(define
|
||||
hs-toggle-attr-diff!
|
||||
(fn
|
||||
(el n1 v1 n2 v2)
|
||||
(if
|
||||
(dom-has-attr? el n1)
|
||||
(do (dom-remove-attr el n1) (dom-set-attr el n2 v2))
|
||||
(do
|
||||
(when (dom-has-attr? el n2) (dom-remove-attr el n2))
|
||||
(dom-set-attr el n1 v1)))))
|
||||
(define
|
||||
hs-set-inner-html!
|
||||
(fn
|
||||
(target value)
|
||||
(do (dom-set-inner-html target value) (hs-boot-subtree! target))))
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
@@ -407,19 +452,24 @@
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
|
||||
(define
|
||||
hs-query-all-in
|
||||
(fn
|
||||
(sel target)
|
||||
(if
|
||||
(nil? target)
|
||||
(hs-query-all sel)
|
||||
(host-call target "querySelectorAll" sel))))
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
(fn (lst idx val) (map-indexed (fn (i x) (if (= i idx) val x)) lst)))
|
||||
(fn
|
||||
(lst idx val)
|
||||
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
||||
|
||||
(define
|
||||
hs-to-number
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((number? v) v)
|
||||
((string? v) (or (parse-number v) 0))
|
||||
((nil? v) 0)
|
||||
(true (or (parse-number (str v)) 0)))))
|
||||
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
||||
|
||||
(define
|
||||
hs-query-first
|
||||
@@ -490,6 +540,10 @@
|
||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||
(true (hs-repeat-while cond-fn thunk)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-repeat-until
|
||||
(fn
|
||||
@@ -502,10 +556,6 @@
|
||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
@@ -525,27 +575,38 @@
|
||||
((= signal "hs-continue") (do-loop (rest remaining)))
|
||||
(true (do-loop (rest remaining))))))))
|
||||
(do-loop items))))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(begin
|
||||
(define
|
||||
hs-append
|
||||
(fn
|
||||
(target value)
|
||||
(cond
|
||||
((nil? target) value)
|
||||
((string? target) (str target value))
|
||||
((list? target) (append target (list value)))
|
||||
((hs-element? target)
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" (str value))
|
||||
target))
|
||||
(true (str target value)))))
|
||||
(define
|
||||
hs-append!
|
||||
(fn (value target) (dom-insert-adjacent-html target "beforeend" value))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(fn
|
||||
(value target)
|
||||
(cond
|
||||
((nil? target) nil)
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend" (str value)))
|
||||
(true nil)))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format)
|
||||
(perform (list "io-fetch" url (if format format "text")))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-coerce
|
||||
(fn
|
||||
@@ -636,7 +697,24 @@
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
value))
|
||||
(true value))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-default?
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((nil? v) true)
|
||||
((and (string? v) (= v "")) true)
|
||||
(true false))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-array-set!
|
||||
(fn
|
||||
(arr i v)
|
||||
(if (list? arr) (do (set-nth! arr i v) v) (host-set! arr i v))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-add
|
||||
(fn
|
||||
@@ -646,9 +724,7 @@
|
||||
((list? b) (cons a b))
|
||||
((or (string? a) (string? b)) (str a b))
|
||||
(true (+ a b)))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
@@ -659,13 +735,13 @@
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Collection: sorted by descending
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
@@ -678,7 +754,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
;; Collection: sorted by descending
|
||||
|
||||
(define
|
||||
hs-transition-from
|
||||
(fn
|
||||
@@ -692,7 +768,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop (str to-val))
|
||||
(when duration (hs-settle target))))
|
||||
;; Collection: split by
|
||||
|
||||
(define
|
||||
hs-type-check
|
||||
(fn
|
||||
@@ -712,7 +788,7 @@
|
||||
(= (host-typeof value) "element")
|
||||
(= (host-typeof value) "text")))
|
||||
(true (= (host-typeof value) (downcase type-name)))))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-type-check-strict
|
||||
(fn
|
||||
@@ -745,11 +821,26 @@
|
||||
((nil? suffix) false)
|
||||
(true (ends-with? (str s) (str suffix))))))
|
||||
|
||||
(define
|
||||
hs-scoped-set!
|
||||
(fn (el name val) (dom-set-data el (str "hs-local-" name) val)))
|
||||
|
||||
(define
|
||||
hs-scoped-get
|
||||
(fn (el name) (dom-get-data el (str "hs-local-" name))))
|
||||
|
||||
(define
|
||||
hs-precedes?
|
||||
(fn
|
||||
(a b)
|
||||
(cond ((nil? a) false) ((nil? b) false) (true (< (str a) (str b))))))
|
||||
(cond
|
||||
((nil? a) false)
|
||||
((nil? b) false)
|
||||
((and (dict? a) (dict? b))
|
||||
(let
|
||||
((pos (host-call a "compareDocumentPosition" b)))
|
||||
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
|
||||
(true (< (str a) (str b))))))
|
||||
|
||||
(define
|
||||
hs-follows?
|
||||
@@ -840,7 +931,18 @@
|
||||
(= obj (nth r 1))
|
||||
(= obj nil)))))))
|
||||
|
||||
(define precedes? (fn (a b) (< (str a) (str b))))
|
||||
(define
|
||||
precedes?
|
||||
(fn
|
||||
(a b)
|
||||
(cond
|
||||
((nil? a) false)
|
||||
((nil? b) false)
|
||||
((and (dict? a) (dict? b))
|
||||
(let
|
||||
((pos (host-call a "compareDocumentPosition" b)))
|
||||
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
|
||||
(true (< (str a) (str b))))))
|
||||
|
||||
(define
|
||||
hs-empty?
|
||||
@@ -1124,33 +1226,109 @@
|
||||
(host-call el "removeAttribute" "open")
|
||||
(dom-set-prop el "open" false)))))))
|
||||
|
||||
(define
|
||||
hs-hide!
|
||||
(fn
|
||||
(el strategy)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when (dom-has-attr? el "open") (host-call el "close")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" false))
|
||||
((= strategy "opacity") (dom-set-style el "opacity" "0"))
|
||||
((= strategy "visibility") (dom-set-style el "visibility" "hidden"))
|
||||
(true (dom-set-style el "display" "none"))))))
|
||||
(begin
|
||||
(define
|
||||
hs-hide-one!
|
||||
(fn
|
||||
(el strategy)
|
||||
(let
|
||||
((parts (split strategy ":")) (tag (dom-get-prop el "tagName")))
|
||||
(let
|
||||
((prop (first parts))
|
||||
(val (if (> (len parts) 1) (nth parts 1) nil)))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when (dom-has-attr? el "open") (host-call el "close")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" false))
|
||||
((= prop "opacity")
|
||||
(dom-set-style el "opacity" (if val val "0")))
|
||||
((= prop "visibility")
|
||||
(dom-set-style el "visibility" (if val val "hidden")))
|
||||
((= prop "hidden") (dom-set-attr el "hidden" ""))
|
||||
((= prop "twDisplay") (dom-add-class el "hidden"))
|
||||
((= prop "twVisibility") (dom-add-class el "invisible"))
|
||||
((= prop "twOpacity") (dom-add-class el "opacity-0"))
|
||||
(true (dom-set-style el "display" (if val val "none"))))))))
|
||||
(define
|
||||
hs-hide!
|
||||
(fn
|
||||
(target strategy)
|
||||
(if
|
||||
(list? target)
|
||||
(do (for-each (fn (el) (hs-hide-one! el strategy)) target) target)
|
||||
(do (hs-hide-one! target strategy) target)))))
|
||||
|
||||
(begin
|
||||
(define
|
||||
hs-show-one!
|
||||
(fn
|
||||
(el strategy)
|
||||
(let
|
||||
((parts (split strategy ":")) (tag (dom-get-prop el "tagName")))
|
||||
(let
|
||||
((prop (first parts))
|
||||
(val (if (> (len parts) 1) (nth parts 1) nil)))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when
|
||||
(not (dom-has-attr? el "open"))
|
||||
(host-call el "showModal")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" true))
|
||||
((= prop "opacity")
|
||||
(dom-set-style el "opacity" (if val val "1")))
|
||||
((= prop "visibility")
|
||||
(dom-set-style el "visibility" (if val val "visible")))
|
||||
((= prop "hidden") (dom-remove-attr el "hidden"))
|
||||
((= prop "twDisplay") (dom-remove-class el "hidden"))
|
||||
((= prop "twVisibility") (dom-remove-class el "invisible"))
|
||||
((= prop "twOpacity") (dom-remove-class el "opacity-0"))
|
||||
(true (dom-set-style el "display" (if val val "block"))))))))
|
||||
(define
|
||||
hs-show!
|
||||
(fn
|
||||
(target strategy)
|
||||
(if
|
||||
(list? target)
|
||||
(do (for-each (fn (el) (hs-show-one! el strategy)) target) target)
|
||||
(do (hs-show-one! target strategy) target)))))
|
||||
|
||||
(define
|
||||
hs-show!
|
||||
hs-show-when!
|
||||
(fn
|
||||
(el strategy)
|
||||
(target strategy pred)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when (not (dom-has-attr? el "open")) (host-call el "showModal")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" true))
|
||||
((= strategy "opacity") (dom-set-style el "opacity" "1"))
|
||||
((= strategy "visibility") (dom-set-style el "visibility" "visible"))
|
||||
(true (dom-set-style el "display" ""))))))
|
||||
((items (if (list? target) target (list target))))
|
||||
(let
|
||||
((matched (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(el)
|
||||
(if
|
||||
(pred el)
|
||||
(do (hs-show-one! el strategy) (append! matched el))
|
||||
(hs-hide-one! el strategy)))
|
||||
items)
|
||||
matched)))))
|
||||
|
||||
(define
|
||||
hs-hide-when!
|
||||
(fn
|
||||
(target strategy pred)
|
||||
(let
|
||||
((items (if (list? target) target (list target))))
|
||||
(let
|
||||
((matched (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(el)
|
||||
(if
|
||||
(pred el)
|
||||
(do (hs-hide-one! el strategy) (append! matched el))
|
||||
(hs-show-one! el strategy)))
|
||||
items)
|
||||
matched)))))
|
||||
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
|
||||
@@ -1390,7 +1568,7 @@
|
||||
false
|
||||
(let
|
||||
((store (host-get el "__hs_vars")))
|
||||
(if (nil? store) false (has-key? store name))))))
|
||||
(if (nil? store) false (host-call store "hasOwnProperty" name))))))
|
||||
|
||||
(define
|
||||
hs-dom-get-var-raw
|
||||
@@ -1409,7 +1587,7 @@
|
||||
(do
|
||||
(when
|
||||
(nil? (host-get el "__hs_vars"))
|
||||
(host-set! el "__hs_vars" (dict)))
|
||||
(host-set! el "__hs_vars" (host-new "Object")))
|
||||
(host-set! (host-get el "__hs_vars") name val)
|
||||
(when changed (hs-dom-fire-watchers! el name val))))))
|
||||
|
||||
|
||||
@@ -436,6 +436,8 @@
|
||||
(let
|
||||
((ch (hs-cur)) (start pos))
|
||||
(cond
|
||||
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/"))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and
|
||||
@@ -613,6 +615,8 @@
|
||||
(do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!))
|
||||
(= ch ":")
|
||||
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
|
||||
(= ch "|")
|
||||
(do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
|
||||
:else (do (hs-advance! 1) (scan!)))))))
|
||||
(scan!)
|
||||
(hs-emit! "eof" nil pos)
|
||||
|
||||
@@ -85,18 +85,18 @@
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote me))
|
||||
(list (quote dom-set-inner-html) (quote me) value))
|
||||
(list (quote hs-set-inner-html!) (quote me) value))
|
||||
((= th (quote it)) (list (quote set!) (quote it) value))
|
||||
((= th (quote query))
|
||||
(list (quote dom-set-inner-html) (hs-to-sx target) value))
|
||||
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
|
||||
((= th (quote array-index))
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote hs-array-set!)
|
||||
(hs-to-sx (nth target 1))
|
||||
(hs-to-sx (nth target 2))
|
||||
value))
|
||||
((or (= th (quote next)) (= th (quote previous)) (= th (quote closest)))
|
||||
(list (quote dom-set-inner-html) (hs-to-sx target) value))
|
||||
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
|
||||
((= th (quote of))
|
||||
(let
|
||||
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
|
||||
@@ -162,10 +162,19 @@
|
||||
(let
|
||||
((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))
|
||||
(handler
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote event))
|
||||
wrapped-body)))
|
||||
(let
|
||||
((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false)))))
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote event))
|
||||
(if
|
||||
(uses-the-result? wrapped-body)
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list (quote the-result) nil))
|
||||
wrapped-body)
|
||||
wrapped-body)))))
|
||||
(if
|
||||
every?
|
||||
(list
|
||||
@@ -443,9 +452,7 @@
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
(list (quote nth) var-sym (quote __hs-idx))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
@@ -463,10 +470,7 @@
|
||||
((t (hs-to-sx expr)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote +) (list (quote hs-to-number) t) amount)))
|
||||
(list (list (quote __hs-new) (list (quote +) t amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
@@ -564,9 +568,7 @@
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
(list (quote nth) var-sym (quote __hs-idx))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
@@ -584,10 +586,7 @@
|
||||
((t (hs-to-sx expr)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote -) (list (quote hs-to-number) t) amount)))
|
||||
(list (list (quote __hs-new) (list (quote -) t amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
@@ -870,6 +869,11 @@
|
||||
((= head (quote ref)) (make-symbol (nth ast 1)))
|
||||
((= head (quote query))
|
||||
(list (quote hs-query-first) (nth ast 1)))
|
||||
((= head (quote query-scoped))
|
||||
(list
|
||||
(quote hs-query-all-in)
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote attr))
|
||||
(list
|
||||
(quote dom-get-attr)
|
||||
@@ -1163,6 +1167,14 @@
|
||||
(quote set!)
|
||||
(hs-to-sx tgt)
|
||||
(list (quote hs-add-to!) val (hs-to-sx tgt)))))
|
||||
((= head (quote add-attr))
|
||||
(let
|
||||
((tgt (nth ast 3)))
|
||||
(list
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx tgt)
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote remove-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
@@ -1296,6 +1308,20 @@
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote toggle-attr-val))
|
||||
(list
|
||||
(quote hs-toggle-attr-val!)
|
||||
(hs-to-sx (nth ast 3))
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote toggle-attr-diff))
|
||||
(list
|
||||
(quote hs-toggle-attr-diff!)
|
||||
(hs-to-sx (nth ast 5))
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 3)
|
||||
(hs-to-sx (nth ast 4))))
|
||||
((= head (quote set!))
|
||||
(emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
|
||||
((= head (quote put!))
|
||||
@@ -1359,13 +1385,48 @@
|
||||
((= head (quote hide))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 1)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||
(list (quote hs-hide!) tgt strategy)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-hide!) tgt strategy)
|
||||
(list
|
||||
(quote hs-hide-when!)
|
||||
tgt
|
||||
strategy
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx when-cond))))))
|
||||
((= head (quote show))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 1)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||
(list (quote hs-show!) tgt strategy)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-show!) tgt strategy)
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-show-r)
|
||||
(list
|
||||
(quote hs-show-when!)
|
||||
tgt
|
||||
strategy
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx when-cond)))))
|
||||
(list
|
||||
(quote begin)
|
||||
(list
|
||||
(quote set!)
|
||||
(quote the-result)
|
||||
(quote __hs-show-r))
|
||||
(list (quote set!) (quote it) (quote __hs-show-r))
|
||||
(quote __hs-show-r))))))
|
||||
((= head (quote transition)) (emit-transition ast))
|
||||
((= head (quote transition-from))
|
||||
(let
|
||||
@@ -1424,6 +1485,14 @@
|
||||
(list (quote hs-settle) (quote me)))
|
||||
((= head (quote go))
|
||||
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote __get-cmd))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))))
|
||||
(list
|
||||
(quote begin)
|
||||
(list (quote set!) (quote the-result) val)
|
||||
(list (quote set!) (quote it) val)
|
||||
val)))
|
||||
((= head (quote append!))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 2)))
|
||||
@@ -1648,11 +1717,13 @@
|
||||
(list (quote hs-reset!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote default!))
|
||||
(let
|
||||
((t (hs-to-sx (nth ast 1))) (v (hs-to-sx (nth ast 2))))
|
||||
((tgt-ast (nth ast 1))
|
||||
(read (hs-to-sx (nth ast 1)))
|
||||
(v (hs-to-sx (nth ast 2))))
|
||||
(list
|
||||
(quote when)
|
||||
(list (quote nil?) t)
|
||||
(list (quote set!) t v))))
|
||||
(list (quote hs-default?) read)
|
||||
(emit-set tgt-ast v))))
|
||||
((= head (quote hs-is))
|
||||
(list
|
||||
(quote hs-is)
|
||||
|
||||
@@ -16,6 +16,14 @@
|
||||
(fn
|
||||
(sx)
|
||||
(define vars (list))
|
||||
(define
|
||||
reserved
|
||||
(list
|
||||
(quote me)
|
||||
(quote it)
|
||||
(quote event)
|
||||
(quote you)
|
||||
(quote yourself)))
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
@@ -30,7 +38,9 @@
|
||||
(let
|
||||
((name (nth node 1)))
|
||||
(when
|
||||
(not (some (fn (v) (= v name)) vars))
|
||||
(and
|
||||
(not (some (fn (v) (= v name)) vars))
|
||||
(not (some (fn (v) (= v name)) reserved)))
|
||||
(set! vars (cons name vars)))))
|
||||
(for-each walk node))))
|
||||
(walk sx)
|
||||
|
||||
@@ -95,6 +95,13 @@
|
||||
(do (adv!) (list kind (str "." val) (list (quote me)))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list kind (str "#" val) (list (quote me)))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote attr)
|
||||
val
|
||||
(list kind (str "[" val "]") (list (quote me))))))
|
||||
(true (list kind "*" (list (quote me))))))))
|
||||
(define
|
||||
parse-pos-kw
|
||||
@@ -146,8 +153,10 @@
|
||||
(do (adv!) (list (quote me))))
|
||||
((and (= typ "keyword") (= val "I"))
|
||||
(do (adv!) (list (quote me))))
|
||||
((and (= typ "keyword") (or (= val "it") (= val "result")))
|
||||
((and (= typ "keyword") (= val "it"))
|
||||
(do (adv!) (list (quote it))))
|
||||
((and (= typ "keyword") (= val "result"))
|
||||
(do (adv!) (quote the-result)))
|
||||
((and (= typ "keyword") (= val "event"))
|
||||
(do (adv!) (list (quote event))))
|
||||
((and (= typ "keyword") (= val "target"))
|
||||
@@ -174,7 +183,18 @@
|
||||
(do (adv!) (parse-pos-kw (quote last))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list (quote query) (str "#" val))))
|
||||
((= typ "selector") (do (adv!) (list (quote query) val)))
|
||||
((= typ "selector")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote query-scoped)
|
||||
val
|
||||
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(list (quote query) val))))
|
||||
((= typ "attr")
|
||||
(do (adv!) (list (quote attr) val (list (quote me)))))
|
||||
((= typ "style")
|
||||
@@ -426,7 +446,7 @@
|
||||
(list (quote type-check) left type-name)))))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
((right (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
@@ -892,6 +912,18 @@
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(list (quote set-styles) (reverse pairs) tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
||||
(let
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(list (quote add-attr) attr-name attr-val tgt))))))
|
||||
(true
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
@@ -978,20 +1010,58 @@
|
||||
()
|
||||
(cond
|
||||
((match-kw "between")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls1 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(expect-kw! "and")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls1 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(expect-kw! "and")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil))
|
||||
nil))
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil)))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n1 (get (adv!) "value")))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) "="))
|
||||
(adv!))
|
||||
(let
|
||||
((v1 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(expect-kw! "and")
|
||||
(when (= (tp-type) "bracket-open") (adv!))
|
||||
(let
|
||||
((n2 (get (adv!) "value")))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) "="))
|
||||
(adv!))
|
||||
(let
|
||||
((v2 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
(= n1 n2)
|
||||
(list
|
||||
(quote toggle-attr-between)
|
||||
n1
|
||||
v1
|
||||
v2
|
||||
tgt)
|
||||
(list
|
||||
(quote toggle-attr-diff)
|
||||
n1
|
||||
v1
|
||||
n2
|
||||
v2
|
||||
tgt)))))))))
|
||||
(true nil)))
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls (do (let ((v (tp-val))) (adv!) v))))
|
||||
@@ -1064,6 +1134,18 @@
|
||||
val2
|
||||
tgt)))
|
||||
(list (quote toggle-attr) attr-name tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
||||
(let
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
|
||||
((and (= (tp-type) "keyword") (= (tp-val) "my"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -1338,19 +1420,23 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||
(list (quote hide) tgt strategy)))))
|
||||
(let
|
||||
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
||||
(list (quote hide) tgt strategy when-cond))))))
|
||||
(define
|
||||
parse-show-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||
(list (quote show) tgt strategy)))))
|
||||
(let
|
||||
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
||||
(list (quote show) tgt strategy when-cond))))))
|
||||
(define
|
||||
parse-transition-cmd
|
||||
(fn
|
||||
@@ -1493,7 +1579,7 @@
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define parse-call-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (list (quote __get-cmd) (parse-expr))))
|
||||
(define
|
||||
parse-take-cmd
|
||||
(fn
|
||||
@@ -1501,12 +1587,34 @@
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls (do (let ((v (tp-val))) (adv!) v))))
|
||||
((classes (list)))
|
||||
(let
|
||||
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
||||
((collect (fn () (when (= (tp-type) "class") (let ((v (tp-val))) (adv!) (set! classes (append classes (list v))) (collect))))))
|
||||
(collect)
|
||||
(let
|
||||
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
||||
(list (quote take!) "class" cls from-sel for-tgt)))))
|
||||
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
||||
(let
|
||||
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
||||
(if
|
||||
(= (len classes) 1)
|
||||
(list
|
||||
(quote take!)
|
||||
"class"
|
||||
(first classes)
|
||||
from-sel
|
||||
for-tgt)
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn
|
||||
(cls)
|
||||
(list
|
||||
(quote take!)
|
||||
"class"
|
||||
cls
|
||||
from-sel
|
||||
for-tgt))
|
||||
classes))))))))
|
||||
((= (tp-type) "attr")
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
@@ -1588,7 +1696,7 @@
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
((regex (parse-atom)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
@@ -1606,7 +1714,7 @@
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
((regex (parse-atom)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
@@ -1697,7 +1805,7 @@
|
||||
(match-kw "of")
|
||||
(list (make-symbol ".") (parse-expr) val)
|
||||
(cond
|
||||
((= val "result") (list (quote it)))
|
||||
((= val "result") (quote the-result))
|
||||
((= val "first") (parse-pos-kw (quote first)))
|
||||
((= val "last") (parse-pos-kw (quote last)))
|
||||
((= val "closest") (parse-trav (quote closest)))
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -18,11 +18,18 @@
|
||||
;; 1. Test framework macros
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defmacro deftest (name &rest body)
|
||||
`(let ((result (try-call (fn () ,@body))))
|
||||
(if (get result "ok")
|
||||
(report-pass ,name)
|
||||
(report-fail ,name (get result "error")))))
|
||||
(defmacro
|
||||
deftest
|
||||
(name &rest body)
|
||||
(quasiquote
|
||||
(when
|
||||
(test-allowed? (unquote name))
|
||||
(let
|
||||
((result (try-call (fn () (splice-unquote body)))))
|
||||
(if
|
||||
(get result "ok")
|
||||
(report-pass (unquote name))
|
||||
(report-fail (unquote name) (get result "error")))))))
|
||||
|
||||
(defmacro defsuite (name &rest items)
|
||||
`(do (push-suite ,name)
|
||||
|
||||
@@ -4,7 +4,9 @@
|
||||
"put into #id compiled"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "on click put \"foo\" into #d1")))
|
||||
(assert= (serialize sx) "SHOW")))
|
||||
(assert=
|
||||
(serialize sx)
|
||||
"(hs-on me \"click\" (fn (event) (hs-set-inner-html! (hs-query-first \"#d1\") \"foo\")))")))
|
||||
(deftest
|
||||
"put into #id works"
|
||||
(let
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -40,7 +40,7 @@
|
||||
"set attribute"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "set @title to 'hello'")))
|
||||
(assert= (quote dom-set-attr) (first sx))
|
||||
(assert= (quote hs-set-attr!) (first sx))
|
||||
(assert= "title" (nth sx 2))
|
||||
(assert= "hello" (nth sx 3))))
|
||||
(deftest
|
||||
@@ -284,12 +284,16 @@
|
||||
"increment attribute"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "increment @count")))
|
||||
(assert= (quote dom-set-attr) (first sx))))
|
||||
(assert= (quote let) (first sx))
|
||||
(assert= (quote do) (first (nth sx 2)))
|
||||
(assert= (quote dom-set-attr) (first (nth (nth sx 2) 1)))))
|
||||
(deftest
|
||||
"decrement attribute"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "decrement @count")))
|
||||
(assert= (quote dom-set-attr) (first sx)))))
|
||||
(assert= (quote let) (first sx))
|
||||
(assert= (quote do) (first (nth sx 2)))
|
||||
(assert= (quote dom-set-attr) (first (nth (nth sx 2) 1))))))
|
||||
|
||||
(defsuite
|
||||
"hs-live-demo-toggle"
|
||||
|
||||
@@ -59,44 +59,73 @@
|
||||
)
|
||||
|
||||
;; ── collectionExpressions (12 tests) ──
|
||||
(defsuite "hs-dev-collectionExpressions"
|
||||
(deftest "filters an array by condition"
|
||||
(let ((result (eval-hs "set arr to [{name: \"a\", active: true}, {name: \"b\", active: false}, {name: \"c\", active: true}] then return arr where its active")))
|
||||
(defsuite
|
||||
"hs-dev-collectionExpressions"
|
||||
(deftest
|
||||
"filters an array by condition"
|
||||
(let
|
||||
((result (eval-hs "set arr to [{name: \"a\", active: true}, {name: \"b\", active: false}, {name: \"c\", active: true}] then return arr where its active")))
|
||||
(assert= (list "a" "c") (map (fn (x) (get x "name")) result))))
|
||||
(deftest "filters with comparison"
|
||||
(assert= (list 4 5) (eval-hs "set arr to [1, 2, 3, 4, 5] then return arr where it > 3"))
|
||||
)
|
||||
(deftest "sorts by a property"
|
||||
(let ((result (eval-hs "set arr to [{name: \"Charlie\"}, {name: \"Alice\"}, {name: \"Bob\"}] then return arr sorted by its name")))
|
||||
(assert= (list "Alice" "Bob" "Charlie") (map (fn (x) (get x "name")) result))))
|
||||
(deftest "sorts descending"
|
||||
(assert= (list 3 2 1) (eval-hs "set arr to [3, 1, 2] then return arr sorted by it descending"))
|
||||
)
|
||||
(deftest "sorts numbers by a computed key"
|
||||
(let ((result (eval-hs "set arr to [{name: \"b\", age: 30}, {name: \"a\", age: 20}, {name: \"c\", age: 25}] then return arr sorted by its age")))
|
||||
(deftest
|
||||
"filters with comparison"
|
||||
(assert=
|
||||
(list 4 5)
|
||||
(eval-hs "set arr to [1, 2, 3, 4, 5] then return arr where it > 3")))
|
||||
(deftest
|
||||
"sorts by a property"
|
||||
(let
|
||||
((result (eval-hs "set arr to [{name: \"Charlie\"}, {name: \"Alice\"}, {name: \"Bob\"}] then return arr sorted by its name")))
|
||||
(assert=
|
||||
(list "Alice" "Bob" "Charlie")
|
||||
(map (fn (x) (get x "name")) result))))
|
||||
(deftest
|
||||
"sorts descending"
|
||||
(assert=
|
||||
(list 3 2 1)
|
||||
(eval-hs "set arr to [3, 1, 2] then return arr sorted by it descending")))
|
||||
(deftest
|
||||
"sorts numbers by a computed key"
|
||||
(let
|
||||
((result (eval-hs "set arr to [{name: \"b\", age: 30}, {name: \"a\", age: 20}, {name: \"c\", age: 25}] then return arr sorted by its age")))
|
||||
(assert= (list "a" "c" "b") (map (fn (x) (get x "name")) result))))
|
||||
(deftest "maps to a property"
|
||||
(assert= (list "Alice" "Bob") (eval-hs "set arr to [{name: \"Alice\"}, {name: \"Bob\"}] then return arr mapped to its name"))
|
||||
)
|
||||
(deftest "maps with an expression"
|
||||
(assert= (list 2 4 6) (eval-hs "set arr to [1, 2, 3] then return arr mapped to (it * 2)"))
|
||||
)
|
||||
(deftest "where then mapped to"
|
||||
(assert= (list "Alice" "Charlie") (eval-hs "set arr to [{name: \"Alice\", active: true}, {name: \"Bob\", active: false}, {name: \"Charlie\", active: true}] then return arr where its active mapped to its name"))
|
||||
)
|
||||
(deftest "sorted by then mapped to"
|
||||
(assert= (list "Alice" "Charlie") (eval-hs "set arr to [{name: \"Charlie\", age: 30}, {name: \"Alice\", age: 20}] then return arr sorted by its age mapped to its name"))
|
||||
)
|
||||
(deftest "where then sorted by then mapped to"
|
||||
(assert= (list "Bob" "Charlie") (eval-hs "set arr to [{name: \"Charlie\", active: true, age: 30}, {name: \"Alice\", active: false, age: 20}, {name: \"Bob\", active: true, age: 25}] then return arr where its active sorted by its age mapped to its name"))
|
||||
)
|
||||
(deftest "the result inside where refers to previous command result, not current element"
|
||||
(assert= (list 4 5) (eval-hs "get 3 then set arr to [1, 2, 3, 4, 5] then return arr where it > the result"))
|
||||
)
|
||||
(deftest "where binds after property access"
|
||||
(assert= (list 3 4) (eval-hs "obj.items where it > 2"))
|
||||
)
|
||||
)
|
||||
(deftest
|
||||
"maps to a property"
|
||||
(assert=
|
||||
(list "Alice" "Bob")
|
||||
(eval-hs
|
||||
"set arr to [{name: \"Alice\"}, {name: \"Bob\"}] then return arr mapped to its name")))
|
||||
(deftest
|
||||
"maps with an expression"
|
||||
(assert=
|
||||
(list 2 4 6)
|
||||
(eval-hs "set arr to [1, 2, 3] then return arr mapped to (it * 2)")))
|
||||
(deftest
|
||||
"where then mapped to"
|
||||
(assert=
|
||||
(list "Alice" "Charlie")
|
||||
(eval-hs
|
||||
"set arr to [{name: \"Alice\", active: true}, {name: \"Bob\", active: false}, {name: \"Charlie\", active: true}] then return arr where its active mapped to its name")))
|
||||
(deftest
|
||||
"sorted by then mapped to"
|
||||
(assert=
|
||||
(list "Alice" "Charlie")
|
||||
(eval-hs
|
||||
"set arr to [{name: \"Charlie\", age: 30}, {name: \"Alice\", age: 20}] then return arr sorted by its age mapped to its name")))
|
||||
(deftest
|
||||
"where then sorted by then mapped to"
|
||||
(assert=
|
||||
(list "Bob" "Charlie")
|
||||
(eval-hs
|
||||
"set arr to [{name: \"Charlie\", active: true, age: 30}, {name: \"Alice\", active: false, age: 20}, {name: \"Bob\", active: true, age: 25}] then return arr where its active sorted by its age mapped to its name")))
|
||||
(deftest
|
||||
"the result inside where refers to previous command result, not current element"
|
||||
(assert=
|
||||
(list 4 5)
|
||||
(eval-hs
|
||||
"get 3 then set arr to [1, 2, 3, 4, 5] then return arr where it > the result")))
|
||||
(deftest
|
||||
"where binds after property access"
|
||||
(assert= (list 3 4) (eval-hs "obj.items where it > 2" {:locals {:obj {:items (list 1 2 3 4)}}}))))
|
||||
|
||||
;; ── splitJoin (7 tests) ──
|
||||
(defsuite "hs-dev-splitJoin"
|
||||
|
||||
@@ -302,7 +302,7 @@
|
||||
(let
|
||||
((ast (hs-compile "if result is empty add .hidden end")))
|
||||
(assert= (quote if) (first ast))
|
||||
(assert= (list (quote empty?) (list (quote it))) (nth ast 1))))
|
||||
(assert= (list (quote empty?) (quote the-result)) (nth ast 1))))
|
||||
(deftest
|
||||
"comparison is not"
|
||||
(let
|
||||
@@ -375,7 +375,7 @@
|
||||
(let
|
||||
((ast (hs-compile "call alert(\"hello\")")))
|
||||
(assert= (quote call) (first ast))
|
||||
(assert= "alert" (nth ast 1))
|
||||
(assert= (list (quote ref) "alert") (nth ast 1))
|
||||
(assert= "hello" (nth ast 2)))))
|
||||
|
||||
;; ── Full expressions (matching tokenizer conformance) ─────────────
|
||||
@@ -462,7 +462,7 @@
|
||||
"the as article skip"
|
||||
(let
|
||||
((ast (hs-compile "set the result to 5")))
|
||||
(let ((tgt (nth ast 1))) (assert= (quote it) (first tgt))))))
|
||||
(let ((tgt (nth ast 1))) (assert= (quote the-result) tgt)))))
|
||||
|
||||
(defsuite
|
||||
"hs-parse-as-conversion"
|
||||
|
||||
361
tests/hs-run-filtered.js
Executable file
361
tests/hs-run-filtered.js
Executable file
@@ -0,0 +1,361 @@
|
||||
#!/usr/bin/env node
|
||||
/**
|
||||
* Run HS behavioral tests — single process, synchronous, with step-limit timeout.
|
||||
* Uses the OCaml VM's built-in step_limit to break infinite loops.
|
||||
*/
|
||||
const fs = require('fs');
|
||||
const path = require('path');
|
||||
|
||||
const PROJECT = path.resolve(__dirname, '..');
|
||||
const WASM_DIR = path.join(PROJECT, 'shared/static/wasm');
|
||||
const SX_DIR = path.join(WASM_DIR, 'sx');
|
||||
|
||||
// Load WASM kernel
|
||||
eval(fs.readFileSync(path.join(WASM_DIR, 'sx_browser.bc.js'), 'utf8'));
|
||||
const K = globalThis.SxKernel;
|
||||
|
||||
// Step limit API — exposed from OCaml kernel
|
||||
const STEP_LIMIT = parseInt(process.env.HS_STEP_LIMIT || '200000');
|
||||
|
||||
function setStepLimit(n) { K.setStepLimit(n); }
|
||||
function resetStepCount() { K.resetStepCount(); }
|
||||
|
||||
// ─── DOM mock ──────────────────────────────────────────────────
|
||||
function mkStyle() { const s={}; s.setProperty=function(p,v){s[p]=v;}; s.getPropertyValue=function(p){return s[p]||'';}; s.removeProperty=function(p){delete s[p];}; return s; }
|
||||
class El {
|
||||
constructor(t) { this.tagName=t.toUpperCase(); this.nodeName=this.tagName; this.nodeType=1; this.id=''; this.className=''; this.classList=new CL(this); this.style=mkStyle(); this.attributes={}; this.children=[]; this.childNodes=[]; this.childNodes.item=function(i){return this[i]||null;}; this.parentElement=null; this.parentNode=null; this.textContent=''; this.innerHTML=''; this._listeners={}; this.dataset={}; this.open=false; this.value=''; this.checked=false; this.disabled=false; this.type=''; this.name=''; this.selectedIndex=-1; this.options=[]; }
|
||||
setAttribute(n,v) { this.attributes[n]=String(v); if(n==='id')this.id=v; if(n==='class'){this.className=v;this.classList._sync(v);} if(n==='value')this.value=v; if(n==='disabled')this.disabled=true; if(n==='style'){const s=String(v);for(const d of s.split(';')){const c=d.indexOf(':');if(c>0){const k=d.slice(0,c).trim();const val=d.slice(c+1).trim();if(k)this.style.setProperty(k,val);}} } }
|
||||
getAttribute(n) { return this.attributes[n]!==undefined?this.attributes[n]:null; }
|
||||
removeAttribute(n) { delete this.attributes[n]; if(n==='disabled')this.disabled=false; }
|
||||
hasAttribute(n) { return n in this.attributes; }
|
||||
addEventListener(e,f) { if(!this._listeners[e])this._listeners[e]=[]; this._listeners[e].push(f); }
|
||||
removeEventListener(e,f) { if(this._listeners[e])this._listeners[e]=this._listeners[e].filter(x=>x!==f); }
|
||||
dispatchEvent(ev) { ev.target=ev.target||this; ev.currentTarget=this; const fns=[...(this._listeners[ev.type]||[])]; for(const f of fns){if(ev._si)break;try{f.call(this,ev);}catch(e){}} if(ev.bubbles&&!ev._sp&&this.parentElement){this.parentElement.dispatchEvent(ev);} return !ev.defaultPrevented; }
|
||||
appendChild(c) { if(c.parentElement)c.parentElement.removeChild(c); c.parentElement=this; c.parentNode=this; this.children.push(c); this.childNodes.push(c); this._syncText(); return c; }
|
||||
removeChild(c) { this.children=this.children.filter(x=>x!==c); this.childNodes=this.childNodes.filter(x=>x!==c); c.parentElement=null; c.parentNode=null; this._syncText(); return c; }
|
||||
insertBefore(n,r) { if(n.parentElement)n.parentElement.removeChild(n); const i=this.children.indexOf(r); if(i>=0){this.children.splice(i,0,n);this.childNodes.splice(i,0,n);}else{this.children.push(n);this.childNodes.push(n);} n.parentElement=this;n.parentNode=this; this._syncText(); return n; }
|
||||
replaceChild(n,o) { const i=this.children.indexOf(o); if(i>=0){this.children[i]=n;this.childNodes[i]=n;} n.parentElement=this;n.parentNode=this; o.parentElement=null;o.parentNode=null; this._syncText(); return o; }
|
||||
querySelector(s) { return fnd(this,s); }
|
||||
querySelectorAll(s) { return fndAll(this,s); }
|
||||
closest(s) { let e=this; while(e){if(mt(e,s))return e; e=e.parentElement;} return null; }
|
||||
matches(s) { return mt(this,s); }
|
||||
contains(o) { if(o===this)return true; for(const c of this.children)if(c===o||c.contains(o))return true; return false; }
|
||||
cloneNode(d) { const e=new El(this.tagName.toLowerCase()); Object.assign(e.attributes,this.attributes); e.id=this.id; e.className=this.className; e.classList._sync(this.className); for(const k of Object.keys(this.style)){if(typeof this.style[k]!=='function')e.style[k]=this.style[k];} e.textContent=this.textContent; e.innerHTML=this.innerHTML; e.value=this.value; if(d)for(const c of this.children)e.appendChild(c.cloneNode(true)); return e; }
|
||||
focus(){} blur(){} click(){this.dispatchEvent(new Ev('click',{bubbles:true}));} remove(){if(this.parentElement)this.parentElement.removeChild(this);}
|
||||
_syncText() {
|
||||
// Sync textContent from children
|
||||
const t = this.children.map(c => c.textContent || '').join('');
|
||||
if (t) this.textContent = t;
|
||||
}
|
||||
_setInnerHTML(html) {
|
||||
// Clear children
|
||||
for (const c of this.children) { c.parentElement = null; c.parentNode = null; }
|
||||
this.children = []; this.childNodes = [];
|
||||
this.innerHTML = html;
|
||||
// Parse simple HTML and add children
|
||||
if (html) {
|
||||
const parsed = parseHTMLFragments(html);
|
||||
for (const c of parsed) this.appendChild(c);
|
||||
this.textContent = this.children.map(c => c.textContent || '').join('') || html.replace(/<[^>]*>/g, '');
|
||||
} else {
|
||||
this.textContent = '';
|
||||
}
|
||||
}
|
||||
get firstElementChild() { return this.children[0]||null; }
|
||||
get lastElementChild() { return this.children[this.children.length-1]||null; }
|
||||
get nextElementSibling() { if(!this.parentElement)return null; const i=this.parentElement.children.indexOf(this); return this.parentElement.children[i+1]||null; }
|
||||
get previousElementSibling() { if(!this.parentElement)return null; const i=this.parentElement.children.indexOf(this); return i>0?this.parentElement.children[i-1]:null; }
|
||||
showModal(){this.open=true;this.setAttribute('open','');} show(){this.open=true;} close(){this.open=false;this.removeAttribute('open');}
|
||||
getAnimations(){return [];} getBoundingClientRect(){return{top:0,left:0,width:100,height:100,right:100,bottom:100};} scrollIntoView(){}
|
||||
get ownerDocument() { return document; }
|
||||
get offsetParent() { return this.parentElement; }
|
||||
get offsetTop() { return 0; } get offsetLeft() { return 0; }
|
||||
get scrollTop() { return 0; } set scrollTop(v) {} get scrollLeft() { return 0; } set scrollLeft(v) {}
|
||||
get scrollHeight() { return 100; } get scrollWidth() { return 100; }
|
||||
get clientHeight() { return 100; } get clientWidth() { return 100; }
|
||||
insertAdjacentHTML(pos, html) {
|
||||
// For non-HTML content (plain text/numbers), just append to innerHTML
|
||||
if (typeof html !== 'string') html = String(html);
|
||||
if (pos === 'beforeend' || pos === 'beforeEnd') {
|
||||
this.innerHTML = (this.innerHTML || '') + html;
|
||||
this.textContent = (this.textContent || '') + html.replace(/<[^>]*>/g, '');
|
||||
} else if (pos === 'afterbegin' || pos === 'afterBegin') {
|
||||
this.innerHTML = html + (this.innerHTML || '');
|
||||
this.textContent = html.replace(/<[^>]*>/g, '') + (this.textContent || '');
|
||||
} else if (pos === 'beforebegin' || pos === 'beforeBegin') {
|
||||
if (this.parentElement) { this.parentElement.insertAdjacentHTML('beforeend', html); }
|
||||
} else if (pos === 'afterend' || pos === 'afterEnd') {
|
||||
if (this.parentElement) { this.parentElement.insertAdjacentHTML('beforeend', html); }
|
||||
}
|
||||
}
|
||||
}
|
||||
class CL { constructor(e){this._el=e;this._set=new Set();} _sync(str){this._set=new Set((str||'').split(/\s+/).filter(Boolean));} add(...c){for(const x of c)this._set.add(x);this._el.className=[...this._set].join(' ');this._el.attributes['class']=this._el.className;} remove(...c){for(const x of c)this._set.delete(x);this._el.className=[...this._set].join(' ');this._el.attributes['class']=this._el.className;} toggle(c,f){if(f!==undefined){if(f)this.add(c);else this.remove(c);return f;} if(this._set.has(c)){this.remove(c);return false;}else{this.add(c);return true;}} contains(c){return this._set.has(c);} get length(){return this._set.size;} [Symbol.iterator](){return this._set[Symbol.iterator]();} }
|
||||
class Ev { constructor(t,o={}){this.type=t;this.bubbles=o.bubbles||false;this.cancelable=o.cancelable!==false;this.defaultPrevented=false;this._sp=false;this._si=false;this.target=null;this.currentTarget=null;this.detail=o.detail||null;} preventDefault(){this.defaultPrevented=true;} stopPropagation(){this._sp=true;} stopImmediatePropagation(){this._sp=true;this._si=true;} }
|
||||
|
||||
function parseHTMLFragments(html) {
|
||||
const results = [];
|
||||
const re = /<(\w+)([^>]*?)(?:\/>|>([\s\S]*?)<\/\1>)/g;
|
||||
let m;
|
||||
let lastIndex = 0;
|
||||
while ((m = re.exec(html)) !== null) {
|
||||
// Text before this tag
|
||||
if (m.index > lastIndex) {
|
||||
const text = html.slice(lastIndex, m.index).trim();
|
||||
if (text) {
|
||||
const tn = {nodeType:3, textContent:text, data:text};
|
||||
// Can't push text nodes directly to El children; wrap if needed
|
||||
}
|
||||
}
|
||||
const tag = m[1]; const attrs = m[2]; const inner = m[3] || '';
|
||||
const el = new El(tag);
|
||||
const attrRe = /([\w-]+)="([^"]*)"/g; let am;
|
||||
while ((am = attrRe.exec(attrs))) el.setAttribute(am[1], am[2]);
|
||||
// Also handle boolean attrs like disabled
|
||||
const boolRe = /\s(\w+)(?=\s|\/|>|$)/g;
|
||||
if (inner) {
|
||||
// Recursively parse inner HTML
|
||||
const innerEls = parseHTMLFragments(inner);
|
||||
if (innerEls.length > 0) {
|
||||
for (const c of innerEls) el.appendChild(c);
|
||||
el.textContent = innerEls.map(c => c.textContent || '').join('');
|
||||
} else {
|
||||
el.textContent = inner;
|
||||
}
|
||||
el.innerHTML = inner;
|
||||
}
|
||||
results.push(el);
|
||||
lastIndex = re.lastIndex;
|
||||
}
|
||||
// If no tags found, treat as text — create a span with textContent
|
||||
if (results.length === 0 && html.trim()) {
|
||||
const el = new El('span');
|
||||
el.textContent = html.replace(/<[^>]*>/g, '');
|
||||
el.innerHTML = html;
|
||||
results.push(el);
|
||||
}
|
||||
return results;
|
||||
}
|
||||
|
||||
function mt(e,s) {
|
||||
if(!e||!e.tagName)return false;
|
||||
s = s.trim();
|
||||
if(s.startsWith('#'))return e.id===s.slice(1);
|
||||
if(s.startsWith('.'))return e.classList.contains(s.slice(1));
|
||||
if(s.startsWith('[')) {
|
||||
const m = s.match(/^\[([^\]=]+)(?:="([^"]*)")?\]$/);
|
||||
if(m) return m[2] !== undefined ? e.getAttribute(m[1]) === m[2] : e.hasAttribute(m[1]);
|
||||
}
|
||||
if(s.includes('.')) { const [tag, cls] = s.split('.'); return e.tagName.toLowerCase() === tag && e.classList.contains(cls); }
|
||||
if(s.includes('#')) { const [tag, id] = s.split('#'); return e.tagName.toLowerCase() === tag && e.id === id; }
|
||||
return e.tagName.toLowerCase() === s.toLowerCase();
|
||||
}
|
||||
function fnd(e,s) { for(const c of(e.children||[])){if(mt(c,s))return c;const f=fnd(c,s);if(f)return f;} return null; }
|
||||
function fndAll(e,s) { const r=[];for(const c of(e.children||[])){if(mt(c,s))r.push(c);r.push(...fndAll(c,s));}r.item=function(i){return r[i]||null;};return r; }
|
||||
|
||||
const _body = new El('body');
|
||||
const _html = new El('html');
|
||||
_html.appendChild(_body);
|
||||
const document = {
|
||||
body: _body, documentElement: _html,
|
||||
createElement(t){return new El(t);}, createElementNS(n,t){return new El(t);},
|
||||
createDocumentFragment(){const f=new El('fragment');f.nodeType=11;return f;},
|
||||
createTextNode(t){return{nodeType:3,textContent:t,data:t};},
|
||||
getElementById(i){return fnd(_body,'#'+i);},
|
||||
querySelector(s){return fnd(_body,s);}, querySelectorAll(s){return fndAll(_body,s);},
|
||||
createEvent(t){return new Ev(t);}, addEventListener(){}, removeEventListener(){},
|
||||
};
|
||||
globalThis.document=document; globalThis.window=globalThis; globalThis.HTMLElement=El; globalThis.Element=El;
|
||||
globalThis.Event=Ev; globalThis.CustomEvent=Ev; globalThis.NodeList=Array; globalThis.HTMLCollection=Array;
|
||||
globalThis.getComputedStyle=(e)=>e?e.style:{}; globalThis.requestAnimationFrame=(f)=>{f();return 0;};
|
||||
globalThis.cancelAnimationFrame=()=>{}; globalThis.MutationObserver=class{observe(){}disconnect(){}};
|
||||
globalThis.ResizeObserver=class{observe(){}disconnect(){}}; globalThis.IntersectionObserver=class{observe(){}disconnect(){}};
|
||||
globalThis.navigator={userAgent:'node'}; globalThis.location={href:'http://localhost/',pathname:'/',search:'',hash:''};
|
||||
globalThis.history={pushState(){},replaceState(){},back(){},forward(){}};
|
||||
const _origLog = console.log;
|
||||
globalThis.console = { log: () => {}, error: () => {}, warn: () => {}, info: () => {}, debug: () => {} }; // suppress ALL console noise
|
||||
const _log = _origLog; // keep reference for our own output
|
||||
|
||||
// ─── FFI ────────────────────────────────────────────────────────
|
||||
K.registerNative('host-global',a=>{const n=a[0];return(n in globalThis)?globalThis[n]:null;});
|
||||
K.registerNative('host-get',a=>{if(a[0]==null)return null;let v=a[0][a[1]];if(v===undefined)return null;if((a[1]==='innerHTML'||a[1]==='textContent'||a[1]==='value'||a[1]==='className')&&typeof v!=='string')v=String(v!=null?v:'');return v;});
|
||||
K.registerNative('host-set!',a=>{if(a[0]!=null){const v=a[2]; if(a[1]==='innerHTML'&&a[0] instanceof El){const s=String(v!=null?v:'');a[0]._setInnerHTML(s);a[0][a[1]]=a[0].innerHTML;} else if(a[1]==='textContent'&&a[0] instanceof El){const s=String(v!=null?v:'');a[0].textContent=s;a[0].innerHTML=s;for(const c of a[0].children){c.parentElement=null;c.parentNode=null;}a[0].children=[];a[0].childNodes=[];} else{a[0][a[1]]=v;}} return a[2];});
|
||||
K.registerNative('host-call',a=>{if(_testDeadline&&Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const[o,m,...r]=a;if(o==null){const f=globalThis[m];return typeof f==='function'?f.apply(null,r):null;}if(o&&typeof o[m]==='function'){try{const v=o[m].apply(o,r);return v===undefined?null:v;}catch(e){return null;}}return null;});
|
||||
K.registerNative('host-new',a=>{const C=typeof a[0]==='string'?globalThis[a[0]]:a[0];return typeof C==='function'?new C(...a.slice(1)):null;});
|
||||
K.registerNative('host-callback',a=>{const fn=a[0];if(typeof fn==='function'&&fn.__sx_handle===undefined)return fn;if(fn&&fn.__sx_handle!==undefined)return function(){const r=K.callFn(fn,Array.from(arguments));if(globalThis._driveAsync)globalThis._driveAsync(r);return r;};return function(){};});
|
||||
K.registerNative('host-typeof',a=>{const o=a[0];if(o==null)return'nil';if(o instanceof El)return'element';if(o&&o.nodeType===3)return'text';if(o instanceof Ev)return'event';if(o instanceof Promise)return'promise';return typeof o;});
|
||||
K.registerNative('host-await',a=>{});
|
||||
K.registerNative('load-library!',()=>false);
|
||||
|
||||
let _testDeadline = 0;
|
||||
// Mock fetch routes
|
||||
const _fetchRoutes = {
|
||||
'/test': { status: 200, body: 'yay', json: '{"foo":1}', html: '<div>yay</div>', number: '1.2' },
|
||||
'/test-json': { status: 200, body: '{"foo":1}', json: '{"foo":1}' },
|
||||
'/404': { status: 404, body: 'the body' },
|
||||
'/number': { status: 200, body: '1.2' },
|
||||
'/users/Joe': { status: 200, body: 'Joe', json: '{"name":"Joe"}' },
|
||||
};
|
||||
function _mockFetch(url) {
|
||||
const route = _fetchRoutes[url] || _fetchRoutes['/test'];
|
||||
return { ok: route.status < 400, status: route.status || 200, url: url || '/test',
|
||||
_body: route.body || '', _json: route.json || route.body || '', _html: route.html || route.body || '' };
|
||||
}
|
||||
globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(d>500||!r||!r.suspended)return;if(_testDeadline && Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const req=r.request;const items=req&&(req.items||req);const op=items&&items[0];const opName=typeof op==='string'?op:(op&&op.name)||String(op);
|
||||
function doResume(v){try{const x=r.resume(v);driveAsync(x,d+1);}catch(e){}}
|
||||
if(opName==='io-sleep'||opName==='wait')doResume(null);
|
||||
else if(opName==='io-fetch'){
|
||||
const url=typeof items[1]==='string'?items[1]:'/test';
|
||||
const fmt=typeof items[2]==='string'?items[2]:'text';
|
||||
const route=_fetchRoutes[url]||_fetchRoutes['/test'];
|
||||
if(fmt==='json'){try{doResume(JSON.parse(route.json||route.body||'{}'));}catch(e){doResume(null);}}
|
||||
else if(fmt==='html'){const frag=new El('fragment');frag.nodeType=11;frag.innerHTML=route.html||route.body||'';frag.textContent=frag.innerHTML.replace(/<[^>]*>/g,'');doResume(frag);}
|
||||
else if(fmt==='response')doResume({ok:(route.status||200)<400,status:route.status||200,url});
|
||||
else if(fmt.toLowerCase()==='number')doResume(parseFloat(route.number||route.body||'0'));
|
||||
else doResume(route.body||'');
|
||||
}
|
||||
else if(opName==='io-parse-text'){const resp=items&&items[1];doResume(resp&&resp._body?resp._body:typeof resp==='string'?resp:'');}
|
||||
else if(opName==='io-parse-json'){const resp=items&&items[1];try{doResume(JSON.parse(typeof resp==='string'?resp:resp&&resp._json?resp._json:'{}'));}catch(e){doResume(null);}}
|
||||
else if(opName==='io-parse-html'){const frag=new El('fragment');frag.nodeType=11;doResume(frag);}
|
||||
else if(opName==='io-settle')doResume(null);
|
||||
else if(opName==='io-wait-event')doResume(null);
|
||||
else if(opName==='io-transition')doResume(null);
|
||||
};
|
||||
|
||||
K.eval('(define SX_VERSION "hs-test-1.0")');K.eval('(define SX_ENGINE "ocaml-vm-sandbox")');
|
||||
K.eval('(define parse sx-parse)');K.eval('(define serialize sx-serialize)');
|
||||
|
||||
// ─── Load modules ──────────────────────────────────────────────
|
||||
process.stderr.write('Loading modules...\n');
|
||||
const t_mod = Date.now();
|
||||
const WEB=['render','core-signals','signals','deps','router','page-helpers','freeze','dom','browser','adapter-html','adapter-sx','adapter-dom','boot-helpers','hypersx','engine','orchestration','boot'];
|
||||
const HS=['hs-tokenizer','hs-parser','hs-compiler','hs-runtime','hs-integration'];
|
||||
K.beginModuleLoad();
|
||||
for(const mod of[...WEB,...HS]){const sp=path.join(SX_DIR,mod+'.sx');const lp=path.join(PROJECT,'lib/hyperscript',mod.replace(/^hs-/,'')+'.sx');let s;try{s=fs.existsSync(sp)?fs.readFileSync(sp,'utf8'):fs.readFileSync(lp,'utf8');}catch(e){continue;}try{K.load(s);}catch(e){process.stderr.write(`LOAD ERROR: ${mod}: ${e.message}\n`);}}
|
||||
K.endModuleLoad();
|
||||
process.stderr.write(`Modules loaded in ${Date.now()-t_mod}ms\n`);
|
||||
|
||||
// ─── Test framework ────────────────────────────────────────────
|
||||
K.eval('(define _test-registry (list))');K.eval('(define _test-suite "")');
|
||||
K.eval('(define push-suite (fn (name) (set! _test-suite name)))');
|
||||
K.eval('(define pop-suite (fn () (set! _test-suite "")))');
|
||||
K.eval('(define _current-test-name "")');
|
||||
K.eval('(define try-call (fn (thunk) (set! _test-registry (append _test-registry (list {:suite _test-suite :name _current-test-name :thunk thunk}))) {:ok true}))');
|
||||
K.eval('(define report-pass (fn (n) true))');
|
||||
K.eval('(define report-fail (fn (n e) true))');
|
||||
K.eval(`(define _run-test-thunk
|
||||
(fn (thunk)
|
||||
(guard (exn
|
||||
(true {:ok false :error (if (string? exn) exn (str exn))}))
|
||||
(thunk)
|
||||
{:ok true})))`);
|
||||
process.stderr.write('Loading tests...\n');
|
||||
const t_tests = Date.now();
|
||||
for(const f of['spec/harness.sx','spec/tests/test-framework.sx','spec/tests/test-hyperscript-behavioral.sx']){
|
||||
const t0=Date.now();
|
||||
try{K.load(fs.readFileSync(path.join(PROJECT,f),'utf8'));}catch(e){process.stderr.write(`TEST LOAD ERROR: ${f}: ${e.message}\n`);}
|
||||
process.stderr.write(` ${path.basename(f)}: ${Date.now()-t0}ms\n`);
|
||||
if(f==='spec/tests/test-framework.sx'){
|
||||
K.eval(`(defmacro deftest (name &rest body)
|
||||
\`(do (set! _current-test-name ,name)
|
||||
(let ((result (try-call (fn () ,@body))))
|
||||
(if (get result "ok")
|
||||
(report-pass ,name)
|
||||
(report-fail ,name (get result "error"))))))`);
|
||||
}
|
||||
}
|
||||
process.stderr.write(`Tests loaded in ${Date.now()-t_tests}ms\n`);
|
||||
|
||||
const testCount = K.eval('(len _test-registry)');
|
||||
// Pre-read names
|
||||
const names = [];
|
||||
for(let i=0;i<testCount;i++) names.push({
|
||||
s: K.eval(`(get (nth _test-registry ${i}) "suite")`)||'',
|
||||
n: K.eval(`(get (nth _test-registry ${i}) "name")`)||`test-${i}`,
|
||||
});
|
||||
|
||||
const startTest = parseInt(process.env.HS_START || '0');
|
||||
const endTest = parseInt(process.env.HS_END || String(testCount));
|
||||
process.stdout.write(`Running tests ${startTest}-${endTest-1} of ${testCount} (step limit: ${STEP_LIMIT})...\n`);
|
||||
|
||||
let passed=0,failed=0;
|
||||
const cats={};const errTypes={};
|
||||
|
||||
const SUITE_FILTER = process.env.HS_SUITE;
|
||||
for(let i=startTest;i<Math.min(endTest,testCount);i++){
|
||||
if(SUITE_FILTER && names[i].s!==SUITE_FILTER) continue;
|
||||
const {s:suite,n:name}=names[i];
|
||||
if(!cats[suite])cats[suite]={p:0,f:0,errs:[]};
|
||||
|
||||
// Reset body
|
||||
_body.children=[];_body.childNodes=[];_body.innerHTML='';_body.textContent='';
|
||||
|
||||
// Enable step limit for timeout protection
|
||||
setStepLimit(STEP_LIMIT);
|
||||
_testDeadline = Date.now() + 10000; // 10 second wall-clock timeout per test
|
||||
if(process.env.HS_VERBOSE)process.stderr.write(`T${i} `);
|
||||
|
||||
let ok=false,err=null;
|
||||
try{
|
||||
// Use SX-level guard to catch errors, avoiding __sxR side-channel issues
|
||||
// Returns a dict with :ok and :error keys
|
||||
K.eval(`(define _test-result (_run-test-thunk (get (nth _test-registry ${i}) "thunk")))`);
|
||||
const isOk=K.eval('(get _test-result "ok")');
|
||||
if(isOk===true){ok=true;}
|
||||
else{
|
||||
const errMsg=K.eval('(get _test-result "error")');
|
||||
err=errMsg?String(errMsg).slice(0,150):'unknown error';
|
||||
}
|
||||
}catch(e){err=(e.message||'').slice(0,150);}
|
||||
setStepLimit(0); // disable step limit between tests
|
||||
|
||||
const elapsed = Date.now() - (_testDeadline - 3000); // ms since test start
|
||||
if(ok){passed++;cats[suite].p++;}
|
||||
else{
|
||||
failed++;cats[suite].f++;cats[suite].errs.push({name,err});
|
||||
let t='other';
|
||||
if(err&&err.includes('TIMEOUT'))t='timeout';
|
||||
else if(err&&err.includes('NOT IMPLEMENTED'))t='stub';
|
||||
else if(err&&err.includes('Assertion'))t='assert-fail';
|
||||
else if(err&&err.includes('Expected'))t='wrong-value';
|
||||
else if(err&&err.includes('Undefined symbol'))t='undef-sym';
|
||||
else if(err&&err.includes('Unhandled'))t='unhandled';
|
||||
errTypes[t]=(errTypes[t]||0)+1;
|
||||
}
|
||||
_testDeadline = 0;
|
||||
if((i+1)%100===0)process.stdout.write(` ${i+1}/${testCount} (${passed} pass, ${failed} fail)\n`);
|
||||
if(elapsed > 5000)process.stdout.write(` SLOW: test ${i} took ${elapsed}ms [${suite}] ${name}\n`);
|
||||
if(!ok && err && err.includes('TIMEOUT'))process.stdout.write(` TIMEOUT: test ${i} [${suite}] ${name}\n`);
|
||||
if(!ok && err && err.includes('Expected') && err.includes(', got '))process.stdout.write(` WRONG: test ${i} [${suite}] ${name} — ${err}\n`);
|
||||
if(!ok && err && err.includes("at position"))process.stdout.write(` PARSE: test ${i} [${suite}] ${name} — ${err}\n`);
|
||||
}
|
||||
|
||||
process.stdout.write(`\nResults: ${passed}/${passed+failed} (${(100*passed/(passed+failed)).toFixed(0)}%)\n\n`);
|
||||
process.stdout.write('By category:\n');
|
||||
for(const[cat,s]of Object.entries(cats).sort((a,b)=>{const ra=a[1].p/(a[1].p+a[1].f);const rb=b[1].p/(b[1].p+b[1].f);return rb-ra;})){
|
||||
const total=s.p+s.f;const pct=(100*s.p/total).toFixed(0);
|
||||
const mark=s.f===0?`✓ ${s.p}`:`${s.p}/${total} (${pct}%)`;
|
||||
process.stdout.write(` ${cat}: ${mark}\n`);
|
||||
}
|
||||
process.stdout.write('\nFailure types:\n');
|
||||
for(const[t,n]of Object.entries(errTypes).sort((a,b)=>b[1]-a[1])) process.stdout.write(` ${t}: ${n}\n`);
|
||||
const ue={};
|
||||
for(const[cat,s]of Object.entries(cats))for(const{err}of s.errs){const e=(err||'').slice(0,100);ue[e]=(ue[e]||0)+1;}
|
||||
process.stdout.write(`\nUnique errors (${Object.keys(ue).length}):\n`);
|
||||
for(const[e,n]of Object.entries(ue).sort((a,b)=>b[1]-a[1]).slice(0,30)) process.stdout.write(` [${n}x] ${e}\n`);
|
||||
|
||||
// Full failure list
|
||||
process.stdout.write('\nAll failures:\n');
|
||||
for(const[cat,s]of Object.entries(cats))for(const{name,err}of s.errs){
|
||||
process.stdout.write(` [${cat}] ${name}: ${err}\n`);
|
||||
}
|
||||
|
||||
// Test-specific debug dump
|
||||
if(process.env.HS_DEBUG_TEST){
|
||||
const target = process.env.HS_DEBUG_TEST;
|
||||
for(let i=0;i<names.length;i++){
|
||||
if(names[i].n===target){
|
||||
console.log('FOUND TARGET INDEX:', i, 'suite:', names[i].s);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -47,9 +47,56 @@ def parse_js_value(s):
|
||||
m = re.match(r'^\[(.+)\]$', s, re.DOTALL)
|
||||
if m:
|
||||
return parse_js_array(m.group(1))
|
||||
# Empty object
|
||||
if s == '{}':
|
||||
return '{}'
|
||||
# Object literal — convert to SX dict {:key val ...}
|
||||
m = re.match(r'^\{(.+)\}$', s, re.DOTALL)
|
||||
if m:
|
||||
return parse_js_object(m.group(1))
|
||||
return None
|
||||
|
||||
|
||||
def parse_js_object(inner):
|
||||
"""Parse JS object contents into SX dict {:key val ...}. Handles nested."""
|
||||
pairs = split_js_object(inner)
|
||||
if pairs is None:
|
||||
return None
|
||||
sx_pairs = []
|
||||
for pair in pairs:
|
||||
km = re.match(r'\s*["\']?(\w+)["\']?\s*:\s*(.+)$', pair.strip(), re.DOTALL)
|
||||
if not km:
|
||||
return None
|
||||
k = km.group(1)
|
||||
v = parse_js_value(km.group(2).strip())
|
||||
if v is None:
|
||||
return None
|
||||
sx_pairs.append(f':{k} {v}')
|
||||
return '{' + ' '.join(sx_pairs) + '}'
|
||||
|
||||
|
||||
def split_js_object(s):
|
||||
"""Split JS object-content by commas respecting nesting."""
|
||||
items = []
|
||||
depth = 0
|
||||
current = ''
|
||||
for ch in s:
|
||||
if ch in '([{':
|
||||
depth += 1
|
||||
current += ch
|
||||
elif ch in ')]}':
|
||||
depth -= 1
|
||||
current += ch
|
||||
elif ch == ',' and depth == 0:
|
||||
items.append(current)
|
||||
current = ''
|
||||
else:
|
||||
current += ch
|
||||
if current.strip():
|
||||
items.append(current)
|
||||
return items if items else None
|
||||
|
||||
|
||||
def parse_js_array(inner):
|
||||
"""Parse JS array contents into SX (list ...). Handles nested arrays."""
|
||||
items = split_js_array(inner)
|
||||
|
||||
Reference in New Issue
Block a user