✨ defcommand macro and expose render_sync

AI-assisted-by: gpt-6.1-sol, deepseek-flash

.cljfmt.edn

@@ -11,5 +11,6 @@
                  cljs.test/async [[:inner 0]]
                  promesa.exec/thread [[:inner 0]]
                  specify! [[:inner 0] [:inner 1]]
+                 benches.render-wasm.runtime.commands/defcommand [[:inner 0]]
                  benches.render-wasm.runtime.protocol/resolve-or-reject-with [[:inner 0]]}
  }

frontend/performance/benches/render_wasm/browser/bridge.cljs

@@ -88,6 +88,7 @@
    ;; WASM calls
    :render            (fn [timestamp flags]
                         (h/call wasm/internal-module "_render" timestamp flags))
+   :render-sync       #(h/call wasm/internal-module "_render_sync")
    :render-from-cache #(h/call wasm/internal-module "_render_from_cache" 0)
    :set-view          #(h/call wasm/internal-module "_set_view"
                                (:scale %) (- (:x %)) (- (:y %)))

frontend/performance/benches/render_wasm/runtime/camera.cljs

@@ -53,8 +53,16 @@
   their bodies. This namespace loads there because renderer effects come
   through the browser-supplied `:hooks`."
   (:require
+   [benches.render-wasm.runtime.commands :refer [defcommand]]
    [benches.render-wasm.runtime.protocol :as protocol]))
 
+(defcommand render-sync
+  "Renders through the blocking renderer path."
+  {:requires [:render-sync]}
+  [rtx]
+  ((get-in rtx [:hooks :render-sync]))
+  rtx)
+
 (defn load!
   "Drains the uploaded scene until the renderer reports Full completion.
   `rtx` supplies the clock and renderer hooks. Returns a promise of first-render

frontend/performance/benches/render_wasm/runtime/commands.clj

@@ -0,0 +1,64 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS SUBSIDIARY SL
+
+(ns benches.render-wasm.runtime.commands)
+
+(defmacro defcommand
+  "Defines a command for scenes.
+
+  `(defcommand foo ...)` creates commands `foo` and `foo*`. The latter is
+  measured (records raw observations).
+
+  Both variants accept a context or its Promise and return a Promise of the
+  updated context. `:requires` declares callable hook names.
+  `:measured-variant false` defines a composite that awaits its returned context.
+  Argument destructuring and `:pre` checks precede the measured interval in
+  every build. The condition map accepts only `:pre`."
+  [command & forms]
+  (let [[doc forms]       (if (string? (first forms))
+                            [(first forms) (next forms)]
+                            [nil forms])
+        [options forms]   (if (map? (first forms))
+                            [(first forms) (next forms)]
+                            [{} forms])
+        [argv & body]     forms
+        [conditions body] (if (and (map? (first body)) (next body))
+                            [(first body) (next body)]
+                            [nil body])
+        measured          (get options :measured-variant true)
+        command-id        (keyword (str (get-in &env [:ns :name])) (name command))
+        starred           (symbol (str command "*"))
+        prepare           (gensym "prepare")]
+    (when-not (and (simple-symbol? command)
+                   (vector? argv)
+                   (seq argv)
+                   (boolean? measured)
+                   (every? #{:requires :measured-variant} (keys options))
+                   (every? keyword? (:requires options))
+                   (every? #{:pre} (keys conditions))
+                   (or (nil? (:pre conditions)) (vector? (:pre conditions))))
+      (throw (ex-info "invalid command declaration" {:command command})))
+    `(let [~prepare (fn ~argv
+                      ~@(for [condition (:pre conditions)]
+                          `(when-not ~condition
+                             (throw (ex-info "command precondition failed"
+                                             {:type ::invalid-arguments
+                                              :command ~command-id
+                                              :condition '~condition}))))
+                      (fn [] ~@body))]
+       (defn ~command
+         ~@(when doc [doc])
+         [rtx# & args#]
+         (invoke {:command ~command-id :measured false :composite ~(not measured)
+                  :requires ~(:requires options)}
+                 rtx# ~prepare args#))
+       ~@(when measured
+           [`(defn ~starred
+               ~(str "Measured variant of `" command "`." (when doc (str " " doc)))
+               [rtx# & args#]
+               (invoke {:command ~command-id :measured true :composite false
+                        :requires ~(:requires options)}
+                       rtx# ~prepare args#))]))))

frontend/performance/benches/render_wasm/runtime/commands.cljs

@@ -0,0 +1,127 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS SUBSIDIARY SL
+
+(ns benches.render-wasm.runtime.commands
+  "Renderer commands and collection of raw command observations."
+  (:require-macros [benches.render-wasm.runtime.commands])
+  (:require
+   [app.common.schema :as sm]
+   [benches.render-wasm.declarations :as decl]
+   [benches.render-wasm.errors :as errors :refer [attempt failure?]]))
+
+(def ^:private schema:context
+  [:map {:closed true}
+   [:case [:map [:id qualified-keyword?]]]
+   [:scene [:map [:objects map?] [:refs map?]]]
+   [:view decl/schema:view]
+   [:hooks [:and
+            [:map-of :keyword fn?]
+            [:map [:now fn?] [:check fn?]]]]])
+
+(def ^:private valid-context? (sm/validator schema:context))
+(def ^:private owners (js/WeakMap.))
+
+(defn- check-context
+  [rtx]
+  (when-not (valid-context? rtx)
+    (throw (ex-info "invalid command context"
+                    {:type ::invalid-context
+                     ::sm/explain (sm/explain schema:context rtx)}))))
+
+(defn- check-output
+  [rtx output]
+  (check-context output)
+  (when-not (identical? (get-in rtx [:hooks :check])
+                        (get-in output [:hooks :check]))
+    (throw (ex-info "command changed execution ownership"
+                    {:type ::ownership-lost})))
+  ((get-in rtx [:hooks :check]))
+  output)
+
+(defn- scope-context
+  [rtx events active]
+  (check-context rtx)
+  (let [previous-check (get-in rtx [:hooks :check])
+        previous-owner (.get owners previous-check)
+        base-check     (or (:base-check previous-owner) previous-check)
+        check          (fn []
+                         (when-not @active
+                           (throw (ex-info "command execution has ended"
+                                           {:type ::inactive-execution})))
+                         (base-check))
+        scoped         (assoc-in rtx [:hooks :check] check)]
+    (.set owners check {:base-check base-check
+                        :record #(do (check) (vswap! events conj %))})
+    (check)
+    scoped))
+
+(defn ^:async ^:no-doc execute
+  "Executes a context function and returns its outcome and ordered raw events.
+  A completed execution includes its updated context. A failed execution
+  includes its cause and any events recorded before failure."
+  [rtx run]
+  (let [events (volatile! [])
+        active (volatile! true)
+        result (try
+                 (attempt :catch-fatal
+                          (let [scoped (scope-context (await rtx) events active)]
+                            (check-output scoped (await (run scoped)))))
+                 (finally
+                   (vreset! active false)))]
+    (if (failure? result)
+      {:outcome :failed :error result :events @events}
+      {:outcome :completed :context result :events @events})))
+
+(defn- prepare-invocation
+  [{:keys [command measured requires] :as invocation} rtx prepare args]
+  (check-context rtx)
+  (let [{:keys [check now] :as hooks} (:hooks rtx)
+        owner                       (.get owners check)]
+    (when-not (sm/validate (into [:map] (map #(vector % fn?) requires)) hooks)
+      (throw (ex-info "command requires callable hooks"
+                      {:type ::invalid-capabilities :command command
+                       :required requires})))
+    (check)
+    (when (and measured (nil? owner))
+      (throw (ex-info "measured command requires an execution"
+                      {:type ::missing-execution :command command})))
+    (assoc invocation
+           :input rtx
+           :core (apply prepare rtx args)
+           :now now
+           :record (:record owner))))
+
+(defn- run-core
+  [{:keys [command measured composite core now] :as invocation}]
+  (if composite
+    (assoc invocation :output (core))
+    (let [start  (when measured (now))
+          output (core)
+          end    (when measured (now))]
+      (when (and (some? output) (fn? (.-then output)))
+        (.catch (js/Promise.resolve output) errors/as-failure)
+        (throw (ex-info "synchronous command returned asynchronous work"
+                        {:type ::async-result :command command})))
+      (cond-> (assoc invocation :output output)
+        measured (assoc :elapsed (- end start))))))
+
+(defn- finish-invocation
+  [{:keys [command measured input output elapsed record]}]
+  (check-output input output)
+  (when measured
+    (record {:command command :metrics {:command/elapsed [elapsed]}}))
+  output)
+
+(defn ^:async invoke
+  "Resolves a command input and executes its declared core.
+  Measured invocations append one raw elapsed observation to their execution."
+  [command rtx prepare args]
+  (let [invocation (prepare-invocation command (await rtx) prepare args)
+        result     (run-core invocation)]
+    (finish-invocation
+     (if (:composite command)
+       (assoc result :output (await (:output result)))
+       result))))

frontend/test/performance_tests/render_wasm/commands_test.cljs

@@ -0,0 +1,196 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS SUBSIDIARY SL
+
+(ns performance-tests.render-wasm.commands-test
+  (:require
+   [benches.render-wasm.builder :as builder]
+   [benches.render-wasm.errors :as errors]
+   [benches.render-wasm.runtime.camera :as camera]
+   [benches.render-wasm.runtime.commands :as cmd :refer [defcommand]]
+   [cljs.test :as t]))
+
+(defcommand move
+  "Moves the camera by the supplied offset."
+  [rtx {:keys [dx dy]}]
+  (-> rtx
+      (update-in [:view :x] + dx)
+      (update-in [:view :y] + dy)))
+
+(defcommand selected-renders
+  {:measured-variant false}
+  [rtx]
+  (-> rtx
+      (camera/render-sync*)
+      (move {:dx 10 :dy 5})
+      (camera/render-sync)
+      (camera/render-sync*)))
+
+(defcommand unexpected-promise
+  [rtx cause]
+  (if cause
+    (js/Promise.reject cause)
+    (js/Promise.resolve rtx)))
+
+(defcommand reject-offset
+  [rtx offset]
+  {:pre [(pos? offset)]}
+  ((get-in rtx [:hooks :render-sync]))
+  (update-in rtx [:view :x] + offset))
+
+(defcommand replace-owner
+  [rtx]
+  (assoc-in rtx [:hooks :check] (fn [])))
+
+(defn- context
+  [clock]
+  {:case {:id :commands/example}
+   :scene (builder/scene {:seed 1})
+   :view {:scale 1 :x 0 :y 0}
+   :hooks {:now #(deref clock)
+           :check (fn [])
+           :render-sync #(vswap! clock + 7)}})
+
+(t/deftest ^:async measurement-uses-core-time
+  (let [clock (volatile! 0)
+        rtx   (assoc-in (context clock) [:hooks :render-sync]
+                        #(do
+                           (vswap! clock + 7)
+                           (js/queueMicrotask (fn [] (vswap! clock + 500)))))
+        {:keys [outcome events context]}
+        (await
+         (cmd/execute
+          rtx
+          (fn [rtx]
+            (let [input (-> (js/Promise.resolve rtx)
+                            (.then (fn [rtx]
+                                     (vswap! clock + 1000)
+                                     rtx)))]
+              (-> (camera/render-sync* input)
+                  (.then (fn [rtx]
+                           (vswap! clock + 2000)
+                           rtx)))))))]
+    (t/is (= :completed outcome))
+    (t/is (= (:view rtx) (:view context)))
+    (t/is (= [{:command ::camera/render-sync
+               :metrics {:command/elapsed [7]}}]
+             events))
+    (t/is (= 3507 @clock))))
+
+(t/deftest ^:async composite-preserves-view-and-selected-observations
+  (doseq [promised [false true]]
+    (let [clock (volatile! 0)
+          cost  (volatile! 0)
+          rtx   (assoc-in (context clock) [:hooks :render-sync]
+                          #(vswap! clock + (vswap! cost + 7)))
+          {:keys [outcome context events]}
+          (await (cmd/execute rtx #(selected-renders
+                                    (if promised (js/Promise.resolve %) %))))]
+      (t/is (= :completed outcome))
+      (t/is (= {:scale 1 :x 10 :y 5} (:view context)))
+      (t/is (= [{:command ::camera/render-sync
+                 :metrics {:command/elapsed [7]}}
+                {:command ::camera/render-sync
+                 :metrics {:command/elapsed [21]}}]
+               events))
+      (t/is (= 42 @clock)))))
+
+(t/deftest measured-command-documentation
+  (t/is (.startsWith (:doc (meta #'camera/render-sync*))
+                     "Measured variant of `render-sync`."))
+  (t/is (= "Measured variant of `unexpected-promise`."
+           (:doc (meta #'unexpected-promise*)))))
+
+(t/deftest ^:async zero-duration-is-a-raw-observation
+  (let [rtx    (context (volatile! 0))
+        result (await (cmd/execute rtx #(move* % {:dx 2 :dy 3})))]
+    (t/is (= :completed (:outcome result)))
+    (t/is (= {:scale 1 :x 2 :y 3} (get-in result [:context :view])))
+    (t/is (= [{:command ::move :metrics {:command/elapsed [0]}}]
+             (:events result)))))
+
+(t/deftest ^:async failed-work-retains-earlier-observations
+  (let [unhandled (atom [])
+        observe   #(swap! unhandled conj %)]
+    (.on js/process "unhandledRejection" observe)
+    (try
+      (doseq [cause [nil (js/Error. "rejected core")]]
+        (let [rtx    (context (volatile! 0))
+              result (await (cmd/execute rtx #(-> %
+                                                  (camera/render-sync*)
+                                                  (unexpected-promise* cause))))]
+          (t/is (= :failed (:outcome result)))
+          (t/is (= ::cmd/async-result (:type (ex-data (:error result)))))
+          (t/is (= [{:command ::camera/render-sync
+                     :metrics {:command/elapsed [7]}}]
+                   (:events result)))))
+      (await (js/Promise. #(js/setImmediate %)))
+      (t/is (= [] @unhandled))
+      (finally
+        (.removeListener js/process "unhandledRejection" observe)))))
+
+(t/deftest ^:async execution-failures-preserve-causes-and-earlier-observations
+  (doseq [cause [(js/Error. "renderer failed")
+                 "renderer disconnected"
+                 {:reason :renderer-disconnected}
+                 (errors/fatal-error "recording failed" {} (js/Error. "storage"))]]
+    (let [clock  (volatile! 0)
+          rtx    (assoc-in (context clock) [:hooks :render-sync]
+                           #(if (zero? @clock)
+                              (vswap! clock + 7)
+                              (throw cause)))
+          result (await (cmd/execute rtx #(-> %
+                                              (camera/render-sync*)
+                                              (camera/render-sync*))))
+          error  (:error result)]
+      (t/is (= :failed (:outcome result)))
+      (t/is (errors/failure? error))
+      (if (errors/failure? cause)
+        (t/is (identical? cause error))
+        (t/is (= cause (:thrown (ex-data error)))))
+      (t/is (= [{:command ::camera/render-sync
+                 :metrics {:command/elapsed [7]}}]
+               (:events result))))))
+
+(t/deftest ^:async invalid-boundaries-fail-the-execution
+  (doseq [[input command expected]
+          [[#(assoc-in % [:view :scale] 0) camera/render-sync* ::cmd/invalid-context]
+           [#(assoc % :module #js {}) camera/render-sync* ::cmd/invalid-context]
+           [#(update % :hooks dissoc :render-sync) camera/render-sync* ::cmd/invalid-capabilities]
+           [identity #(reject-offset* % -1) ::cmd/invalid-arguments]]]
+    (let [clock     (volatile! 0)
+          now-reads (volatile! 0)
+          rtx       (assoc-in (context clock) [:hooks :now]
+                              #(do (vswap! now-reads inc) @clock))
+          result    (await (cmd/execute rtx #(command (input %))))]
+      (t/is (= :failed (:outcome result)))
+      (t/is (= expected (:type (ex-data (:error result)))))
+      (t/is (= [] (:events result)))
+      (t/is (zero? @now-reads))
+      (t/is (zero? @clock)))))
+
+(t/deftest ^:async commands-enforce-execution-ownership
+  (let [rtx    (context (volatile! 0))
+        result (await (cmd/execute rtx replace-owner*))
+        cause  (await (.then (camera/render-sync* rtx) (fn [_] nil) identity))]
+    (t/is (= :failed (:outcome result)))
+    (t/is (= ::cmd/ownership-lost (:type (ex-data (:error result)))))
+    (t/is (= [] (:events result)))
+    (t/is (= ::cmd/missing-execution (:type (ex-data cause))))))
+
+(t/deftest ^:async completed-context-starts-a-new-execution
+  (let [first-result (await (cmd/execute (context (volatile! 0))
+                                         #(move* % {:dx 10 :dy 5})))
+        rtx          (:context first-result)
+        late-error   (await (.then (camera/render-sync* rtx)
+                                   (fn [_] nil)
+                                   identity))
+        next-result  (await (cmd/execute rtx camera/render-sync*))]
+    (t/is (= ::cmd/inactive-execution (:type (ex-data late-error))))
+    (t/is (= :completed (:outcome next-result)))
+    (t/is (= {:scale 1 :x 10 :y 5} (get-in next-result [:context :view])))
+    (t/is (= [{:command ::camera/render-sync
+               :metrics {:command/elapsed [7]}}]
+             (:events next-result)))))