From 064d737ac0826eeee8273aa279514b90ca902193 Mon Sep 17 00:00:00 2001 From: sorrel Date: Mon, 1 Jan 2024 16:28:42 -0500 Subject: [PATCH] stub naive scalar net --- .dev-log | 11 ++++ src/prop_net/naive_scalar_net.clj | 101 ++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 .dev-log create mode 100644 src/prop_net/naive_scalar_net.clj diff --git a/.dev-log b/.dev-log new file mode 100644 index 0000000..8e4731e --- /dev/null +++ b/.dev-log @@ -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 diff --git a/src/prop_net/naive_scalar_net.clj b/src/prop_net/naive_scalar_net.clj new file mode 100644 index 0000000..759c98f --- /dev/null +++ b/src/prop_net/naive_scalar_net.clj @@ -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))