oxaliq/prop-net
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

refactor cell and prop-net as records that implement protocols

Browse source
This commit is contained in:
sorrel 2024-03-29 15:55:11 -04:00
parent 064d737ac0
commit b4647fb2a8
1 changed files with 89 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

168
src/prop_net/naive_scalar_net.clj
View file

@ -1,101 +1,109 @@
(ns prop-net.naive-scalar-net (ns prop-net.naive-scalar-net)
(:require [clojure.core.match :refer [match]]))
;; private definitions at the ns scope so that cells can access them, but ;; private definitions at the ns scope so that cells can access them, but
;; everything must be accessed through the prop-network closure itself ;; 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 []) (def ^:private nothing [])
(defn- nothing? [thing] (= thing nothing)) (defn- nothing? [thing] (= thing nothing))
(defn- alert-propagators [& propagators] (defn- alert-propagators [& propagators]
(run! (fn [propagator] (run! (fn [propagator]
(if (not (fn? propagator)) (print propagator)
(throw (ex-info "Alerting a non-procedure" #{:propagator propagator}))) (when (not (fn? propagator))
(throw (ex-info "Alerting a non-procedure" {:propagator propagator})))
(swap! propagators-ever-alerted #(conj % propagator)) (swap! propagators-ever-alerted #(conj % propagator))
(swap! alerted-propagators #(conj % propagator))))) (swap! alerted-propagators #(conj % propagator)))
propagators))
(defn- alert-propagator [p] (defn- alert-propagator [p]
(alert-propagators p)) (alert-propagators p))
;; TODO check that adding a neighbor always adds propagator to this set ;; ;; TODO check that adding a neighbor always adds propagator to this set
;; and they are never removed ;; ;; and they are never removed
(defn- alert-all-propagators [] ;; (defn- alert-all-propagators []
(apply alert-propagators (vector @propagators-ever-alerted))) ;; (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 [] (defrecord Cell
(let [neighbors (atom #{}) [neighbors
content (atom nothing) content]
add-content* (fn [increment] ICell
(cond (nothing? increment) 'ok (neighbors [this] (deref (:neighbors this)))
(nothing? @content) (do (reset! content increment) (content [this] (deref (:content this)))
(apply alert-propagators (vector @neighbors))) (add-content! [this increment]
:else (if (not (= @content increment)) (let [prev-content (deref (:content this))]
(throw (ex-info "Inconsistency!" (cond (nothing? increment) :ok
{:content @content (nothing? prev-content)
:increment increment}))))) (do (reset! (:content this) increment)
new-neighbor*! (fn [new-neighbor] (apply alert-propagators (vector (deref (:neighbors this))))
(if (not (contains? @neighbors new-neighbor)) :ok)
(do (swap! neighbors #(conj %1 new-neighbor)) :else (if (not (= prev-content increment))
(alert-propagator new-neighbor)))) (throw (ex-info "Inconsistency!"
closure (fn [message] {:content prev-content
(match [message] :increment increment}))))))
['content] @content (new-neighbor! [this new-neighbor]
['add-content] add-content* (let [old-neighbors (deref (:neighbors this))]
['new-neighbor!] new-neighbor*! (do (swap! (:neighbors this) conj new-neighbor)
:else (throw (ex-info "Unknown message to cell" (alert-propagator new-neighbor)
{:msg message}))))] :ok))))
closure))
;; returns an initialized cell
(defn make-cell []
(map->Cell
{:neighbors (atom #{})
:content (atom nothing)}))
;; currently not implementing abort semantics ;; 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 [] (defn- alerted-propagators* [] #{})
(reset! alerted-propagators #{})) (defn- cells* [] {})
initialize-scheduler (fn [] (defn- propagators-ever-alerted* [] #{})
(clear-alerted-propagators!) (def ^:private done :done)
(reset! last-value-of-run :done)
(reset! propagators-ever-alerted #{})
:ok!)
any-propagators-alerted? (fn [] (defprotocol IPropNet
(not (empty? @alerted-propagators))) (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]))
;run-alerted (fn [] '()) (defrecord PropNet
;run (fn [] '()) [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)))
closure (fn [message] ;; returns a propnet
(match [message] (defn make-prop-net []
['alerted-propagators] @alerted-propagators (map->PropNet
['last-value-of-run] @last-value-of-run {:alerted-propagators (atom #{})
['propagators-ever-alerted] @propagators-ever-alerted :last-value-of-run (atom done)
['cells] @cells ;; cells is a map with each keyword being an identifier for the cell
['initialize-scheduler] (initialize-scheduler) ;; this makes lookup easier as callers to prop-net do not need to hold
;; on to references of the cells themselves
:cells (atom {})
['add-cell] (fn [key] :propagators-ever-alerted (atom #{})}))
(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))