HS: call command fix, event destructuring, array ops, form reset
- call: use make-symbol for fn name, rest-rest for args (was string + nth) - on: extract (ref ...) nodes from body as event.detail let-bindings - host-set!: add ListRef+Number case for array index mutation - append!: support index 0 for prepend - hs-put!: branch on list? for array start/end operations - hs-reset!: form reset restoring defaultValue/checked/textContent - 522/793 pass (was 493/754) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -352,7 +352,11 @@ let make_test_env () =
|
||||
|
||||
bind "append!" (fun args ->
|
||||
match args with
|
||||
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* mutate in place *)
|
||||
| [ListRef r; v; Number n] when int_of_float n = 0 ->
|
||||
r := v :: !r; ListRef r (* prepend *)
|
||||
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* append in place *)
|
||||
| [List items; v; Number n] when int_of_float n = 0 ->
|
||||
List (v :: items) (* immutable prepend *)
|
||||
| [List items; v] -> List (items @ [v]) (* immutable fallback *)
|
||||
| _ -> raise (Eval_error "append!: expected list and value"));
|
||||
|
||||
@@ -1297,8 +1301,7 @@ let run_spec_tests env test_files =
|
||||
let response = match op with
|
||||
| "import" ->
|
||||
let lib_spec = Sx_runtime.get_val request (String "library") in
|
||||
let key = Sx_ref.library_name_key lib_spec in
|
||||
if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
|
||||
if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
|
||||
Nil
|
||||
else begin
|
||||
(match resolve_library_path lib_spec with
|
||||
@@ -1611,7 +1614,7 @@ let run_spec_tests env test_files =
|
||||
| "contains" | "cloneNode" | "remove" | "focus" | "blur" | "click"
|
||||
| "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close"
|
||||
| "getBoundingClientRect" | "getAnimations" | "scrollIntoView"
|
||||
| "scrollTo" | "scroll" -> Bool true
|
||||
| "scrollTo" | "scroll" | "reset" -> Bool true
|
||||
| "firstElementChild" ->
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
(match kids with c :: _ -> c | [] -> Nil)
|
||||
@@ -1718,6 +1721,17 @@ let run_spec_tests env test_files =
|
||||
Hashtbl.replace d "childNodes" (List [])
|
||||
| _ -> ());
|
||||
stored
|
||||
| [ListRef r; Number n; value] ->
|
||||
let idx = int_of_float n in
|
||||
let lst = !r in
|
||||
if idx >= 0 && idx < List.length lst then
|
||||
r := List.mapi (fun i v -> if i = idx then value else v) lst
|
||||
else if idx = List.length lst then
|
||||
r := lst @ [value];
|
||||
value
|
||||
| [List _; Number _; _value] ->
|
||||
(* Immutable list — can't set, but don't crash *)
|
||||
Nil
|
||||
| _ -> Nil);
|
||||
|
||||
reg "host-call" (fun args ->
|
||||
@@ -2079,6 +2093,56 @@ let run_spec_tests env test_files =
|
||||
Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
| "reset" ->
|
||||
(* Reset form elements to their default values *)
|
||||
let rec reset_element el =
|
||||
match el with
|
||||
| Dict ed ->
|
||||
let tag = match Hashtbl.find_opt ed "tagName" with Some (String t) -> String.lowercase_ascii t | _ -> "" in
|
||||
let attrs = match Hashtbl.find_opt ed "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
|
||||
(match tag with
|
||||
| "input" ->
|
||||
let typ = match Hashtbl.find_opt attrs "type" with Some (String t) -> String.lowercase_ascii t | _ -> "text" in
|
||||
(match typ with
|
||||
| "checkbox" | "radio" ->
|
||||
let default_checked = Hashtbl.mem attrs "checked" in
|
||||
Hashtbl.replace ed "checked" (Bool default_checked)
|
||||
| _ ->
|
||||
let default_value = match Hashtbl.find_opt attrs "value" with Some v -> v | None -> String "" in
|
||||
Hashtbl.replace ed "value" default_value)
|
||||
| "textarea" ->
|
||||
(* Textarea default is from innerHTML/textContent, not value attr *)
|
||||
let default_value = match Hashtbl.find_opt attrs "value" with
|
||||
| Some v -> v
|
||||
| None -> (match Hashtbl.find_opt ed "textContent" with Some v -> v
|
||||
| None -> (match Hashtbl.find_opt ed "innerHTML" with Some v -> v | None -> String "")) in
|
||||
Hashtbl.replace ed "value" default_value
|
||||
| "select" ->
|
||||
(* Restore first option or defaultSelected *)
|
||||
let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
|
||||
let rec find_default = function
|
||||
| [] -> None
|
||||
| Dict od :: _ when Hashtbl.mem (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "selected" ->
|
||||
Some (match Hashtbl.find_opt (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "value" with Some (String v) -> v | _ -> "")
|
||||
| _ :: rest -> find_default rest in
|
||||
(match find_default kids with
|
||||
| Some v -> Hashtbl.replace ed "value" (String v)
|
||||
| None ->
|
||||
(match kids with
|
||||
| Dict od :: _ ->
|
||||
let v = match Hashtbl.find_opt (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "value" with Some (String v) -> v | _ -> "" in
|
||||
Hashtbl.replace ed "value" (String v)
|
||||
| _ -> ()))
|
||||
| "form" ->
|
||||
let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
|
||||
List.iter reset_element kids
|
||||
| _ ->
|
||||
(* Recurse into children for generic containers *)
|
||||
let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
|
||||
List.iter reset_element kids);
|
||||
| _ -> ()
|
||||
in
|
||||
reset_element (Dict d); Nil
|
||||
| _ -> Nil)
|
||||
| _ -> Nil);
|
||||
|
||||
|
||||
@@ -110,47 +110,32 @@
|
||||
(let
|
||||
((target (if source (hs-to-sx source) (quote me))))
|
||||
(let
|
||||
((compiled-body (hs-to-sx body))
|
||||
(wrapped-body
|
||||
(if
|
||||
catch-info
|
||||
((event-refs (if (and (list? body) (= (first body) (quote do))) (filter (fn (x) (and (list? x) (= (first x) (quote ref)))) (rest body)) (list))))
|
||||
(let
|
||||
((stripped-body (if (> (len event-refs) 0) (let ((remaining (filter (fn (x) (not (and (list? x) (= (first x) (quote ref))))) (rest body)))) (if (= (len remaining) 1) (first remaining) (cons (quote do) remaining))) body)))
|
||||
(let
|
||||
((raw-compiled (hs-to-sx stripped-body)))
|
||||
(let
|
||||
((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote get) (list (quote get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled)))
|
||||
(let
|
||||
((var (make-symbol (first catch-info)))
|
||||
(catch-body
|
||||
(hs-to-sx (nth catch-info 1))))
|
||||
(if
|
||||
finally-info
|
||||
(list
|
||||
(quote do)
|
||||
((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 guard)
|
||||
(list var (list true catch-body))
|
||||
compiled-body)
|
||||
(hs-to-sx finally-info))
|
||||
(quote fn)
|
||||
(list (quote event))
|
||||
wrapped-body)))
|
||||
(if
|
||||
every?
|
||||
(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)))
|
||||
(if
|
||||
every?
|
||||
(list
|
||||
(quote hs-on-every)
|
||||
target
|
||||
event-name
|
||||
handler)
|
||||
(list (quote hs-on) target event-name handler))))))
|
||||
(quote hs-on-every)
|
||||
target
|
||||
event-name
|
||||
handler)
|
||||
(list
|
||||
(quote hs-on)
|
||||
target
|
||||
event-name
|
||||
handler))))))))))
|
||||
((= (first items) :from)
|
||||
(scan-on
|
||||
(rest (rest items))
|
||||
@@ -1134,8 +1119,13 @@
|
||||
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
|
||||
((= head (quote call))
|
||||
(let
|
||||
((fn-expr (hs-to-sx (nth ast 1)))
|
||||
(args (map hs-to-sx (nth ast 2))))
|
||||
((raw-fn (nth ast 1))
|
||||
(fn-expr
|
||||
(if
|
||||
(string? raw-fn)
|
||||
(make-symbol raw-fn)
|
||||
(hs-to-sx raw-fn)))
|
||||
(args (map hs-to-sx (rest (rest ast)))))
|
||||
(cons fn-expr args)))
|
||||
((= head (quote return))
|
||||
(let
|
||||
|
||||
@@ -161,12 +161,21 @@
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((= pos "into") (dom-set-inner-html target value))
|
||||
((= pos "into")
|
||||
(if (list? target) target (dom-set-inner-html target value)))
|
||||
((= pos "before")
|
||||
(dom-insert-adjacent-html target "beforebegin" value))
|
||||
((= pos "after") (dom-insert-adjacent-html target "afterend" value))
|
||||
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
||||
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
|
||||
((= pos "start")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value 0)
|
||||
(dom-insert-adjacent-html target "afterbegin" value)))
|
||||
((= pos "end")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value)
|
||||
(dom-insert-adjacent-html target "beforeend" value))))))
|
||||
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
|
||||
Reference in New Issue
Block a user