refactor cell and prop-net as records that implement protocols
This commit is contained in:
parent
064d737ac0
commit
b4647fb2a8
1 changed files with 89 additions and 81 deletions
|
@ -1,101 +1,109 @@
|
|||
(ns prop-net.naive-scalar-net
|
||||
(:require [clojure.core.match :refer [match]]))
|
||||
(ns prop-net.naive-scalar-net)
|
||||
|
||||
|
||||
|
||||
|
||||
;; private definitions at the ns scope so that cells can access them, but
|
||||
;; everything must be accessed through the prop-network closure itself
|
||||
|
||||
;; temporary set of props to alert on each run
|
||||
(def ^:private alerted-propagators (atom #{}))
|
||||
(def ^:private last-value-of-run (atom :done))
|
||||
;; this might be for tracking? can't remember rn
|
||||
(def ^:private propagators-ever-alerted (atom #{}))
|
||||
|
||||
;; cells is a map with each keyword being an identifier for the cell
|
||||
;; this makes lookup easier as callers to prop-net do not need to hold
|
||||
;; on to references of the cells themselves
|
||||
(def ^:private cells (atom {}))
|
||||
|
||||
(def ^:private nothing [])
|
||||
(defn- nothing? [thing] (= thing nothing))
|
||||
|
||||
(defn- alert-propagators [& propagators]
|
||||
(run! (fn [propagator]
|
||||
(if (not (fn? propagator))
|
||||
(throw (ex-info "Alerting a non-procedure" #{:propagator propagator})))
|
||||
(print propagator)
|
||||
(when (not (fn? propagator))
|
||||
(throw (ex-info "Alerting a non-procedure" {:propagator propagator})))
|
||||
(swap! propagators-ever-alerted #(conj % propagator))
|
||||
(swap! alerted-propagators #(conj % propagator)))))
|
||||
(swap! alerted-propagators #(conj % propagator)))
|
||||
propagators))
|
||||
|
||||
(defn- alert-propagator [p]
|
||||
(alert-propagators p))
|
||||
|
||||
;; TODO check that adding a neighbor always adds propagator to this set
|
||||
;; and they are never removed
|
||||
(defn- alert-all-propagators []
|
||||
(apply alert-propagators (vector @propagators-ever-alerted)))
|
||||
;; ;; TODO check that adding a neighbor always adds propagator to this set
|
||||
;; ;; and they are never removed
|
||||
;; (defn- alert-all-propagators []
|
||||
;; (apply alert-propagators (vector @propagators-ever-alerted)))
|
||||
|
||||
(defprotocol ICell
|
||||
(neighbors [this])
|
||||
(content [this])
|
||||
(add-content! [this increment])
|
||||
(new-neighbor! [this new-neighbor]))
|
||||
|
||||
(defn- make-cell []
|
||||
(let [neighbors (atom #{})
|
||||
content (atom nothing)
|
||||
add-content* (fn [increment]
|
||||
(cond (nothing? increment) 'ok
|
||||
(nothing? @content) (do (reset! content increment)
|
||||
(apply alert-propagators (vector @neighbors)))
|
||||
:else (if (not (= @content increment))
|
||||
(throw (ex-info "Inconsistency!"
|
||||
{:content @content
|
||||
:increment increment})))))
|
||||
new-neighbor*! (fn [new-neighbor]
|
||||
(if (not (contains? @neighbors new-neighbor))
|
||||
(do (swap! neighbors #(conj %1 new-neighbor))
|
||||
(alert-propagator new-neighbor))))
|
||||
closure (fn [message]
|
||||
(match [message]
|
||||
['content] @content
|
||||
['add-content] add-content*
|
||||
['new-neighbor!] new-neighbor*!
|
||||
:else (throw (ex-info "Unknown message to cell"
|
||||
{:msg message}))))]
|
||||
closure))
|
||||
(defrecord Cell
|
||||
[neighbors
|
||||
content]
|
||||
ICell
|
||||
(neighbors [this] (deref (:neighbors this)))
|
||||
(content [this] (deref (:content this)))
|
||||
(add-content! [this increment]
|
||||
(let [prev-content (deref (:content this))]
|
||||
(cond (nothing? increment) :ok
|
||||
(nothing? prev-content)
|
||||
(do (reset! (:content this) increment)
|
||||
(apply alert-propagators (vector (deref (:neighbors this))))
|
||||
:ok)
|
||||
:else (if (not (= prev-content increment))
|
||||
(throw (ex-info "Inconsistency!"
|
||||
{:content prev-content
|
||||
:increment increment}))))))
|
||||
(new-neighbor! [this new-neighbor]
|
||||
(let [old-neighbors (deref (:neighbors this))]
|
||||
(do (swap! (:neighbors this) conj new-neighbor)
|
||||
(alert-propagator new-neighbor)
|
||||
:ok))))
|
||||
|
||||
;; returns an initialized cell
|
||||
(defn make-cell []
|
||||
(map->Cell
|
||||
{:neighbors (atom #{})
|
||||
:content (atom nothing)}))
|
||||
|
||||
;; currently not implementing abort semantics
|
||||
(defn make-prop-net
|
||||
"construct a propagation-network closure using the core implementation introduced in Chapter 3"
|
||||
[]
|
||||
(let [content (fn [cell] (cell 'content))
|
||||
add-content (fn [cell increment] ((cell 'add-content) increment))
|
||||
new-neighbor! (fn [cell new-neighbor] ((cell 'new-neighbor!) new-neighbor))
|
||||
|
||||
clear-alerted-propagators! (fn []
|
||||
(reset! alerted-propagators #{}))
|
||||
initialize-scheduler (fn []
|
||||
(clear-alerted-propagators!)
|
||||
(reset! last-value-of-run :done)
|
||||
(reset! propagators-ever-alerted #{})
|
||||
:ok!)
|
||||
|
||||
any-propagators-alerted? (fn []
|
||||
(not (empty? @alerted-propagators)))
|
||||
|
||||
;run-alerted (fn [] '())
|
||||
;run (fn [] '())
|
||||
(defn- alerted-propagators* [] #{})
|
||||
(defn- cells* [] {})
|
||||
(defn- propagators-ever-alerted* [] #{})
|
||||
(def ^:private done :done)
|
||||
|
||||
closure (fn [message]
|
||||
(match [message]
|
||||
['alerted-propagators] @alerted-propagators
|
||||
['last-value-of-run] @last-value-of-run
|
||||
['propagators-ever-alerted] @propagators-ever-alerted
|
||||
['cells] @cells
|
||||
['initialize-scheduler] (initialize-scheduler)
|
||||
|
||||
(defprotocol IPropNet
|
||||
(alerted-propagators [this])
|
||||
(last-value-of-run [this])
|
||||
(propagators-ever-alerted [this])
|
||||
(cells [this])
|
||||
(initialize-scheduler! [this])
|
||||
(add-content-to-cell! [this cell-key content])
|
||||
(add-cell! [this cell-key])
|
||||
(cell [this cell-key]))
|
||||
|
||||
['add-cell] (fn [key]
|
||||
(if (key @cells)
|
||||
(throw (ex-info "Identifier for cell already exists"
|
||||
{:id key :cells @cells}))
|
||||
(swap! cells conj {key (make-cell)})))
|
||||
['cell] (fn [key] (key @cells))
|
||||
:else (throw (ex-info "Unknown message" {:msg message}))
|
||||
))]
|
||||
|
||||
closure))
|
||||
(defrecord PropNet
|
||||
[alerted-propagators
|
||||
last-value-of-run
|
||||
cells
|
||||
propagators-ever-alerted]
|
||||
IPropNet
|
||||
(alerted-propagators [this] (deref (:alerted-propagators this)))
|
||||
(last-value-of-run [this] (deref :last-value-of-run))
|
||||
(cells [this] (deref cells))
|
||||
(initialize-scheduler! [this]
|
||||
(reset! (:alerted-propagators this) alerted-propagators*)
|
||||
(reset! (:last-value-of-run this) done)
|
||||
(reset! (:propagators-ever-alerted this) propagators-ever-alerted*)
|
||||
:ok)
|
||||
(add-content-to-cell! [this cell-key content] '())
|
||||
(add-cell! [this cell-key]
|
||||
(swap! (:cells this) assoc cell-key (make-cell))
|
||||
(:cells this))
|
||||
(cell [this cell-key] (get (:cells this) cell-key)))
|
||||
|
||||
;; returns a propnet
|
||||
(defn make-prop-net []
|
||||
(map->PropNet
|
||||
{:alerted-propagators (atom #{})
|
||||
:last-value-of-run (atom done)
|
||||
;; cells is a map with each keyword being an identifier for the cell
|
||||
;; this makes lookup easier as callers to prop-net do not need to hold
|
||||
;; on to references of the cells themselves
|
||||
:cells (atom {})
|
||||
:propagators-ever-alerted (atom #{})}))
|
||||
|
|
Loading…
Reference in a new issue