SpindleyQ/hottub
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

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

Browse source
This commit is contained in:
Jeremy Penner 2013-04-30 17:15:41 -04:00
parent de29d67036
commit 4d0dd8ba8d
2 changed files with 34 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
src/hottub/stm.clj
View file

@ -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]]

2
test/hottub/test/core.clj
View file

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