Advertisement
Guest User

Untitled

a guest
Aug 24th, 2019
99
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.40 KB | None | 0 0
  1. (ns statecharts
  2. (:require [clojure.set :as set]))
  3.  
  4. (def states
  5. (-> (make-hierarchy)
  6. (derive ::update ::displays)
  7. (derive ::wait ::displays)
  8. (derive ::time ::displays)
  9. (derive ::date ::displays)
  10. (derive ::alarm1 ::displays)
  11. (derive ::alarm2 ::displays)
  12. (derive ::chime ::displays)
  13. (derive ::stopwatch ::displays)
  14. (derive ::update1 ::displays)
  15. (derive ::update2 ::displays)
  16. (derive ::alarm1-off ::alarm1)
  17. (derive ::alarm1-on ::alarm1)
  18. (derive ::alarm2-off ::alarm2)
  19. (derive ::alarm2-on ::alarm2)
  20. (derive ::chime-on ::chime)
  21. (derive ::chime-off ::chime)))
  22.  
  23. (def transitions
  24. {::wait {::2-sec-in-wait ::update
  25. ::hat-c ::time}
  26. ::update {::b ::time}
  27. ::time {::a ::alarm1
  28. ::c ::wait
  29. ::d ::date}
  30. ::date {::d ::time
  31. ::2-min-in-date ::time}
  32. ::alarm1 {::a ::alarm2
  33. ::c ::update1}
  34. ::alarm1-off {::d ::alarm1-on}
  35. ::alarm1-on {::d ::alarm1-off}
  36. ::alarm2 {::c ::update2
  37. ::a ::chime}
  38. ::chime {::a ::stopwatch}
  39. ::stopwatch {::a ::time}
  40. ::update1 {::b ::alarm1}
  41. ::update2 {::b ::alarm2}
  42. ::alarm2-off {::d ::alarm2-on}
  43. ::alarm2-on {::d ::alarm2-off}
  44. ::chime-on {::d ::chime-off}
  45. ::chime-off {::d ::chime-on}})
  46.  
  47. (def initial-states
  48. {::displays ::time
  49. ::chime ::chime-off
  50. ::alarm1 ::alarm1-off
  51. ::alarm2 ::alarm2-off})
  52.  
  53. (defn state-descendants [s] (into #{s} (descendants states s)))
  54. (defn state-ancestors [s] (into #{s} (ancestors states s)))
  55.  
  56. (defn do-step
  57. [fsm from to]
  58. (let [leaving-set (set/intersection fsm (state-descendants from))
  59. entering-set (state-ancestors to)
  60. entering-set (set/difference entering-set fsm)
  61. entering-set (into entering-set (keep initial-states entering-set))]
  62. {:fsm' (-> fsm
  63. (disj leaving-set)
  64. (conj entering-set))
  65. :leaving-set leaving-set
  66. :entering-set entering-set}))
  67.  
  68. (let [fsm #{::displays ::alarm2 ::alarm2-on}
  69. txns (mapcat (comp keys transitions) fsm)]
  70. (println "before: " fsm)
  71. (doseq [t txns]
  72. (doseq [from fsm]
  73. (when-let [to (get-in transitions [from t])]
  74. (clojure.pprint/pprint
  75. {:from from
  76. :txn t
  77. :to to
  78. :step (do-step fsm from to)})))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement