statecharts.clj

(ns statecharts
  (:require [clojure.set :as set]))

(def states
  (-> (make-hierarchy)
      (derive ::update ::displays)
      (derive ::wait ::displays)
      (derive ::time ::displays)
      (derive ::date ::displays)
      (derive ::alarm1 ::displays)
      (derive ::alarm2 ::displays)
      (derive ::chime ::displays)
      (derive ::stopwatch ::displays)
      (derive ::update1 ::displays)
      (derive ::update2 ::displays)
      (derive ::alarm1-off ::alarm1)
      (derive ::alarm1-on ::alarm1)
      (derive ::alarm2-off ::alarm2)
      (derive ::alarm2-on ::alarm2)
      (derive ::chime-on ::chime)
      (derive ::chime-off ::chime)))

(def transitions
  {::wait       {::2-sec-in-wait ::update
                 ::hat-c         ::time}
   ::update     {::b ::time}
   ::time       {::a ::alarm1
                 ::c ::wait
                 ::d ::date}
   ::date       {::d             ::time
                 ::2-min-in-date ::time}
   ::alarm1     {::a ::alarm2
                 ::c ::update1}
   ::alarm1-off {::d ::alarm1-on}
   ::alarm1-on  {::d ::alarm1-off}
   ::alarm2     {::c ::update2
                 ::a ::chime}
   ::chime      {::a ::stopwatch}
   ::stopwatch  {::a ::time}
   ::update1    {::b ::alarm1}
   ::update2    {::b ::alarm2}
   ::alarm2-off {::d ::alarm2-on}
   ::alarm2-on  {::d ::alarm2-off}
   ::chime-on   {::d ::chime-off}
   ::chime-off  {::d ::chime-on}})

(def initial-states
  {::displays ::time
   ::chime    ::chime-off
   ::alarm1   ::alarm1-off
   ::alarm2   ::alarm2-off})

(defn state-descendants [s] (into #{s} (descendants states s)))
(defn state-ancestors [s] (into #{s} (ancestors states s)))

(defn do-step
  [fsm from to]
  (let [leaving-set (set/intersection fsm (state-descendants from))
        entering-set (state-ancestors to)
        entering-set (set/difference entering-set fsm)
        entering-set (into entering-set (keep initial-states entering-set))]
    {:fsm'         (-> fsm
                       (disj leaving-set)
                       (conj entering-set))
     :leaving-set  leaving-set
     :entering-set entering-set}))

(let [fsm #{::displays ::alarm2 ::alarm2-on}
      txns (mapcat (comp keys transitions) fsm)]
  (println "before: " fsm)
  (doseq [t txns]
    (doseq [from fsm]
      (when-let [to (get-in transitions [from t])]
        (clojure.pprint/pprint
          {:from from
           :txn  t
           :to   to
           :step (do-step fsm from to)})))))