fix state machine bugs
This commit is contained in:
parent
5548363a06
commit
69c533ceec
|
@ -29,7 +29,7 @@
|
||||||
::id (::id stm)
|
::id (::id stm)
|
||||||
::return-to (::return-to stm))))
|
::return-to (::return-to stm))))
|
||||||
|
|
||||||
(defn goto [stm state & [value]]
|
(defn goto [stm state & [value]]
|
||||||
(assoc (stm-from-value stm value) ::state state))
|
(assoc (stm-from-value stm value) ::state state))
|
||||||
|
|
||||||
(defn post-event [stm event]
|
(defn post-event [stm event]
|
||||||
|
@ -49,8 +49,8 @@
|
||||||
(defn- process-state [stm step]
|
(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
|
(case step
|
||||||
:enter
|
:enter
|
||||||
(let [[stmnew stepnext] (transition :return-from enter-state stm)]
|
(let [[stmnew stepnext] (transition :return-from enter-state stm)]
|
||||||
(recur stmnew stepnext))
|
(recur stmnew stepnext))
|
||||||
:return-from
|
:return-from
|
||||||
(if (is-end-state stm)
|
(if (is-end-state stm)
|
||||||
|
@ -75,10 +75,10 @@
|
||||||
stm))
|
stm))
|
||||||
stm))
|
stm))
|
||||||
|
|
||||||
(defn start [stmid & [value]]
|
(defn start [stmid & [value]]
|
||||||
(let [stm (assoc (or value {})
|
(let [stm (assoc (or value {})
|
||||||
::id stmid
|
::id stmid
|
||||||
::state (start-state-for-stm stmid)
|
::state (start-state-for-stm stmid)
|
||||||
::events clojure.lang.PersistentQueue/EMPTY)]
|
::events clojure.lang.PersistentQueue/EMPTY)]
|
||||||
(process-state stm :enter)))
|
(process-state stm :enter)))
|
||||||
|
|
||||||
|
@ -114,9 +114,9 @@
|
||||||
`(~handlertype ~opts ~@args)))
|
`(~handlertype ~opts ~@args)))
|
||||||
|
|
||||||
(defn- normalize-statespec [statespec statedefault]
|
(defn- normalize-statespec [statespec statedefault]
|
||||||
(let [state-defined
|
(let [state-defined
|
||||||
(keyword? (first statespec))
|
(keyword? (first statespec))
|
||||||
[state args]
|
[state args]
|
||||||
(if state-defined
|
(if state-defined
|
||||||
[(first statespec) (next statespec)]
|
[(first statespec) (next statespec)]
|
||||||
[statedefault statespec])
|
[statedefault statespec])
|
||||||
|
@ -130,23 +130,23 @@
|
||||||
`(~state ~opts ~@(map #(normalize-handlerspec % opts) handlerspecs))))
|
`(~state ~opts ~@(map #(normalize-handlerspec % opts) handlerspecs))))
|
||||||
|
|
||||||
(defn- states-from-specs [statespecs start-state]
|
(defn- states-from-specs [statespecs start-state]
|
||||||
(loop [states []
|
(loop [states []
|
||||||
statespecs statespecs
|
statespecs statespecs
|
||||||
statenext start-state
|
statenext start-state
|
||||||
statenextindex 0]
|
statenextindex 0]
|
||||||
|
|
||||||
(if (empty? statespecs)
|
(if (empty? statespecs)
|
||||||
(conj states :end)
|
(conj states :end)
|
||||||
(let [statespec
|
(let [statespec
|
||||||
(first statespecs)
|
(first statespecs)
|
||||||
given-state
|
given-state
|
||||||
(if (keyword? (first statespec))
|
(if (keyword? (first statespec))
|
||||||
(first statespec))
|
(first statespec))
|
||||||
state
|
state
|
||||||
(or given-state (keyword (str (name statenext) (if (= statenextindex 0) "" statenextindex))))]
|
(or given-state (keyword (str (name statenext) (if (= statenextindex 0) "" statenextindex))))]
|
||||||
|
|
||||||
(recur (conj states state)
|
(recur (conj states state)
|
||||||
(next statespecs)
|
(next statespecs)
|
||||||
(if given-state given-state statenext)
|
(if given-state given-state statenext)
|
||||||
(if given-state 1 (+ statenextindex 1)))))))
|
(if given-state 1 (+ statenextindex 1)))))))
|
||||||
|
|
||||||
|
@ -186,8 +186,8 @@
|
||||||
((:fnhandler handler) stm event))))
|
((:fnhandler handler) stm event))))
|
||||||
|
|
||||||
(defn- out-stmfnbody [body opts statenext]
|
(defn- out-stmfnbody [body opts statenext]
|
||||||
`[[& args#] (call-stmfunc (fn ~@body) ~opts args# ~statenext)])
|
`[[& args#] (call-stmfunc (fn ~@body) ~opts args# ~statenext)])
|
||||||
|
|
||||||
(defn- out-def-handler [stmid state optsdefault statenext [handlertype opts & args]]
|
(defn- out-def-handler [stmid state optsdefault statenext [handlertype opts & args]]
|
||||||
(let [opts (into optsdefault opts)]
|
(let [opts (into optsdefault opts)]
|
||||||
(case handlertype
|
(case handlertype
|
||||||
|
@ -196,11 +196,11 @@
|
||||||
::exit
|
::exit
|
||||||
[`(defmethod exit-state [~stmid ~state] ~@(out-stmfnbody opts statenext 1 args))]
|
[`(defmethod exit-state [~stmid ~state] ~@(out-stmfnbody opts statenext 1 args))]
|
||||||
::call
|
::call
|
||||||
[(let [[stmidcall & body]
|
[(let [[stmidcall & body]
|
||||||
(if (keyword? (first args))
|
(if (keyword? (first args))
|
||||||
[(first args) [(gensym)] nil]
|
[(first args) [(gensym)] nil]
|
||||||
(first args))]
|
(first args))]
|
||||||
`(defmethod on-call [~stmid ~state] [stm#]
|
`(defmethod on-call [~stmid ~state] [stm#]
|
||||||
(start ~stmidcall ((fn ~@(ensure-fnbody 1 body)) stm#))))]
|
(start ~stmidcall ((fn ~@(ensure-fnbody 1 body)) stm#))))]
|
||||||
[])))
|
[])))
|
||||||
|
|
||||||
|
@ -211,7 +211,7 @@
|
||||||
::call
|
::call
|
||||||
[(let [body (next args)]
|
[(let [body (next args)]
|
||||||
`{:eventtype ::return :fnhandler (fn ~@(out-stmfnbody body opts statenext))})]
|
`{:eventtype ::return :fnhandler (fn ~@(out-stmfnbody body opts statenext))})]
|
||||||
[(let [[fnguard body] (if (vector? (first args)) [nil args] args)]
|
[(let [[fnguard & body] (if (vector? (first args)) [nil args] args)]
|
||||||
`{:eventtype ~handlertype :fnguard ~fnguard :fnhandler (fn ~@(out-stmfnbody (ensure-fnbody 2 body) opts statenext))})])))
|
`{:eventtype ~handlertype :fnguard ~fnguard :fnhandler (fn ~@(out-stmfnbody (ensure-fnbody 2 body) opts statenext))})])))
|
||||||
|
|
||||||
(defn- out-def-state [stmid [state opts & handlerspecs] statenext]
|
(defn- out-def-state [stmid [state opts & handlerspecs] statenext]
|
||||||
|
@ -220,12 +220,12 @@
|
||||||
[`(let [handlers# [~@(apply concat (map #(out-event-handler stmid state opts statenext %) handlerspecs))]]
|
[`(let [handlers# [~@(apply concat (map #(out-event-handler stmid state opts statenext %) handlerspecs))]]
|
||||||
(defmethod on-event [~stmid ~state] [stm# event#]
|
(defmethod on-event [~stmid ~state] [stm# event#]
|
||||||
(call-eventhandlers stm# event# handlers#)))]))
|
(call-eventhandlers stm# event# handlers#)))]))
|
||||||
|
|
||||||
(defmacro defstm [stmid & args]
|
(defmacro defstm [stmid & args]
|
||||||
(let [stmopts
|
(let [stmopts
|
||||||
{:start-state :start}
|
{:start-state :start}
|
||||||
[stmopts statespecs]
|
[stmopts statespecs]
|
||||||
(if (map? (first args))
|
(if (map? (first args))
|
||||||
[(into stmopts (first args)) (next args)]
|
[(into stmopts (first args)) (next args)]
|
||||||
[stmopts args])
|
[stmopts args])
|
||||||
states
|
states
|
||||||
|
@ -234,7 +234,7 @@
|
||||||
(map normalize-statespec statespecs states)
|
(map normalize-statespec statespecs states)
|
||||||
endstates
|
endstates
|
||||||
(filter #(:is-end-state (second %)) statespecs)
|
(filter #(:is-end-state (second %)) statespecs)
|
||||||
sstmid
|
sstmid
|
||||||
(gensym "stmid")]
|
(gensym "stmid")]
|
||||||
`(let [~sstmid ~stmid]
|
`(let [~sstmid ~stmid]
|
||||||
(remove-stm ~sstmid)
|
(remove-stm ~sstmid)
|
||||||
|
|
Loading…
Reference in a new issue