Change "value" of stm to be the stm itself, since it couldn't be nil anyway

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 state [stm] (::state stm))
-(defn value [stm] (:value 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)]
+          (if-let [stmreturn (::return-to stm)]
-            (let [stmreturn (assoc stmreturn :events (:events stm))]
+            (let [stmreturn (assoc stmreturn ::events (::events stm))]
-              (recur (post-event stmreturn {:id ::return :stmid (:id stm) :state (:state stm) :value (:value stm)}) :events))
+              (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 
+  (let [stm (assoc (or value {}) 
-             :state (start-state-for-stm stmid) 
+                   ::id stmid 
-             :value (or value {})
+                   ::state (start-state-for-stm stmid) 
-             :events clojure.lang.PersistentQueue/EMPTY}]
+                   ::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))
+        stmnew (stm-from-value stm result)
-        stm (if (:advances opts) (goto stm statenext (value stm)) stm)]
+        stmnew (if (and (:advances opts) (= (::state stm) (::state stmnew))) (goto stmnew statenext) stmnew)]
-    stm))
+    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]]

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))