coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

Hyperscript examples working: toggle, bounce, count clicks

Browse Source 
- sx_browser.ml: restore VmSuspended handler in api_call_fn with
  make_js_callFn_suspension for IO suspension chains (wait, fetch)
- runtime.sx: delete host-get stub that shadowed platform native —
  hs-toggle-class! now uses real FFI host-get for classList access

All three live demo examples work:
  Toggle Color — classList.toggle on click
  Bounce — add .animate-bounce, wait 1s suspend, remove
  Count Clicks — increment @data-count, put into innerHTML

4/4 bytecode regression tests pass (was 0/4 without VmSuspended).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-09 21:04:45 +00:00
parent c6df054957
commit de9ab4ca07
7 changed files with 253 additions and 117 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
hosts/ocaml/browser/sx_browser.ml
View File

@@ -487,12 +487,35 @@ let api_register_native name_js callback_js =
Hashtbl.replace _vm_globals name v;
Js.Unsafe.inject Js.null
let rec make_js_callFn_suspension request vm =
let obj = Js.Unsafe.obj [||] in
Js.Unsafe.set obj (Js.string "suspended") (Js.Unsafe.inject Js._true);
Js.Unsafe.set obj (Js.string "request") (value_to_js request);
Js.Unsafe.set obj (Js.string "resume") (Js.wrap_callback (fun result_js ->
let result = js_to_value result_js in
try
let v = Sx_vm.resume_vm vm result in
sync_vm_to_env ();
value_to_js v
with
| Sx_vm.VmSuspended (req2, vm2) ->
Js.Unsafe.inject (make_js_callFn_suspension req2 vm2)
| Eval_error msg ->
ignore (Js.Unsafe.meth_call
(Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
"error" [| Js.Unsafe.inject (Js.string ("[sx] resume: " ^ msg)) |]);
Js.Unsafe.inject Js.null));
obj
let api_call_fn fn_js args_js =
try
let fn = js_to_value fn_js in
let args = Array.to_list (Array.map js_to_value (Js.to_array (Js.Unsafe.coerce args_js))) in
return_via_side_channel (value_to_js (call_sx_fn fn args))
with
| Sx_vm.VmSuspended (request, vm) ->
sync_vm_to_env ();
Js.Unsafe.inject (make_js_callFn_suspension request vm)
| Eval_error msg ->
ignore (Js.Unsafe.meth_call
(Js.Unsafe.get Js.Unsafe.global (Js.string "console"))

146
lib/hyperscript/runtime.sx
View File

@@ -49,9 +49,7 @@
;; Toggle a single class on an element.
(define
hs-toggle-class!
(fn
(target cls)
(host-call (hs-host-get target "classList") "toggle" cls)))
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; Toggle between two classes — exactly one is active at a time.
(define
@@ -468,67 +466,107 @@
d))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-host-get
(fn (obj key) (if (= key "length") (len obj) (get obj key))))
;; DOM query stub — sandbox returns empty list
(define hs-dom-query (fn (selector) (list)))
;; DOM query stub — sandbox returns empty list
(define
hs-method-call
(fn
(obj method &rest args)
(cond
((= method "map") (map (first args) obj))
((= method "push") (do (append! obj (first args)) obj))
((= method "filter") (filter (first args) obj))
((= method "join") (join obj (first args)))
((= method "indexOf")
(let
((item (first args)))
(define
idx-loop
(fn
(lst i)
(if
(= (len lst) 0)
-1
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0)))
(true nil))))
;; Method dispatch — obj.method(args)
(define hs-method-call (fn (obj method &rest args)
(cond
((= method "map") (map (first args) obj))
((= method "push") (do (append! obj (first args)) obj))
((= method "filter") (filter (first args) obj))
((= method "join") (join obj (first args)))
((= method "indexOf")
(let ((item (first args)))
(define idx-loop (fn (lst i)
(if (= (len lst) 0) -1
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0)))
(true nil))))
(define hs-beep (fn (v) v))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define hs-beep (fn (v) v))
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
;; Property-based is — check obj.key truthiness
(define hs-prop-is (fn (obj key) (not (hs-falsy? (hs-host-get obj key)))))
;; Array slicing (inclusive both ends)
(define hs-slice (fn (col start end)
(let ((s (if (nil? start) 0 start))
(define
hs-slice
(fn
(col start end)
(let
((s (if (nil? start) 0 start))
(e (if (nil? end) (len col) (+ end 1))))
(slice col s e))))
(slice col s e))))
;; Array slicing (inclusive both ends)
(define
hs-sorted-by
(fn
(col key-fn)
(let
((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map
(fn (p) (nth p 1))
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
;; Collection: sorted by
(define hs-sorted-by (fn (col key-fn)
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map (fn (p) (nth p 1))
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
(define
hs-sorted-by-desc
(fn
(col key-fn)
(let
((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map
(fn (p) (nth p 1))
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
;; Collection: sorted by descending
(define hs-sorted-by-desc (fn (col key-fn)
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map (fn (p) (nth p 1))
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
;; Collection: split by
(define hs-split-by (fn (s sep) (split s sep)))
;; Collection: joined by
;; Collection: split by
(define hs-joined-by (fn (col sep) (join sep col)))
;; Collection: joined by
(define
hs-sorted-by
(fn
(col key-fn)
(let
((decorated (map (fn (item) (list (key-fn item) item)) col)))
(let
((sorted-dec (sort (map first decorated))))
(define
reorder
(fn
(keys acc remaining)
(if
(= (len keys) 0)
acc
(let
((k (first keys)))
(define
find-item
(fn
(lst)
(if
(= (len lst) 0)
nil
(if
(= (first (first lst)) k)
(first lst)
(find-item (rest lst))))))
(let
((found (find-item remaining)))
(reorder
(rest keys)
(append acc (list (nth found 1)))
(filter (fn (x) (not (= x found))) remaining)))))))
(reorder sorted-dec (list) decorated)))))
;; Override sorted-by — use decorate-sort-undecorate (no comparator arg to sort)
(define hs-sorted-by (fn (col key-fn)
(let ((decorated (map (fn (item) (list (key-fn item) item)) col)))
(let ((sorted-dec (sort (map first decorated))))
(define reorder (fn (keys acc remaining)
(if (= (len keys) 0) acc
(let ((k (first keys)))
(define find-item (fn (lst)
(if (= (len lst) 0) nil
(if (= (first (first lst)) k) (first lst)
(find-item (rest lst))))))
(let ((found (find-item remaining)))
(reorder (rest keys)
(append acc (list (nth found 1)))
(filter (fn (x) (not (= x found))) remaining)))))))
(reorder sorted-dec (list) decorated)))))
(define hs-sorted-by-desc (fn (col key-fn)
(reverse (hs-sorted-by col key-fn))))
(define
hs-sorted-by-desc
(fn (col key-fn) (reverse (hs-sorted-by col key-fn))))

146
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -49,9 +49,7 @@
;; Toggle a single class on an element.
(define
hs-toggle-class!
(fn
(target cls)
(host-call (hs-host-get target "classList") "toggle" cls)))
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; Toggle between two classes — exactly one is active at a time.
(define
@@ -468,67 +466,107 @@
d))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-host-get
(fn (obj key) (if (= key "length") (len obj) (get obj key))))
;; DOM query stub — sandbox returns empty list
(define hs-dom-query (fn (selector) (list)))
;; DOM query stub — sandbox returns empty list
(define
hs-method-call
(fn
(obj method &rest args)
(cond
((= method "map") (map (first args) obj))
((= method "push") (do (append! obj (first args)) obj))
((= method "filter") (filter (first args) obj))
((= method "join") (join obj (first args)))
((= method "indexOf")
(let
((item (first args)))
(define
idx-loop
(fn
(lst i)
(if
(= (len lst) 0)
-1
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0)))
(true nil))))
;; Method dispatch — obj.method(args)
(define hs-method-call (fn (obj method &rest args)
(cond
((= method "map") (map (first args) obj))
((= method "push") (do (append! obj (first args)) obj))
((= method "filter") (filter (first args) obj))
((= method "join") (join obj (first args)))
((= method "indexOf")
(let ((item (first args)))
(define idx-loop (fn (lst i)
(if (= (len lst) 0) -1
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0)))
(true nil))))
(define hs-beep (fn (v) v))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define hs-beep (fn (v) v))
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
;; Property-based is — check obj.key truthiness
(define hs-prop-is (fn (obj key) (not (hs-falsy? (hs-host-get obj key)))))
;; Array slicing (inclusive both ends)
(define hs-slice (fn (col start end)
(let ((s (if (nil? start) 0 start))
(define
hs-slice
(fn
(col start end)
(let
((s (if (nil? start) 0 start))
(e (if (nil? end) (len col) (+ end 1))))
(slice col s e))))
(slice col s e))))
;; Array slicing (inclusive both ends)
(define
hs-sorted-by
(fn
(col key-fn)
(let
((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map
(fn (p) (nth p 1))
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
;; Collection: sorted by
(define hs-sorted-by (fn (col key-fn)
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map (fn (p) (nth p 1))
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
(define
hs-sorted-by-desc
(fn
(col key-fn)
(let
((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map
(fn (p) (nth p 1))
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
;; Collection: sorted by descending
(define hs-sorted-by-desc (fn (col key-fn)
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map (fn (p) (nth p 1))
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
;; Collection: split by
(define hs-split-by (fn (s sep) (split s sep)))
;; Collection: joined by
;; Collection: split by
(define hs-joined-by (fn (col sep) (join sep col)))
;; Collection: joined by
(define
hs-sorted-by
(fn
(col key-fn)
(let
((decorated (map (fn (item) (list (key-fn item) item)) col)))
(let
((sorted-dec (sort (map first decorated))))
(define
reorder
(fn
(keys acc remaining)
(if
(= (len keys) 0)
acc
(let
((k (first keys)))
(define
find-item
(fn
(lst)
(if
(= (len lst) 0)
nil
(if
(= (first (first lst)) k)
(first lst)
(find-item (rest lst))))))
(let
((found (find-item remaining)))
(reorder
(rest keys)
(append acc (list (nth found 1)))
(filter (fn (x) (not (= x found))) remaining)))))))
(reorder sorted-dec (list) decorated)))))
;; Override sorted-by — use decorate-sort-undecorate (no comparator arg to sort)
(define hs-sorted-by (fn (col key-fn)
(let ((decorated (map (fn (item) (list (key-fn item) item)) col)))
(let ((sorted-dec (sort (map first decorated))))
(define reorder (fn (keys acc remaining)
(if (= (len keys) 0) acc
(let ((k (first keys)))
(define find-item (fn (lst)
(if (= (len lst) 0) nil
(if (= (first (first lst)) k) (first lst)
(find-item (rest lst))))))
(let ((found (find-item remaining)))
(reorder (rest keys)
(append acc (list (nth found 1)))
(filter (fn (x) (not (= x found))) remaining)))))))
(reorder sorted-dec (list) decorated)))))
(define hs-sorted-by-desc (fn (col key-fn)
(reverse (hs-sorted-by col key-fn))))
(define
hs-sorted-by-desc
(fn (col key-fn) (reverse (hs-sorted-by col key-fn))))

4
shared/static/wasm/sx/hs-runtime.sxbc
View File

File diff suppressed because one or more lines are too long

1
shared/static/wasm/sx/module-manifest.json
View File

@@ -991,7 +991,6 @@
"hs-last",
"hs-template",
"hs-make-object",
"hs-host-get",
"hs-dom-query",
"hs-method-call",
"hs-beep",

46
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

4
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-42ed14c8",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-27feff75",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-42ed14c8",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-7e2debaf",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new
@@ -1818,4 +1818,4 @@ a()},"Js_of_ocaml__Json.fragments":{"get_JSON":a=>a.JSON,"get_constructor":a=>a.
a(b)},"Js_of_ocaml__Dom_svg.fragments":{"get_SVGElement":a=>a.SVGElement,"get_document":a=>a.document,"get_tagName":a=>a.tagName,"meth_call_0_toLowerCase":a=>a.toLowerCase(),"meth_call_1_getElementById":(a,b)=>a.getElementById(b),"meth_call_2_createElementNS":(a,b,c)=>a.createElementNS(b,c)},"Js_of_ocaml__EventSource.fragments":{"get_EventSource":a=>a.EventSource,"obj_9":()=>({}),"set_withCredentials":(a,b)=>a.withCredentials=b},"Js_of_ocaml__Geolocation.fragments":{"get_geolocation":a=>a.geolocation,"get_navigator":a=>a.navigator,"obj_10":()=>({})},"Js_of_ocaml__IntersectionObserver.fragments":{"get_IntersectionObserver":a=>a.IntersectionObserver,"obj_11":()=>({})},"Js_of_ocaml__Intl.fragments":{"get_Collator":a=>a.Collator,"get_DateTimeFormat":a=>a.DateTimeFormat,"get_Intl":a=>a.Intl,"get_NumberFormat":a=>a.NumberFormat,"get_PluralRules":a=>a.PluralRules,"obj_12":a=>({localeMatcher:a}),"obj_13":(a,b,c,d,e,f)=>({localeMatcher:a,usage:b,sensitivity:c,ignorePunctuation:d,numeric:e,caseFirst:f}),"obj_14":(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)=>({dateStyle:a,timeStyle:b,calendar:c,dayPeriod:d,numberingSystem:e,localeMatcher:f,timeZone:g,hour12:h,hourCycle:i,formatMatcher:j,weekday:k,era:l,year:m,month:n,day:o,hour:p,minute:q,second:r,fractionalSecondDigits:s,timeZoneName:t}),"obj_15":(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)=>({compactDisplay:a,currency:b,currencyDisplay:c,currencySign:d,localeMatcher:e,notation:f,numberingSystem:g,signDisplay:h,style:i,unit:j,unitDisplay:k,useGrouping:l,roundingMode:m,roundingPriority:n,roundingIncrement:o,trailingZeroDisplay:p,minimumIntegerDigits:q,minimumFractionDigits:r,maximumFractionDigits:s,minimumSignificantDigits:t,maximumSignificantDigits:u}),"obj_16":(a,b)=>({localeMatcher:a,type:b})},"Dune__exe__Sx_browser.fragments":{"fun_call_1":(a,b)=>a(b),"fun_call_3":(a,b,c,d)=>a(b,c,d),"get_Array":a=>a.Array,"get_Object":a=>a.Object,"get___sx_handle":a=>a.__sx_handle,"get__type":a=>a._type,"get_console":a=>a.console,"get_items":a=>a.items,"get_length":a=>a.length,"get_name":a=>a.name,"js_expr_10d25c5c":()=>function(a){return function(){b.__sxR=undefined;var
c=a.apply(null,arguments);return b.__sxR!==undefined?b.__sxR:c}},"js_expr_1ab4fffb":()=>function(){var
b={},d=0;return{put:function(a){var
c=d++;b[c]=a;return c},get:function(a){return b[a]}}}(),"js_expr_36506fc1":()=>function(a,b,c){a.__sx_handle=b;a._type=c;return a},"meth_call_1_error":(a,b)=>a.error(b),"meth_call_1_get":(a,b)=>a.get(b),"meth_call_1_isArray":(a,b)=>a.isArray(b),"meth_call_1_keys":(a,b)=>a.keys(b),"meth_call_1_put":(a,b)=>a.put(b),"obj_0":()=>({}),"obj_1":()=>({}),"obj_2":(a,b)=>({_type:a,items:b}),"obj_3":(a,b)=>({_type:a,name:b}),"obj_4":(a,b)=>({_type:a,name:b}),"obj_5":(a,b)=>({_type:a,__sx_handle:b}),"obj_6":()=>({}),"set_SxKernel":(a,b)=>a.SxKernel=b,"set___sxR":(a,b)=>a.__sxR=b,"set__type":(a,b)=>a._type=b,"set_beginModuleLoad":(a,b)=>a.beginModuleLoad=b,"set_callFn":(a,b)=>a.callFn=b,"set_compileModule":(a,b)=>a.compileModule=b,"set_debugEnv":(a,b)=>a.debugEnv=b,"set_endModuleLoad":(a,b)=>a.endModuleLoad=b,"set_engine":(a,b)=>a.engine=b,"set_eval":(a,b)=>a.eval=b,"set_evalExpr":(a,b)=>a.evalExpr=b,"set_evalVM":(a,b)=>a.evalVM=b,"set_fnArity":(a,b)=>a.fnArity=b,"set_inspect":(a,b)=>a.inspect=b,"set_isCallable":(a,b)=>a.isCallable=b,"set_load":(a,b)=>a.load=b,"set_loadModule":(a,b)=>a.loadModule=b,"set_loadSource":(a,b)=>a.loadSource=b,"set_op":(a,b)=>a.op=b,"set_parse":(a,b)=>a.parse=b,"set_registerNative":(a,b)=>a.registerNative=b,"set_renderToHtml":(a,b)=>a.renderToHtml=b,"set_request":(a,b)=>a.request=b,"set_resume":(a,b)=>a.resume=b,"set_scopeTraceDrain":(a,b)=>a.scopeTraceDrain=b,"set_scopeTraceOff":(a,b)=>a.scopeTraceOff=b,"set_scopeTraceOn":(a,b)=>a.scopeTraceOn=b,"set_stringify":(a,b)=>a.stringify=b,"set_suspended":(a,b)=>a.suspended=b,"set_typeOf":(a,b)=>a.typeOf=b}}})(globalThis),"src":"sx_browser.bc.wasm.assets"});
c=d++;b[c]=a;return c},get:function(a){return b[a]}}}(),"js_expr_36506fc1":()=>function(a,b,c){a.__sx_handle=b;a._type=c;return a},"meth_call_1_error":(a,b)=>a.error(b),"meth_call_1_get":(a,b)=>a.get(b),"meth_call_1_isArray":(a,b)=>a.isArray(b),"meth_call_1_keys":(a,b)=>a.keys(b),"meth_call_1_put":(a,b)=>a.put(b),"obj_0":()=>({}),"obj_1":()=>({}),"obj_2":(a,b)=>({_type:a,items:b}),"obj_3":(a,b)=>({_type:a,name:b}),"obj_4":(a,b)=>({_type:a,name:b}),"obj_5":(a,b)=>({_type:a,__sx_handle:b}),"obj_6":()=>({}),"obj_7":()=>({}),"set_SxKernel":(a,b)=>a.SxKernel=b,"set___sxR":(a,b)=>a.__sxR=b,"set__type":(a,b)=>a._type=b,"set_beginModuleLoad":(a,b)=>a.beginModuleLoad=b,"set_callFn":(a,b)=>a.callFn=b,"set_compileModule":(a,b)=>a.compileModule=b,"set_debugEnv":(a,b)=>a.debugEnv=b,"set_endModuleLoad":(a,b)=>a.endModuleLoad=b,"set_engine":(a,b)=>a.engine=b,"set_eval":(a,b)=>a.eval=b,"set_evalExpr":(a,b)=>a.evalExpr=b,"set_evalVM":(a,b)=>a.evalVM=b,"set_fnArity":(a,b)=>a.fnArity=b,"set_inspect":(a,b)=>a.inspect=b,"set_isCallable":(a,b)=>a.isCallable=b,"set_load":(a,b)=>a.load=b,"set_loadModule":(a,b)=>a.loadModule=b,"set_loadSource":(a,b)=>a.loadSource=b,"set_op":(a,b)=>a.op=b,"set_parse":(a,b)=>a.parse=b,"set_registerNative":(a,b)=>a.registerNative=b,"set_renderToHtml":(a,b)=>a.renderToHtml=b,"set_request":(a,b)=>a.request=b,"set_resume":(a,b)=>a.resume=b,"set_scopeTraceDrain":(a,b)=>a.scopeTraceDrain=b,"set_scopeTraceOff":(a,b)=>a.scopeTraceOff=b,"set_scopeTraceOn":(a,b)=>a.scopeTraceOn=b,"set_stringify":(a,b)=>a.stringify=b,"set_suspended":(a,b)=>a.suspended=b,"set_typeOf":(a,b)=>a.typeOf=b}}})(globalThis),"src":"sx_browser.bc.wasm.assets"});