stub naive scalar net
This commit is contained in:
parent
23ffa28802
commit
064d737ac0
2 changed files with 112 additions and 0 deletions
11
.dev-log
Normal file
11
.dev-log
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
2024/1/1
|
||||||
|
- fixed message matching bug in naive-scalar-net/make-prop-net
|
||||||
|
|
||||||
|
2023/12/29
|
||||||
|
- jumping into project after a couple days
|
||||||
|
- fixed bug in let binding of prop-net
|
||||||
|
- TODO:
|
||||||
|
- check that adding a neighbor always adds to alert-all-propagators
|
||||||
|
and they are never removed
|
||||||
|
- debug message matching: match doesn't match symbol messages and
|
||||||
|
errors on keyword messages
|
101
src/prop_net/naive_scalar_net.clj
Normal file
101
src/prop_net/naive_scalar_net.clj
Normal file
|
@ -0,0 +1,101 @@
|
||||||
|
(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
|
||||||
|
;; 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})))
|
||||||
|
(swap! propagators-ever-alerted #(conj % propagator))
|
||||||
|
(swap! alerted-propagators #(conj % propagator)))))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
|
||||||
|
(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))
|
||||||
|
|
||||||
|
;; 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 [] '())
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
|
||||||
|
['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))
|
Loading…
Reference in a new issue