diff --git a/src/hottub/stm.clj b/src/hottub/stm.clj index 0c5e753..9e7506e 100644 --- a/src/hottub/stm.clj +++ b/src/hottub/stm.clj @@ -1,10 +1,10 @@ (ns hottub.stm) -(defn- dispatch-id-state [stm] [(:id stm) (:state stm)]) +(defn- dispatch-id-state [stm] [(::id stm) (::state stm)]) (defmulti enter-state dispatch-id-state) (defmulti exit-state dispatch-id-state) (defmulti on-event (fn [stm event] (dispatch-id-state stm))) -(defmulti event-matches (fn [stm eventtype event] (:id stm))) +(defmulti event-matches (fn [stm eventtype event] (::id stm))) (defmulti on-call dispatch-id-state) (defmulti start-state-for-stm (fn [stmid] stmid)) @@ -13,24 +13,31 @@ (defmethod enter-state :default [stm] nil) (defmethod exit-state :default [stm]) (defmethod on-event :default [stm event] nil) -(defmethod event-matches :default [stm eventtype event] (= eventtype (:type event))) +(defmethod event-matches :default [stm eventtype event] (or (nil? eventtype) (= eventtype (:type event)))) (defmethod on-call :default [stm] nil) (defmethod start-state-for-stm :default [stmid] :start) -(defmethod is-end-state :default [stm] (= (:state stm) :end)) +(defmethod is-end-state :default [stm] (= (::state stm) :end)) -(defn state [stm] (:state stm)) -(defn value [stm] (:value stm)) +(defn state [stm] (::state stm)) + +(defn- stm-from-value [stm value] + (if (nil? value) + stm + (assoc value ::state (or (::state value) (::state stm)) + ::events (or (::events value) (::events stm)) + ::id (::id stm) + ::return-to (::return-to stm)))) (defn goto [stm state & [value]] - (assoc stm :state state :value (or value (:value stm)))) + (assoc (stm-from-value stm value) ::state state)) (defn post-event [stm event] - (assoc stm :events (conj (:events stm) event))) + (assoc stm ::events (conj (::events stm) event))) (defn- transition [stepnext fntrans stmold & args] (if-let [stmnew (apply fntrans stmold args)] - (if-not (= (:state stmnew) (:state stmold)) + (if-not (= (::state stmnew) (::state stmold)) (do (exit-state stmold) [stmnew :enter]) @@ -40,7 +47,7 @@ (declare start) (defn- process-state [stm step] - ;(println step (:state stm) (:value stm) (seq (:events stm))) + ;(println step (::state stm) (::value stm) (seq (::events stm))) (case step :enter (let [[stmnew stepnext] (transition :return-from enter-state stm)] @@ -49,19 +56,19 @@ (if (is-end-state stm) (do (exit-state stm) - (if-let [stmreturn (:return-to stm)] - (let [stmreturn (assoc stmreturn :events (:events stm))] - (recur (post-event stmreturn {:id ::return :stmid (:id stm) :state (:state stm) :value (:value stm)}) :events)) + (if-let [stmreturn (::return-to stm)] + (let [stmreturn (assoc stmreturn ::events (::events stm))] + (recur (post-event stmreturn (dissoc (assoc stm ::id ::return ::stmid (::id stm)) ::events)) ::events)) nil)) (recur stm :call)) :call (if-let [[stmid value] (on-call stm)] - (recur (assoc (start stmid value) :return-to (dissoc stm :events) :events (:events stm)) :events) + (recur (assoc (start stmid value) ::return-to (dissoc stm ::events) ::events (::events stm)) :events) (recur stm :events)) :events - (let [queue (:events stm) + (let [queue (::events stm) event (first queue) - stm (if event (assoc stm :events (pop queue)) stm)] + stm (if event (assoc stm ::events (pop queue)) stm)] (if event (let [[stmnew stepnext] (transition :events on-event stm event)] (recur stmnew stepnext)) @@ -69,10 +76,10 @@ stm)) (defn start [stmid & [value]] - (let [stm {:id stmid - :state (start-state-for-stm stmid) - :value (or value {}) - :events clojure.lang.PersistentQueue/EMPTY}] + (let [stm (assoc (or value {}) + ::id stmid + ::state (start-state-for-stm stmid) + ::events clojure.lang.PersistentQueue/EMPTY)] (process-state stm :enter))) (defn run [stm & events] @@ -92,11 +99,9 @@ [(first handlerspec) (next handlerspec)] optsimplicit (if (:implicit-state optsdefault) - {:returns-value true - :advances (not= handlertype ::enter) + {:advances (not= handlertype ::enter) :pass-next-state false} - {:returns-value false - :advances false + {:advances false :pass-next-state false}) [optsoverridden args] (if (map? (first args)) @@ -162,12 +167,11 @@ (defn call-stmfunc [fn opts args statenext] (let [stm (first args) - args (if (:returns-value opts) (cons (value stm) (next args)) args) args (if (:pass-next-state opts) (concat args [statenext]) args) result (apply fn args) - stm (if (:returns-value opts) (goto stm (state stm) result) (or result stm)) - stm (if (:advances opts) (goto stm statenext (value stm)) stm)] - stm)) + stmnew (stm-from-value stm result) + stmnew (if (and (:advances opts) (= (::state stm) (::state stmnew))) (goto stmnew statenext) stmnew)] + stmnew)) (defn- handler-matches [stm handler event] (and (event-matches stm (:eventtype handler) event) @@ -197,7 +201,7 @@ [(first args) [(gensym)] nil] (first args))] `(defmethod on-call [~stmid ~state] [stm#] - (start ~stmidcall ((fn ~@(ensure-fnbody 1 body)) (value stm#)))))] + (start ~stmidcall ((fn ~@(ensure-fnbody 1 body)) stm#))))] []))) (defn- out-event-handler [stmid state optsdefault statenext [handlertype opts & args]] diff --git a/test/hottub/test/core.clj b/test/hottub/test/core.clj index cdeb844..3c4365e 100644 --- a/test/hottub/test/core.clj +++ b/test/hottub/test/core.clj @@ -9,7 +9,7 @@ (contains? (:mousebuttons input) :left)) (stm/defstm ::click - [(::stm/enter {:returns-value false} [stm] + [(::stm/enter [stm] (let [input-now (:input (first (gs/q :name :input))) stm (stm/post-event stm (assoc input-now :type :input))] stm))