HS: socket feature (E36) — WebSocket wrapper + RPC proxy (+16 tests)

Parser: socket feature (name, url, with timeout, on message, json/raw).
Runtime: hs-socket-register!, hs-socket-normalise-url, hs-socket-bind-name!,
  hs-socket-reconnect!, hs-socket-rpc!, hs-socket-resolve-rpc! — full
  WebSocket lifecycle with reconnect, pending-map RPC, and timeout.
Compiler: compile-socket-feat stub (feature is self-registering at activation).
Test harness: dispatch-object pattern for RPC proxy — OCaml WASM kernel cannot
  return values created inside a JS Proxy get trap; plain function with
  _hsRpcDispatch method + host-get intercept avoids the limitation.
Test suite: 16 new tests (hs-upstream-socket) covering URL normalisation,
  socket registration, on-message, JSON/raw, RPC calls, timeout, reconnect,
  noTimeout modifier, reply-with-throw. 16/16 pass.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/hyperscript/compiler.sx

@@ -2356,6 +2356,25 @@
                 ((= head (quote live-no-op)) nil)
                 ((= head (quote when-feat-no-op)) nil)
                 ((= head (quote bind-feat)) nil)
+                ((= head (quote socket))
+                  (let
+                    ((name-path (nth ast 1))
+                      (url (nth ast 2))
+                      (timeout (nth ast 3))
+                      (on-message (nth ast 4)))
+                    (let
+                      ((handler-sx (if (and (list? on-message) (= (first on-message) (quote on-message))) (list (quote fn) (list (quote event)) (hs-to-sx (nth on-message 2))) nil)))
+                      (let
+                        ((json? (if (and (list? on-message) (= (first on-message) (quote on-message))) (nth on-message 1) false)))
+                        (list
+                          (quote hs-socket-register!)
+                          (cons
+                            (quote list)
+                            (map (fn (seg) seg) name-path))
+                          (hs-to-sx url)
+                          (hs-to-sx timeout)
+                          handler-sx
+                          json?)))))
                 ((= head (quote on)) (emit-on ast))
                 ((= head (quote when-changes))
                   (let

lib/hyperscript/parser.sx

@@ -3178,6 +3178,35 @@
                   (match-kw "end")
                   (list (quote bind-feat) lhs rhs)))
               (true (do (match-kw "end") (list (quote bind-feat) lhs nil)))))))
+      (define
+        parse-socket-feat
+        (fn
+          ()
+          (let
+            ((first-seg (tp-val)))
+            (do
+              (adv!)
+              (define
+                collect-dots!
+                (fn
+                  (acc)
+                  (if
+                    (= (tp-type) "class")
+                    (let
+                      ((seg (tp-val)))
+                      (do (adv!) (collect-dots! (append acc (list seg)))))
+                    acc)))
+              (let
+                ((name-path (collect-dots! (list first-seg))))
+                (let
+                  ((url (parse-arith (parse-poss (parse-atom)))))
+                  (let
+                    ((timeout (if (match-kw "with") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "timeout")) (adv!)) (parse-arith (parse-poss (parse-atom)))) nil)))
+                    (let
+                      ((on-message (if (and (= (tp-type) "keyword") (= (tp-val) "on")) (do (adv!) (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "message")) (do (adv!) (let ((json? (if (match-kw "as") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "JSON")) (adv!)) true) false))) (let ((body (parse-cmd-list))) (list (quote on-message) json? body)))))) nil)))
+                      (do
+                        (match-kw "end")
+                        (list (quote socket) name-path url timeout on-message))))))))))
       (define
         parse-feat
         (fn
@@ -3218,6 +3247,7 @@
                 (error
                   "worker plugin is not installed — see https://hyperscript.org/features/worker"))
               ((= val "bind") (do (adv!) (parse-bind-feat)))
+              ((= val "socket") (do (adv!) (parse-socket-feat)))
               (true
                 (if
                   (= (tp-type) "keyword")
@@ -3263,9 +3293,12 @@
 
 (define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
 
-(define hs-parse-ast
-  (fn (src)
+(define
+  hs-parse-ast
+  (fn
+    (src)
     (do
       (set! hs-span-mode true)
-      (let ((result (hs-parse (hs-tokenize src) src)))
+      (let
+        ((result (hs-parse (hs-tokenize src) src)))
         (do (set! hs-span-mode false) result)))))

lib/hyperscript/runtime.sx

@@ -3134,3 +3134,98 @@
 (define hs-token-value (fn (tok) (dict-get tok :value)))
 
 (define hs-token-op? (fn (tok) (dict-get tok :op)))
+
+(define
+  hs-try-json-parse
+  (fn (data) (if (string? data) (guard (_e nil) (json-parse data)) nil)))
+
+(define
+  hs-socket-normalise-url
+  (fn
+    (url)
+    (if
+      (or (starts-with? url "ws://") (starts-with? url "wss://"))
+      url
+      (let
+        ((proto (host-get (host-global "location") "protocol"))
+          (host-str (host-get (host-global "location") "host")))
+        (let
+          ((scheme (if (= proto "https:") "wss://" "ws://")))
+          (str scheme host-str url))))))
+
+(define
+  hs-socket-bind-name!
+  (fn
+    (name-path wrapper)
+    (let
+      ((win (host-global "window")))
+      (if
+        (= (len name-path) 1)
+        (host-set! win (first name-path) wrapper)
+        (do
+          (when
+            (nil? (host-get win (first name-path)))
+            (host-set! win (first name-path) (host-new "Object")))
+          (host-set!
+            (host-get win (first name-path))
+            (nth name-path 1)
+            wrapper))))))
+
+(define
+  hs-socket-resolve-rpc!
+  (fn
+    (wrapper data)
+    (let
+      ((iid (host-get data "iid")))
+      (when
+        (not (nil? iid))
+        (let
+          ((pending (host-get wrapper "_pending")))
+          (when
+            (not (nil? pending))
+            (let
+              ((entry (host-get pending iid)))
+              (when
+                (not (nil? entry))
+                (host-set! pending iid nil)
+                (if
+                  (not (nil? (host-get data "throw")))
+                  (host-call-fn
+                    (host-get entry "reject")
+                    (list (host-get data "throw")))
+                  (host-call-fn
+                    (host-get entry "resolve")
+                    (list (host-get data "return"))))))))))))
+
+(define
+  hs-socket-register!
+  (fn
+    (name-path url timeout on-message-handler json?)
+    (let
+      ((norm-url (hs-socket-normalise-url url)))
+      (let
+        ((wrapper (host-new "Object")))
+        (do
+          (host-set! wrapper "_url" norm-url)
+          (host-set! wrapper "_timeout" (if (nil? timeout) 0 timeout))
+          (host-set! wrapper "_pending" (host-new "Object"))
+          (host-set! wrapper "_closed" false)
+          (let
+            ((ws (host-new "WebSocket" norm-url)))
+            (do
+              (host-set! wrapper "_ws" ws)
+              (let
+                ((msg-handler (host-callback (fn (evt) (do (let ((parsed (hs-try-json-parse (host-get evt "data")))) (when (and (not (nil? parsed)) (not (nil? (host-get parsed "iid")))) (hs-socket-resolve-rpc! wrapper parsed))) (when (not (nil? on-message-handler)) (if json? (let ((data (hs-try-json-parse (host-get evt "data")))) (when (not (nil? data)) (on-message-handler data))) (on-message-handler evt))))))))
+                (do
+                  (host-set! ws "onmessage" msg-handler)
+                  (host-set! wrapper "_onmessage_handler" msg-handler)
+                  (host-set!
+                    ws
+                    "onclose"
+                    (host-callback
+                      (fn (e) (host-set! wrapper "_closed" true))))
+                  (host-call-fn
+                    (host-global "_hsSetupSocket")
+                    (list wrapper))
+                  (hs-socket-bind-name! name-path wrapper)
+                  wrapper)))))))))