├── doc ├── design │ ├── 002_model-checking.md │ ├── 001_durable-execution.md │ └── 003_bthread-macro.md ├── assets │ ├── bprogram.png │ ├── explorer1.png │ ├── explorer2.png │ └── model-results.png ├── navigating-bprograms.md └── what-is-a-bthread.md ├── modules ├── pavlov │ ├── resources │ │ ├── .keep │ │ ├── clj-kondo.exports │ │ │ └── tech.thomascothran │ │ │ │ └── pavlov │ │ │ │ └── config.edn │ │ └── clojure-lsp.exports │ │ │ └── tech.thomascothran │ │ │ └── pavlov │ │ │ └── config.edn │ ├── src │ │ └── tech │ │ │ └── thomascothran │ │ │ ├── pavlov.cljc │ │ │ └── pavlov │ │ │ ├── bid │ │ │ ├── proto.cljc │ │ │ └── defaults.cljc │ │ │ ├── event │ │ │ ├── proto.cljc │ │ │ ├── publisher │ │ │ │ ├── proto.cljc │ │ │ │ └── defaults.cljc │ │ │ ├── publisher.cljc │ │ │ ├── defaults.cljc │ │ │ └── selection.cljc │ │ │ ├── bthread │ │ │ ├── proto.cljc │ │ │ └── defaults.cljc │ │ │ ├── defaults.cljc │ │ │ ├── event.cljc │ │ │ ├── bprogram │ │ │ ├── proto.cljc │ │ │ ├── state.cljc │ │ │ ├── notification.cljc │ │ │ └── ephemeral.cljc │ │ │ ├── lasso │ │ │ ├── proto.cljc │ │ │ └── lru.cljc │ │ │ ├── bprogram.cljc │ │ │ ├── viz │ │ │ └── cytoscape.clj │ │ │ └── bthread.cljc │ ├── squint.edn │ ├── vite.config.js │ ├── deps.edn │ ├── package.json │ ├── .gitignore │ ├── test │ │ └── tech │ │ │ └── thomascothran │ │ │ └── pavlov │ │ │ ├── lasso │ │ │ └── lru_test.clj │ │ │ ├── event │ │ │ └── selection │ │ │ │ ├── prioritized_bids_test.cljc │ │ │ │ └── prioritized_events_test.cljc │ │ │ ├── bprogram │ │ │ ├── state_test.cljc │ │ │ ├── ephemeral_test │ │ │ │ └── bthreads.cljc │ │ │ ├── ephemeral_test.clj │ │ │ └── ephemeral_test.cljs │ │ │ └── bthread_test.cljc │ ├── squint-test │ │ └── tech │ │ │ └── thomascothran │ │ │ └── pavlov │ │ │ └── bprogram │ │ │ └── ephemeral_squint_test.cljs │ └── build.clj └── pavlov-devtools │ ├── .gitignore │ ├── deps.edn │ ├── src │ └── tech │ │ └── thomascothran │ │ └── pavlov │ │ ├── graph.cljc │ │ ├── viz │ │ ├── cytoscape_html.clj │ │ ├── portal.cljc │ │ └── cytoscape.clj │ │ ├── subscribers │ │ └── tap.cljc │ │ ├── model │ │ └── check.clj │ │ ├── test.cljc │ │ ├── nav.cljc │ │ └── search.cljc │ ├── build.clj │ └── test │ └── tech │ └── thomascothran │ └── pavlov │ ├── nav_test.clj │ ├── graph_test.cljc │ ├── test_test.clj │ ├── viz │ └── cytoscape_test.clj │ └── model │ └── check_test.clj ├── context ├── Model checking BP.pdf └── model_check_state_restore.md ├── shadow-cljs.edn ├── tests.edn ├── .envrc ├── devenv.yaml ├── .gitignore ├── deps.edn ├── dev ├── demo │ ├── portal.clj │ └── bank │ │ └── domain.cljc └── dev.clj ├── devenv.nix ├── devenv.lock └── LICENSE /doc/design/002_model-checking.md: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /modules/pavlov/resources/.keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /doc/design/001_durable-execution.md: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/.gitignore: -------------------------------------------------------------------------------- 1 | target/ 2 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov) 2 | -------------------------------------------------------------------------------- /modules/pavlov/squint.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "squint-test"] 2 | :output-dir "out/squint-js"} 3 | -------------------------------------------------------------------------------- /doc/assets/bprogram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomascothran/pavlov/HEAD/doc/assets/bprogram.png -------------------------------------------------------------------------------- /doc/assets/explorer1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomascothran/pavlov/HEAD/doc/assets/explorer1.png -------------------------------------------------------------------------------- /doc/assets/explorer2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomascothran/pavlov/HEAD/doc/assets/explorer2.png -------------------------------------------------------------------------------- /doc/assets/model-results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomascothran/pavlov/HEAD/doc/assets/model-results.png -------------------------------------------------------------------------------- /context/Model checking BP.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomascothran/pavlov/HEAD/context/Model checking BP.pdf -------------------------------------------------------------------------------- /modules/pavlov/resources/clj-kondo.exports/tech.thomascothran/pavlov/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {tech.thomascothran.pavlov.bthread/thread clojure.core/fn}} 2 | -------------------------------------------------------------------------------- /modules/pavlov/resources/clojure-lsp.exports/tech.thomascothran/pavlov/config.edn: -------------------------------------------------------------------------------- 1 | {:cljfmt 2 | {:extra-indents {tech.thomascothran.pavlov.bthread/thread [[:inner 0]]}}} 3 | -------------------------------------------------------------------------------- /modules/pavlov/vite.config.js: -------------------------------------------------------------------------------- 1 | import { defineConfig } from 'vite'; 2 | 3 | export default defineConfig({ 4 | test: { 5 | include: ["out/squint-js/**/**test.mjs"], 6 | } 7 | }); 8 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bid/proto.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bid.proto) 2 | 3 | (defprotocol Bid 4 | (request [this]) 5 | (wait-on [this]) 6 | (block [this])) 7 | 8 | -------------------------------------------------------------------------------- /shadow-cljs.edn: -------------------------------------------------------------------------------- 1 | {:deps true 2 | :builds {:test 3 | {:target :node-test 4 | :output-to "out/node-tests.js" 5 | :ns-regexp "-test$" 6 | :autorun true}}} 7 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/event/proto.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.proto 2 | (:refer-clojure :exclude [type])) 3 | 4 | (defprotocol Event 5 | (type [event]) 6 | (terminal? [event])) 7 | -------------------------------------------------------------------------------- /modules/pavlov/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :aliases 3 | {:build {:deps {io.github.clojure/tools.build {:mvn/version "0.9.6"} 4 | slipset/deps-deploy {:mvn/version "0.2.0"}} 5 | :ns-default build}}} 6 | -------------------------------------------------------------------------------- /modules/pavlov/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "squint-cljs": "^0.8.124" 4 | }, 5 | "devDependencies": { 6 | "vitest": "^2.1.6" 7 | }, 8 | "scripts": { 9 | "squint-tests": "vitest" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | {:tests [{:id :unit 3 | :source-paths ["modules/pavlov/src" "modules/pavlov-devtools/src"] 4 | :test-paths ["modules/pavlov/test" "modules/pavlov-devtools/test"] 5 | :ns-patterns [".*"]}]} 6 | -------------------------------------------------------------------------------- /.envrc: -------------------------------------------------------------------------------- 1 | export DIRENV_WARN_TIMEOUT=20s 2 | 3 | eval "$(devenv direnvrc)" 4 | 5 | # The use_devenv function supports passing flags to the devenv command 6 | # For example: use devenv --impure --option services.postgres.enable:bool true 7 | use devenv 8 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bthread/proto.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bthread.proto) 2 | 3 | (defprotocol BThread 4 | (notify! [this last-event]) 5 | (state [this]) 6 | (label [this]) 7 | (set-state [this serialized])) 8 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/event/publisher/proto.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.publisher.proto) 2 | 3 | (defprotocol Publisher 4 | (start! [this]) 5 | (stop! [this]) 6 | (notify! [this event bthread->bid]) 7 | (subscribe! [this key f]) 8 | (listeners [this])) 9 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/defaults.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.defaults 2 | "Get all the default protocols in one place" 3 | (:require [tech.thomascothran.pavlov.bid.defaults] 4 | [tech.thomascothran.pavlov.bthread.defaults] 5 | [tech.thomascothran.pavlov.event.defaults])) 6 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/event.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event 2 | (:refer-clojure :exclude [type]) 3 | (:require [tech.thomascothran.pavlov.event.proto :as proto])) 4 | 5 | (defn type 6 | [event] 7 | (when event (proto/type event))) 8 | 9 | (defn terminal? 10 | [event] 11 | (when event (proto/terminal? event))) 12 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bprogram/proto.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.proto 2 | (:refer-clojure :exclude [pop conj])) 3 | 4 | (defprotocol BProgram 5 | (stop! [this]) 6 | (stopped [this]) 7 | (kill! [this]) 8 | (submit-event! [this event]) 9 | (subscribe! [this k f])) 10 | 11 | (defprotocol BProgramQueue 12 | (conj [this event]) 13 | (pop [this])) 14 | 15 | (defprotocol BProgramIntrospectable 16 | (bthread->bids [this])) 17 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/event/publisher.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.publisher 2 | (:require [tech.thomascothran.pavlov.event.publisher.proto :as proto])) 3 | 4 | (defn notify! 5 | [publisher event bthread->bid] 6 | (proto/notify! publisher event bthread->bid)) 7 | 8 | (defn subscribe! 9 | [publisher key f] 10 | (proto/subscribe! publisher key f)) 11 | 12 | (defn listeners 13 | [publisher] 14 | (proto/listeners publisher)) 15 | -------------------------------------------------------------------------------- /devenv.yaml: -------------------------------------------------------------------------------- 1 | # yaml-language-server: $schema=https://devenv.sh/devenv.schema.json 2 | inputs: 3 | nixpkgs: 4 | url: github:cachix/devenv-nixpkgs/rolling 5 | 6 | # If you're using non-OSS software, you can set allowUnfree to true. 7 | # allowUnfree: true 8 | 9 | # If you're willing to use a package that's vulnerable 10 | # permittedInsecurePackages: 11 | # - "openssl-1.1.1w" 12 | 13 | # If you have more than one devenv you can merge them 14 | #imports: 15 | # - ./backend 16 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {djblue/portal {:mvn/version "0.61.0"} 3 | dev.onionpancakes/chassis {:mvn/version "1.0.365"} 4 | info.sunng/ring-jetty9-adapter {:mvn/version "0.39.0"} 5 | metosin/malli {:mvn/version "0.19.2"} 6 | metosin/jsonista {:mvn/version "0.3.13"}} 7 | :aliases 8 | {:build {:deps {io.github.clojure/tools.build {:mvn/version "0.9.6"} 9 | slipset/deps-deploy {:mvn/version "0.2.0"}} 10 | :ns-default build}}} 11 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/lasso/proto.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.lasso.proto 2 | (:refer-clojure :exclude [key])) 3 | 4 | (defprotocol LassoDetector 5 | (begin! [this] 6 | "Called when the *inner chain* starts (before the first internal next-event).") 7 | 8 | (observe! [this key] 9 | "Observe one synchronization point (canonical key of the BP state). 10 | Returns nil if new; or a map when a repetition is detected. 11 | :period and :mu are filled when the algorithm can compute them (e.g. Brent). 12 | 13 | The `key` is the sequence of bthread names -> labels in priority order. ") 14 | 15 | (end! [this] 16 | "called when the inner chain ends")) 17 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .calva/output-window/ 2 | .classpath 3 | .clj-kondo/.cache 4 | .cpcache 5 | .eastwood 6 | .factorypath 7 | .hg/ 8 | .hgignore 9 | .java-version 10 | .lein-* 11 | .lsp/.cache 12 | .lsp/sqlite.db 13 | .nrepl-history 14 | .nrepl-port 15 | .portal/vs-code.edn 16 | .project 17 | .rebel_readline_history 18 | .settings 19 | .socket-repl-port 20 | .sw* 21 | .vscode 22 | *.class 23 | *.jar 24 | *.swp 25 | *~ 26 | /checkouts 27 | /classes 28 | /target 29 | /out 30 | node_modules/ 31 | .shadow-cljs 32 | .secrets 33 | .aider* 34 | 35 | # Devenv 36 | .devenv* 37 | devenv.local.nix 38 | 39 | # direnv 40 | .direnv 41 | 42 | # pre-commit 43 | .pre-commit-config.yaml 44 | 45 | .clj-kondo/.cache 46 | .clj-kondo/imports 47 | -------------------------------------------------------------------------------- /modules/pavlov/.gitignore: -------------------------------------------------------------------------------- 1 | .calva/output-window/ 2 | .classpath 3 | .clj-kondo/.cache 4 | .cpcache 5 | .eastwood 6 | .factorypath 7 | .hg/ 8 | .hgignore 9 | .java-version 10 | .lein-* 11 | .lsp/.cache 12 | .lsp/sqlite.db 13 | .nrepl-history 14 | .nrepl-port 15 | .portal/vs-code.edn 16 | .project 17 | .rebel_readline_history 18 | .settings 19 | .socket-repl-port 20 | .sw* 21 | .vscode 22 | *.class 23 | *.jar 24 | *.swp 25 | *~ 26 | /checkouts 27 | /classes 28 | /target 29 | /out 30 | node_modules/ 31 | .shadow-cljs 32 | .secrets 33 | .aider* 34 | 35 | # Devenv 36 | .devenv* 37 | devenv.local.nix 38 | 39 | # direnv 40 | .direnv 41 | 42 | # pre-commit 43 | .pre-commit-config.yaml 44 | 45 | .clj-kondo/.cache 46 | .clj-kondo/imports 47 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {tech.thomascothran/pavlov {:local/root "./modules/pavlov"} 2 | tech.thomascothran/pavlov-devtools {:local/root "./modules/pavlov-devtools"}} 3 | :aliases 4 | {:test {:extra-paths ["modules/pavlov/test" "modules/pavlov-devtools/test"] 5 | :extra-deps {org.clojure/test.check {:mvn/version "1.1.1"} 6 | lambdaisland/kaocha {:mvn/version "1.91.1392"} 7 | org.clojure/math.combinatorics {:mvn/version "0.3.0"}} 8 | :exec-fn kaocha.runner/exec-fn} 9 | :dev {:extra-deps {org.clojure/clojurescript {:mvn/version "1.11.54"} 10 | nrepl/nrepl {:mvn/version "1.2.0"} 11 | cider/piggieback {:mvn/version "0.4.2"} 12 | org.clojure/clojure {:mvn/version "1.12.1"} 13 | thheller/shadow-cljs {:mvn/version "2.28.18"}} 14 | :extra-paths ["dev"]}}} 15 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/event/publisher/defaults.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.publisher.defaults 2 | (:require [tech.thomascothran.pavlov.event.publisher.proto :as publisher])) 3 | 4 | (defn- -notify! 5 | [!subscribers event bthread->bid] 6 | (mapv (fn [args] 7 | (let [k (first args) 8 | subscriber (second args)] 9 | (try (subscriber event bthread->bid) 10 | (catch #?(:clj Throwable :cljs :default) e 11 | (swap! !subscribers dissoc k) 12 | {:error e})))) 13 | @!subscribers)) 14 | 15 | (defn- -subscribe! 16 | [!subscribers k f] 17 | (swap! !subscribers assoc k f)) 18 | 19 | (defn make-publisher! 20 | [opts] 21 | (let [!subscribers (-> (get opts :subscribers {}) atom)] 22 | (reify publisher/Publisher 23 | (start! [_]) 24 | (stop! [_]) 25 | (notify! [_ event bthread->bid] 26 | (-notify! !subscribers event bthread->bid)) 27 | (subscribe! [_ k f] (-subscribe! !subscribers k f))))) 28 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bthread/defaults.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bthread.defaults 2 | (:require [tech.thomascothran.pavlov.bthread.proto :as bthread])) 3 | 4 | #?(:clj (extend-protocol bthread/BThread 5 | clojure.lang.APersistentMap 6 | (notify! [this _event] this) 7 | (state [this] this) 8 | (label [this] this) 9 | (set-state [_this serialized] serialized)) 10 | 11 | :cljs (extend-protocol bthread/BThread 12 | 13 | cljs.core.PersistentArrayMap 14 | (notify! [this _event] this) 15 | (state [this] this) 16 | (label [this] this) 17 | (set-state [_this serialized] serialized) 18 | 19 | cljs.core.PersistentHashMap 20 | (notify! [this _event] this) 21 | (state [this] this) 22 | (label [this] this) 23 | (set-state [_this serialized] serialized))) 24 | 25 | (extend-protocol bthread/BThread 26 | nil 27 | (notify! [this _event] this) 28 | (label [_] nil) 29 | (state [_] nil) 30 | (set-state [_ _] nil)) 31 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bprogram.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram 2 | (:require [tech.thomascothran.pavlov.bprogram.proto :as bp-proto])) 3 | 4 | (defn stop! 5 | "Stop the bprogram, allowing all enqueued events to be processed. 6 | 7 | Returns a promise that is delivered when the bprogram has stopped." 8 | [bprogram] 9 | (bp-proto/stop! bprogram)) 10 | 11 | (defn kill! 12 | "Attempt to kill the program, ignoring enqueued events." 13 | [bprogram] 14 | (bp-proto/kill! bprogram)) 15 | 16 | (defn submit-event! 17 | "Submit an event to the bprogram." 18 | [bprogram event] 19 | (bp-proto/submit-event! bprogram event)) 20 | 21 | (defn subscribe! 22 | "Dynamically add a subscriber, named `k`, to the bprogram. 23 | 24 | `f` will be applied to each event and a map of the bthreads to their bids. 25 | 26 | Generally, the bthread->bid map will only be used for debugging." 27 | [bprogram k f] 28 | (bp-proto/subscribe! bprogram k f)) 29 | 30 | (defn bthread->bids 31 | "Get a map of the bthreads to their current bids" 32 | [bprogram] 33 | (bp-proto/bthread->bids bprogram)) 34 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/event/defaults.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.defaults 2 | (:require [tech.thomascothran.pavlov.event.proto :as event])) 3 | 4 | (extend-protocol event/Event 5 | #?(:clj clojure.lang.Keyword 6 | :cljs Keyword) 7 | (type [event] event) 8 | (terminal? [event] 9 | (= event :pavlov/terminate))) 10 | 11 | #?(:clj (extend-protocol event/Event 12 | clojure.lang.APersistentMap 13 | (type [event] (:type event)) 14 | (terminal? [event] (:terminal event))) 15 | 16 | :cljs (extend-protocol event/Event 17 | 18 | cljs.core.PersistentArrayMap 19 | (type [event] (:type event)) 20 | (terminal? [event] (:terminal event)) 21 | 22 | cljs.core.PersistentHashMap 23 | (type [event] (:type event)) 24 | (terminal? [event] (:terminal event))) 25 | :squint (extend-protocol event/Object 26 | (type [event] (get event :type)) 27 | (terminal? [event] (get event :terminal)))) 28 | 29 | (extend-protocol event/Event 30 | #?(:clj Object :cljs default) 31 | (type [o] o) 32 | (terminal? [_] false)) 33 | 34 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bid/defaults.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bid.defaults 2 | (:require [tech.thomascothran.pavlov.bid.proto :as proto])) 3 | 4 | #?(:clj (extend-protocol proto/Bid 5 | clojure.lang.APersistentMap 6 | (request [this] (get this :request #{})) 7 | (wait-on [this] (get this :wait-on #{})) 8 | (block [this] (get this :block #{}))) 9 | 10 | :cljs (extend-protocol proto/Bid 11 | 12 | cljs.core.PersistentArrayMap 13 | (request [this] (get this :request #{})) 14 | (wait-on [this] (get this :wait-on #{})) 15 | (block [this] (get this :block #{})) 16 | 17 | cljs.core.PersistentHashMap 18 | (request [this] (get this :request #{})) 19 | (wait-on [this] (get this :wait-on #{})) 20 | (block [this] (get this :block #{}))) 21 | 22 | :squint (extend-protocol proto/Bid 23 | js/Object 24 | (request [this] (get this :request #{})) 25 | (wait-on [this] (get this :wait-on #{})) 26 | (block [this] (get this :block #{})))) 27 | 28 | (extend-protocol proto/Bid 29 | nil 30 | (request [_]) 31 | (wait-on [_]) 32 | (block [_])) 33 | 34 | -------------------------------------------------------------------------------- /dev/demo/portal.clj: -------------------------------------------------------------------------------- 1 | (ns demo.portal 2 | (:require [tech.thomascothran.pavlov.bthread :as b] 3 | [tech.thomascothran.pavlov.event :as e] 4 | [tech.thomascothran.pavlov.nav :as nav] 5 | [portal.api :as p])) 6 | 7 | (comment 8 | ;; setup 9 | (do (def p (p/open)) 10 | (add-tap #'p/submit))) 11 | 12 | (comment 13 | (do (def bthreads {:letters (b/bids [{:request [:a]} 14 | {:request [:b]} 15 | {:request [:c]}]) 16 | :numbers (b/bids [{:request #{1 2}} 17 | {:request #{3}}])}) 18 | (def root-node 19 | (nav/root bthreads 20 | (fn [{event :pavlov/event 21 | branches :pavlov/branches}] 22 | [^{:portal.viewer/default :portal.viewer/hiccup} 23 | [:div 24 | (if-not event 25 | [:h1 "Initialized"] 26 | [:h1 "Event: " (e/type event)])] 27 | ^{:portal.viewer/default :portal.viewer/hiccup} 28 | [:h3 "Branches"] 29 | branches 30 | ^{:portal.viewer/default :portal.viewer/hiccup} 31 | [:hr]]))) 32 | 33 | (tap> root-node) 34 | (:wrapped root-node) 35 | (get-in root-node [:pavlov/bthreads]))) 36 | -------------------------------------------------------------------------------- /dev/dev.clj: -------------------------------------------------------------------------------- 1 | (ns dev 2 | (:require [portal.api :as portal] 3 | [cljs.repl.browser :as b] 4 | [cider.piggieback :as p] 5 | [nrepl.server :as nrepl] 6 | [shadow.cljs.devtools.server.nrepl :as shadow-nrepl] 7 | [shadow.cljs.devtools.server :as server] 8 | [shadow.cljs.devtools.api :as shadow])) 9 | 10 | (comment 11 | (require '[clojure.repl.deps :as d]) 12 | (d/add-libs 13 | {'lambdaisland/kaocha {:mvn/version "1.91.1392"}})) 14 | 15 | (defonce !nrepl-server 16 | (atom nil)) 17 | 18 | (defn start-nrepl! 19 | ([] (start-nrepl! {:port 7888})) 20 | ([{:keys [port]}] 21 | (spit ".nrepl-port" port) 22 | (reset! !nrepl-server 23 | (nrepl/start-server 24 | :handler (nrepl/default-handler #'shadow-nrepl/middleware #'p/wrap-cljs-repl) 25 | :port port)) 26 | (println "nrepl started on port " port) 27 | :ok)) 28 | 29 | (defn shadow-go! 30 | [] 31 | (do 32 | (server/start!) 33 | (shadow/watch :test))) 34 | 35 | (comment 36 | (shadow/repl :test)) 37 | 38 | (defn go! 39 | [& _] 40 | (start-nrepl!) 41 | (shadow-go!) 42 | @(promise)) 43 | 44 | (defn run-plain-repl 45 | [] 46 | (p/cljs-repl (b/repl-env))) 47 | 48 | (comment 49 | ;; In conjure, use ConjurePiggieback and the following 50 | ;; :ConjurePiggieback (cljs.repl.browser/repl-env) 51 | (p/cljs-repl (b/repl-env)) 52 | 53 | 1 54 | (js/alert "hi") 55 | :cljs/quit) 56 | 57 | (comment 58 | (do 59 | (def p (portal/open)) 60 | (add-tap #'portal/submit))) 61 | -------------------------------------------------------------------------------- /devenv.nix: -------------------------------------------------------------------------------- 1 | { pkgs, lib, config, inputs, ... }: 2 | 3 | { 4 | cachix.enable = false; 5 | 6 | # https://devenv.sh/packages/ 7 | languages = { 8 | clojure.enable = true; 9 | javascript.enable = true; 10 | }; 11 | 12 | packages = [ 13 | pkgs.git 14 | pkgs.nodejs 15 | ]; 16 | 17 | # https://devenv.sh/languages/ 18 | # languages.rust.enable = true; 19 | 20 | # https://devenv.sh/processes/ 21 | processes.clj.exec = "clj -A:dev:test -X dev/go!"; 22 | 23 | # https://devenv.sh/services/ 24 | # services.postgres.enable = true; 25 | 26 | # https://devenv.sh/scripts/ 27 | scripts.cljs-test-watch.exec = '' 28 | node --watch out/node-tests.js 29 | ''; 30 | scripts.deploy.exec = '' 31 | clj -X:test 32 | cd ./modules/pavlov 33 | clj -T:build ci 34 | env $(cat ~/.secrets/.clojars | xargs) clj -T:build deploy 35 | ''; 36 | scripts.squint-watch.exec = '' 37 | npx squint watch 38 | ''; 39 | scripts.clj-test.exec = '' 40 | clj -X:test 41 | ''; 42 | scripts.test-watch.exec = '' 43 | clj -X:test :watch? true 44 | ''; 45 | 46 | enterShell = '' 47 | hello 48 | git --version 49 | ''; 50 | 51 | # https://devenv.sh/tasks/ 52 | # tasks = { 53 | # "myproj:setup".exec = "mytool build"; 54 | # "devenv:enterShell".after = [ "myproj:setup" ]; 55 | # }; 56 | 57 | # https://devenv.sh/tests/ 58 | enterTest = '' 59 | echo "Running tests" 60 | git --version | grep --color=auto "${pkgs.git.version}" 61 | ''; 62 | 63 | # https://devenv.sh/git-hooks/ 64 | # git-hooks.hooks.shellcheck.enable = true; 65 | 66 | # See full reference at https://devenv.sh/reference/options/ 67 | } 68 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/lasso/lru_test.clj: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.lasso.lru-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [tech.thomascothran.pavlov.lasso.lru :as lru] 4 | [tech.thomascothran.pavlov.lasso.proto :as proto])) 5 | 6 | (deftest detects-simple-repeat-and-period 7 | (testing "A, B, A -> duplicate with correct period" 8 | (let [det (lru/make-lru-detector 8)] 9 | (proto/begin! det) 10 | (is (nil? (proto/observe! det :A))) 11 | (is (nil? (proto/observe! det :B))) 12 | (let [hit (proto/observe! det :A)] 13 | (is (map? hit)) 14 | (is (= true (:repeat? hit))) 15 | (is (= 2 (:period hit))) 16 | (is (= :A (:key hit)))) 17 | (proto/end! det)))) 18 | 19 | (deftest evicts-least-recently-used 20 | (testing "Touching :A makes it MRU; inserting :C evicts LRU (:B)" 21 | (let [det (lru/make-lru-detector 2)] 22 | (proto/begin! det) 23 | ;; Fill up to capacity with A, B 24 | (is (nil? (proto/observe! det :A))) 25 | (is (nil? (proto/observe! det :B))) 26 | 27 | (let [hit (proto/observe! det :A)] 28 | (is (= true (:repeat? hit)) 29 | "A is MRU, hence should get a hit")) 30 | (is (nil? (proto/observe! det :C)) 31 | "Insert :C -> capacity exceeded, LRU (:B) should be evicted") 32 | ;; Now 33 | (is (nil? (proto/observe! det :B)) 34 | "B was LRU and should have been evicted; seeing it again is not a repeat") 35 | (let [hit2 (proto/observe! det :C)] 36 | (is (= true (:repeat? hit2)) 37 | ":C should be in the window and return a repeat")) 38 | (proto/end! det)))) 39 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/graph.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.graph 2 | "Graph utilities for Pavlov behavioral programs." 3 | (:require [tech.thomascothran.pavlov.search :as search])) 4 | 5 | (defn ->graph 6 | "Return a graph representation for the supplied bthreads. 7 | 8 | The returned structure will be map-based, with nodes and edges keyed in 9 | a way suitable for visualization and analysis tooling. 10 | 11 | Example: 12 | ```clojure 13 | (->graph {:go-to-work go-to-work-bthread 14 | :start-work start-work-bthread}) 15 | ;;=> {:nodes {...} 16 | ;; :edges {...}} 17 | ``` 18 | " 19 | [bthreads] 20 | (let [nav (search/make-navigator bthreads)] 21 | (search/bfs-reduce 22 | nav 23 | (fn [acc wrapped] 24 | (let [nodes (get acc :nodes) 25 | edges (get acc :edges) 26 | identifier (search/identifier nav wrapped) 27 | node-id (get wrapped :path) 28 | last-event (get-in wrapped [:bprogram/state :last-event]) 29 | successors (search/succ nav wrapped) 30 | nodes' (assoc nodes node-id {:path node-id 31 | :identifier identifier 32 | :event last-event 33 | :wrapped wrapped}) 34 | edges' (into edges 35 | (map (fn [m] 36 | {:from node-id 37 | :to (get-in m [:state :path]) 38 | :event (get m :event)})) 39 | successors)] 40 | (assoc acc :nodes nodes' :edges edges'))) 41 | {:nodes {} :edges []}))) 42 | -------------------------------------------------------------------------------- /modules/pavlov/squint-test/tech/thomascothran/pavlov/bprogram/ephemeral_squint_test.cljs: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.ephemeral-squint-test 2 | (:require ["vitest" :refer [expect test]] 3 | [tech.thomascothran.pavlov.bthread :as bthread] 4 | [tech.thomascothran.pavlov.defaults] 5 | [tech.thomascothran.pavlov.bprogram.proto :as bp] 6 | [tech.thomascothran.pavlov.bprogram.ephemeral :as bpe])) 7 | 8 | (test "dummy expect works" 9 | (fn [] 10 | (-> (expect 1) 11 | (.toBe 1)))) 12 | 13 | ;; Stopped here due to extend-protocol not being supported in squint 14 | #_(test "good-morning-and-evening" 15 | (fn [] 16 | (let [bthreads 17 | [(bthread/seq (repeat 4 {:request #{:good-morning}}) 18 | {:priority 1} 19 | 20 | (bthread/seq (repeat 4 {:request #{:good-evening}})) 21 | (bthread/seq (interleave 22 | (repeat {:wait-on #{:good-morning} 23 | :block #{:good-evening}}) 24 | (repeat {:wait-on #{:good-evening} 25 | :block #{:good-morning}}))))] 26 | !a (atom []) 27 | subscriber (fn [x _] (swap! !a conj x)) 28 | program (bpi/make-program! bthreads 29 | {:subscribers {:test subscriber}}) 30 | _ @(bp/stop! program)] 31 | (-> (expect (butlast @!a)) 32 | (.toEqual 33 | (interleave (repeat 4 :good-morning 34 | (repeat 4 :good-evening)) 35 | (butlast @!a))))))) 36 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/event/selection/prioritized_bids_test.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.selection.prioritized-bids-test 2 | (:require #?(:clj [clojure.test :refer [deftest is]] 3 | :cljs [cljs.test :refer [deftest is]]) 4 | [tech.thomascothran.pavlov.event.selection :as sel])) 5 | 6 | (deftest ordered-bthreads-ordered-requests 7 | (let [bthreads-by-priority [:A :B] 8 | bid-a {:request [:d :e :f]} 9 | bid-b {:request [:x]} 10 | bthread->bid {:A bid-a 11 | :B bid-b} 12 | bids (sel/prioritized-bids bthreads-by-priority 13 | bthread->bid)] 14 | (is (= [bid-a] bids) 15 | "With ordered bthreads and ordered requests, take the first unblocked"))) 16 | 17 | (deftest unordered-bthreads-ordered-requests 18 | (let [bthreads-by-priority #{:A :B} 19 | bid-a {:request [:d :e :f]} 20 | bid-b {:request [:x]} 21 | bthread->bid {:A bid-a 22 | :B bid-b} 23 | bids (sel/prioritized-bids bthreads-by-priority 24 | bthread->bid)] 25 | (is (= [bid-a bid-b] bids) 26 | "With ordered bthreads and ordered requests, take the first unblocked"))) 27 | 28 | (deftest unordered-bthreads-ordered-requests-with-blocks 29 | (let [bthreads-by-priority #{:A :B :C} 30 | bid-a {:request [:d :e :f]} 31 | bid-b {:request [:x]} 32 | bid-c {:request [:g] 33 | :block [:x]} 34 | bthread->bid {:A bid-a 35 | :B bid-b 36 | :C bid-c} 37 | bids (sel/prioritized-bids bthreads-by-priority 38 | bthread->bid)] 39 | (is (= [bid-a bid-c] bids) 40 | "With ordered bthreads and ordered requests, take the first unblocked"))) 41 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/event/selection/prioritized_events_test.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.selection.prioritized-events-test 2 | (:require #?(:clj [clojure.test :refer [deftest is]] 3 | :cljs [cljs.test :refer [deftest is]]) 4 | [tech.thomascothran.pavlov.event.selection :as sel])) 5 | 6 | (deftest ordered-bthreads-ordered-requests 7 | (let [bthreads-by-priority [:A :B] 8 | bid-a {:request [:d :e :f]} 9 | bid-b {:request [:x]} 10 | bthread->bid {:A bid-a 11 | :B bid-b} 12 | events (sel/prioritized-events bthreads-by-priority 13 | bthread->bid)] 14 | (is (= [:d] events)))) 15 | 16 | (deftest unordered-bthreads-ordered-requests 17 | (let [bthreads-by-priority #{:A :B} 18 | bid-a {:request [:d :e :f]} 19 | bid-b {:request [:x]} 20 | bthread->bid {:A bid-a 21 | :B bid-b} 22 | events (sel/prioritized-events bthreads-by-priority 23 | bthread->bid)] 24 | (is (= [:d :x] events)))) 25 | 26 | (deftest unordered-bthreads-unordered-events 27 | (let [bthreads-by-priority #{:A :B} 28 | bid-a {:request #{:d :e :f}} 29 | bid-b {:request [:x :y]} 30 | bthread->bid {:A bid-a 31 | :B bid-b} 32 | events (sel/prioritized-events bthreads-by-priority 33 | bthread->bid)] 34 | (is (= #{:d :e :f :x} (into #{} events))))) 35 | 36 | (deftest unordered-bthreads-ordered-requests-with-blocks 37 | (let [bthreads-by-priority #{:A :B :C} 38 | bid-a {:request [:d :e :f]} 39 | bid-b {:request [:x]} 40 | bid-c {:request [:g] 41 | :block [:x]} 42 | bthread->bid {:A bid-a 43 | :B bid-b 44 | :C bid-c} 45 | events (sel/prioritized-events bthreads-by-priority 46 | bthread->bid)] 47 | (is (= [:d :g] events)))) 48 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/lasso/lru.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.lasso.lru 2 | (:require [tech.thomascothran.pavlov.lasso.proto :refer [LassoDetector]]) 3 | #?(:clj (:import [java.util LinkedHashMap]))) 4 | 5 | ;; Guaranteed to execute in a single thread 6 | 7 | #?(:clj 8 | (defn make-lru-map ^LinkedHashMap [capacity] 9 | (proxy [LinkedHashMap] [16 0.75 true] 10 | (removeEldestEntry [^java.util.Map$Entry _eldest] 11 | (> (.size ^LinkedHashMap this) (int capacity)))))) 12 | 13 | #?(:clj 14 | (defn make-lru-detector 15 | [capacity] 16 | (let [m (make-lru-map capacity) 17 | !i (volatile! 0)] 18 | (reify LassoDetector 19 | (begin! [_] (vreset! !i 0) (.clear m)) 20 | (observe! [_ key] 21 | (let [i (vswap! !i inc)] 22 | (if (.containsKey m key) 23 | (let [j (.get m key)] 24 | (.put m key i) 25 | {:repeat? true :period (- i (int j)) :key key}) 26 | (do (.put m key i) nil)))) 27 | (end! [_] nil))))) 28 | 29 | ;; TODO: this is guaranteed to be used on a single thread, 30 | ;; so we can use mutable data structures for better performance 31 | #?(:cljs 32 | (defn make-lru-detector ^LassoDetector [capacity] 33 | (let [!idx (atom 0) 34 | !queue (atom #queue []) 35 | !map (atom {})] ; key -> first-index 36 | (reify LassoDetector 37 | (begin! [_] 38 | (reset! !idx 0) 39 | (reset! !queue #queue []) 40 | (reset! !map {})) 41 | (observe! [_ key] 42 | (let [i (swap! !idx inc) 43 | m @!map] 44 | (if-let [j (get m key)] 45 | {:repeat? true :period (- i j) :key key} 46 | (do 47 | (swap! !queue conj key) 48 | (swap! !map assoc key i) 49 | (when (> (count @!queue) capacity) 50 | (let [old (peek @!queue)] 51 | (swap! !queue pop) 52 | (swap! !map dissoc old))) 53 | nil)))) 54 | (end! [_] nil))))) 55 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:refer-clojure :exclude [test]) 3 | (:require [clojure.tools.build.api :as b] 4 | [deps-deploy.deps-deploy :as dd])) 5 | 6 | (def lib 'tech.thomascothran/pavlov-devtools) 7 | ; alternatively, use MAJOR.MINOR.COMMITS: 8 | (def version (format "2.0.%s" (b/git-count-revs nil))) 9 | (def class-dir "target/classes") 10 | 11 | (defn- pom-template [version] 12 | [[:description "Pavlov Devtools"] 13 | [:url "https://github.com/thomascothran/pavlov"] 14 | [:licenses 15 | [:license 16 | [:name "Eclipse Public License"] 17 | [:url "http://www.eclipse.org/legal/epl-v10.html"]]] 18 | [:developers 19 | [:developer 20 | [:name "Thomas Cothran"]]] 21 | [:scm 22 | [:url "https://github.com/thomascothran/pavlov"] 23 | [:connection "scm:git:https://github.com/thomascothran/pavlov.git"] 24 | [:developerConnection "scm:git:ssh:git@github.com:thomascothran/pavlov.git"] 25 | [:tag (str "v" version)]]]) 26 | 27 | (defn- jar-opts [opts] 28 | (assoc opts 29 | :lib lib :version version 30 | :jar-file (format "target/%s-%s.jar" lib version) 31 | :basis (b/create-basis {}) 32 | :class-dir class-dir 33 | :target "target" 34 | :src-dirs ["src"] 35 | :pom-data (pom-template version))) 36 | 37 | (defn ci "Run the CI pipeline of tests (and build the JAR)." [opts] 38 | ;(test opts) 39 | (b/delete {:path "target"}) 40 | (let [opts (jar-opts opts)] 41 | (println "\nWriting pom.xml...") 42 | (b/write-pom opts) 43 | (println "\nCopying source...") 44 | (b/copy-dir {:src-dirs ["resources" "src"] :target-dir class-dir}) 45 | (println "\nBuilding JAR..." (:jar-file opts)) 46 | (b/jar opts)) 47 | opts) 48 | 49 | (defn install "Install the JAR locally." [opts] 50 | (let [opts (jar-opts opts)] 51 | (b/install opts)) 52 | opts) 53 | 54 | (defn deploy "Deploy the JAR to Clojars." [opts] 55 | (let [{:keys [jar-file] :as opts} (jar-opts opts)] 56 | (dd/deploy {:installer :remote :artifact (b/resolve-path jar-file) 57 | :pom-file (b/pom-path (select-keys opts [:lib :class-dir]))})) 58 | opts) 59 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/test/tech/thomascothran/pavlov/nav_test.clj: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.nav-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [tech.thomascothran.pavlov.bthread :as b] 4 | [tech.thomascothran.pavlov.event :as e] 5 | [tech.thomascothran.pavlov.nav :as pnav])) 6 | 7 | (defn make-test-bthreads 8 | [] 9 | {:letters (b/bids [{:request [:a]} 10 | {:request [:b]} 11 | {:request [:c]}]) 12 | :numbers (b/bids [{:request #{1 2}} 13 | {:request #{3}}])}) 14 | 15 | (defn make-test-linear-bthreads 16 | [] 17 | {:linear (b/bids [{:request [:a]} 18 | {:request [:b]} 19 | {:request [:c]}])}) 20 | 21 | (deftest test-nav-to 22 | (testing "with event types" 23 | (let [root (pnav/root (make-test-bthreads)) 24 | at-first-branch (pnav/to root 1)] 25 | (is (= 1 (e/type (:pavlov/event at-first-branch)))) 26 | (is (:pavlov/branches at-first-branch)))) 27 | 28 | (testing "with functions" 29 | (let [root (pnav/root (make-test-bthreads)) 30 | at-first-branch (pnav/to root (comp (partial = 1) 31 | e/type))] 32 | (is (= 1 (e/type (:pavlov/event at-first-branch)))) 33 | (is (:pavlov/branches at-first-branch))))) 34 | 35 | (deftest test-follow 36 | (let [root (pnav/root (make-test-bthreads)) 37 | followed (pnav/follow root [1])] 38 | (is (= 1 (e/type (:pavlov/event followed))))) 39 | 40 | (let [root (pnav/root (make-test-bthreads)) 41 | followed (pnav/follow root [1 3])] 42 | (is (= 3 (e/type (:pavlov/event followed))))) 43 | 44 | (let [root (pnav/root (make-test-linear-bthreads)) 45 | followed (pnav/follow root [:a :c])] 46 | (is (= :c (e/type (:pavlov/event followed))))) 47 | 48 | (let [root (pnav/root (make-test-linear-bthreads)) 49 | followed (pnav/follow root [:a :b])] 50 | (is (= :b (e/type (:pavlov/event followed))))) 51 | 52 | (let [root (pnav/root (make-test-linear-bthreads)) 53 | followed (pnav/follow root [:a :d])] 54 | (is (nil? (:pavlov/event followed))))) 55 | -------------------------------------------------------------------------------- /modules/pavlov/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:refer-clojure :exclude [test]) 3 | (:require [clojure.tools.build.api :as b] 4 | [deps-deploy.deps-deploy :as dd])) 5 | 6 | (def lib 'tech.thomascothran/pavlov) 7 | ; alternatively, use MAJOR.MINOR.COMMITS: 8 | (def version (format "2.0.%s" (b/git-count-revs nil))) 9 | (def class-dir "target/classes") 10 | 11 | (defn- pom-template [version] 12 | [[:description "Pavlov: Bthreads for Clojure(Script)"] 13 | [:url "https://github.com/thomascothran/pavlov"] 14 | [:licenses 15 | [:license 16 | [:name "Eclipse Public License"] 17 | [:url "http://www.eclipse.org/legal/epl-v10.html"]]] 18 | [:developers 19 | [:developer 20 | [:name "Thomas Cothran"]]] 21 | [:scm 22 | [:url "https://github.com/thomascothran/pavlov"] 23 | [:connection "scm:git:https://github.com/thomascothran/pavlov.git"] 24 | [:developerConnection "scm:git:ssh:git@github.com:thomascothran/pavlov.git"] 25 | [:tag (str "v" version)]]]) 26 | 27 | (defn- jar-opts [opts] 28 | (assoc opts 29 | :lib lib :version version 30 | :jar-file (format "target/%s-%s.jar" lib version) 31 | :basis (b/create-basis {}) 32 | :class-dir class-dir 33 | :target "target" 34 | :src-dirs ["src"] 35 | :pom-data (pom-template version))) 36 | 37 | (defn ci "Run the CI pipeline of tests (and build the JAR)." [opts] 38 | ;(test opts) 39 | (b/delete {:path "target"}) 40 | (let [opts (jar-opts opts)] 41 | (println "\nWriting pom.xml...") 42 | (b/write-pom opts) 43 | (println "\nCopying source...") 44 | (b/copy-dir {:src-dirs ["resources" "src"] :target-dir class-dir}) 45 | (println "\nBuilding JAR..." (:jar-file opts)) 46 | (b/jar opts)) 47 | opts) 48 | 49 | (defn install "Install the JAR locally." [opts] 50 | (let [opts (jar-opts opts)] 51 | (b/install opts)) 52 | opts) 53 | 54 | (defn deploy "Deploy the JAR to Clojars." [opts] 55 | (let [{:keys [jar-file] :as opts} (jar-opts opts)] 56 | (dd/deploy {:installer :remote :artifact (b/resolve-path jar-file) 57 | :pom-file (b/pom-path (select-keys opts [:lib :class-dir]))})) 58 | opts) 59 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/test/tech/thomascothran/pavlov/graph_test.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.graph-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [tech.thomascothran.pavlov.graph :as graph] 4 | [tech.thomascothran.pavlov.bthread :as b])) 5 | 6 | (defn make-bthreads-two-step 7 | [] 8 | {:first (b/bids [{:request #{:a}} 9 | {:request #{:b}}])}) 10 | 11 | (defn make-branching-bthreads 12 | [] 13 | {:chooser (b/bids [{:request #{:branch/a :branch/b :branch/c}}]) 14 | :branch-b (b/on :branch/b (constantly {:request #{:branch/b-1}})) 15 | :branch-c-advance (b/on :branch/c (constantly {:request #{:branch/c-1}})) 16 | :branch-c-finish (b/on :branch/c-1 (constantly {:request #{:branch/c-2}}))}) 17 | 18 | (deftest graph-from-two-step-bthread 19 | (testing "graph structure contains root and sequential nodes" 20 | (let [graph (graph/->graph (make-bthreads-two-step))] 21 | (is (some? graph)) 22 | (is (= #{[] [:a] [:a :b]} 23 | (-> graph :nodes keys set))) 24 | (is (= #{{:from [] :to [:a] :event :a} 25 | {:from [:a] :to [:a :b] :event :b}} 26 | (->> graph 27 | :edges 28 | (map #(select-keys % [:from :to :event])) 29 | set)))))) 30 | 31 | (deftest graph-from-branching-bthreads 32 | (testing "graph structure captures branching fan-out" 33 | (let [graph (graph/->graph (make-branching-bthreads)) 34 | node-ids (-> graph :nodes keys set) 35 | edges (->> graph :edges (map #(select-keys % [:from :to :event])) set)] 36 | (is (= #{[] 37 | [:branch/a] 38 | [:branch/b] 39 | [:branch/b :branch/b-1] 40 | [:branch/c] 41 | [:branch/c :branch/c-1] 42 | [:branch/c :branch/c-1 :branch/c-2]} 43 | node-ids)) 44 | (is (= #{{:from [] :to [:branch/a] :event :branch/a} 45 | {:from [] :to [:branch/b] :event :branch/b} 46 | {:from [] :to [:branch/c] :event :branch/c} 47 | {:from [:branch/b] :to [:branch/b :branch/b-1] :event :branch/b-1} 48 | {:from [:branch/c] :to [:branch/c :branch/c-1] :event :branch/c-1} 49 | {:from [:branch/c :branch/c-1] 50 | :to [:branch/c :branch/c-1 :branch/c-2] 51 | :event :branch/c-2}} 52 | edges))))) 53 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/viz/cytoscape_html.clj: -------------------------------------------------------------------------------- 1 | (ns ^:alpha tech.thomascothran.pavlov.viz.cytoscape-html 2 | "Generate Cytoscape HTML from Pavlov bthreads." 3 | (:require [clojure.java.io :as io] 4 | [clojure.string :as str] 5 | [jsonista.core :as json] 6 | [tech.thomascothran.pavlov.viz.cytoscape :as cytoscape])) 7 | 8 | (def ^:private template-resource "viz/cytoscape/shell.html") 9 | (def ^:private template-fallback 10 | (str "modules/pavlov-devtools/resources/" template-resource)) 11 | 12 | (def ^:private data-placeholder "__PAVLOV_CY_DATA__") 13 | 14 | (defn- fetch-template [] 15 | (if-let [resource (io/resource template-resource)] 16 | (slurp resource) 17 | (let [file (io/file template-fallback)] 18 | (when (.exists file) 19 | (slurp file))))) 20 | 21 | (defn- load-template [] 22 | (or (fetch-template) 23 | (throw (ex-info "Cytoscape HTML template not found" 24 | {:template template-resource 25 | :fallback template-fallback})))) 26 | 27 | (defn -graph 28 | "Convert a Pavlov graph structure to Cytoscape-friendly data." 29 | [graph-map] 30 | (cytoscape/-graph->cytoscape graph-map)) 31 | 32 | (defn ->body 33 | "Inject Cytoscape data into the template's body segment." 34 | ([cy-data] 35 | (->body cy-data (load-template))) 36 | ([cy-data template] 37 | (let [payload (json/write-value-as-string cy-data)] 38 | (str/replace template data-placeholder payload)))) 39 | 40 | (defn ->page 41 | "Produce a full HTML page string for the supplied Cytoscape data map." 42 | ([cy-data] 43 | (->page cy-data (load-template))) 44 | ([cy-data template] 45 | (->body cy-data template))) 46 | 47 | (defn ->html 48 | "Return a browser-ready Cytoscape HTML document for `bthreads`." 49 | [bthreads] 50 | (-> bthreads 51 | cytoscape/graph->cytoscape 52 | ->page)) 53 | 54 | (comment 55 | (require '[tech.thomascothran.pavlov.bthread :as b]) 56 | 57 | (defn make-bthreads 58 | [] 59 | {:linear (b/bids [{:request #{:begin}} 60 | {:request #{{:type :step-1}}} 61 | {:request #{{:type :step-2 62 | :invariant-violated true}}} 63 | {:request #{{:type :step-3 64 | :environment true}}} 65 | {:request #{{:type :step-4 66 | :terminal true}}}])}) 67 | 68 | (spit "cytoscape-test.html" (->html (make-bthreads))) 69 | ;; Produces a full HTML page containing serialized Cytoscape data. 70 | (subs (->html (make-bthreads)) 0 200)) 71 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/subscribers/tap.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.subscribers.tap 2 | "Experimental, will likely change." 3 | (:require [tech.thomascothran.pavlov.event :as event] 4 | [tech.thomascothran.pavlov.bprogram :as bprogram] 5 | [tech.thomascothran.pavlov.bid.proto :as bid])) 6 | 7 | (defn- event->bthreads 8 | [bthread->bid] 9 | (reduce (fn [acc [bthread-name bid]] 10 | (let [wait-on (bid/wait-on bid) 11 | block (bid/block bid) 12 | request (bid/request bid) 13 | 14 | reducer-fn 15 | (fn [bid-type acc' event] 16 | (update-in acc' [bid-type (event/type event)] 17 | #(into #{bthread-name} %))) 18 | 19 | update-bid-bthreads 20 | (fn [acc' bid-type] 21 | (reduce (partial reducer-fn bid-type) acc' 22 | (case bid-type 23 | :wait-on wait-on 24 | :block block 25 | :request request)))] 26 | (-> acc 27 | (update-bid-bthreads :wait-on) 28 | (update-bid-bthreads :block) 29 | (update-bid-bthreads :request)))) 30 | 31 | {} 32 | bthread->bid)) 33 | 34 | (defn subscriber 35 | ([event bprogram] 36 | (subscriber :tap event bprogram)) 37 | ([prefix event bprogram] 38 | (try 39 | (let [bthread->bid (bprogram/bthread->bids bprogram) 40 | event->bthreads' (event->bthreads bthread->bid) 41 | 42 | waiting-on (into #{} (keys (get event->bthreads' :wait-on))) 43 | requested (into #{} (keys (get event->bthreads' :request))) 44 | blocked (into #{} (keys (get event->bthreads' :block))) 45 | unblocked (into #{} (remove (into #{} blocked)) requested)] 46 | 47 | (tap> {:subscriber-name prefix 48 | :event event 49 | :blocked blocked 50 | :requested requested 51 | :unblocked unblocked 52 | :waiting-on waiting-on 53 | :event->bthreads event->bthreads' 54 | :bthread->bid bthread->bid})) 55 | (catch #?(:clj Throwable :cljs :default) e 56 | (tap> {:subscriber-name prefix 57 | :event event 58 | :error-msg (str "Error in tap subscriber: " (.getMessage e)) 59 | :error e}))))) 60 | 61 | (comment 62 | (do 63 | (clojure.repl.deps/add-lib 'djblue/portal {:mvn/version "0.59.1"}) 64 | (require '[portal.api :as portal]) 65 | (def p (portal/open)) 66 | (add-tap #'portal/submit))) 67 | -------------------------------------------------------------------------------- /devenv.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "devenv": { 4 | "locked": { 5 | "dir": "src/modules", 6 | "lastModified": 1759501127, 7 | "owner": "cachix", 8 | "repo": "devenv", 9 | "rev": "a9f2a642628e2021e393cd4c6070d64d23a3f70f", 10 | "type": "github" 11 | }, 12 | "original": { 13 | "dir": "src/modules", 14 | "owner": "cachix", 15 | "repo": "devenv", 16 | "type": "github" 17 | } 18 | }, 19 | "flake-compat": { 20 | "flake": false, 21 | "locked": { 22 | "lastModified": 1747046372, 23 | "owner": "edolstra", 24 | "repo": "flake-compat", 25 | "rev": "9100a0f413b0c601e0533d1d94ffd501ce2e7885", 26 | "type": "github" 27 | }, 28 | "original": { 29 | "owner": "edolstra", 30 | "repo": "flake-compat", 31 | "type": "github" 32 | } 33 | }, 34 | "git-hooks": { 35 | "inputs": { 36 | "flake-compat": "flake-compat", 37 | "gitignore": "gitignore", 38 | "nixpkgs": [ 39 | "nixpkgs" 40 | ] 41 | }, 42 | "locked": { 43 | "lastModified": 1759523803, 44 | "owner": "cachix", 45 | "repo": "git-hooks.nix", 46 | "rev": "cfc9f7bb163ad8542029d303e599c0f7eee09835", 47 | "type": "github" 48 | }, 49 | "original": { 50 | "owner": "cachix", 51 | "repo": "git-hooks.nix", 52 | "type": "github" 53 | } 54 | }, 55 | "gitignore": { 56 | "inputs": { 57 | "nixpkgs": [ 58 | "git-hooks", 59 | "nixpkgs" 60 | ] 61 | }, 62 | "locked": { 63 | "lastModified": 1709087332, 64 | "owner": "hercules-ci", 65 | "repo": "gitignore.nix", 66 | "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", 67 | "type": "github" 68 | }, 69 | "original": { 70 | "owner": "hercules-ci", 71 | "repo": "gitignore.nix", 72 | "type": "github" 73 | } 74 | }, 75 | "nixpkgs": { 76 | "locked": { 77 | "lastModified": 1758532697, 78 | "owner": "cachix", 79 | "repo": "devenv-nixpkgs", 80 | "rev": "207a4cb0e1253c7658c6736becc6eb9cace1f25f", 81 | "type": "github" 82 | }, 83 | "original": { 84 | "owner": "cachix", 85 | "ref": "rolling", 86 | "repo": "devenv-nixpkgs", 87 | "type": "github" 88 | } 89 | }, 90 | "root": { 91 | "inputs": { 92 | "devenv": "devenv", 93 | "git-hooks": "git-hooks", 94 | "nixpkgs": "nixpkgs", 95 | "pre-commit-hooks": [ 96 | "git-hooks" 97 | ] 98 | } 99 | } 100 | }, 101 | "root": "root", 102 | "version": 7 103 | } 104 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/model/check.clj: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.model.check 2 | "Model checking for behavioral programs. 3 | 4 | This namespace provides model checking capabilities for behavioral programs 5 | by implementing state-space exploration using the StateNavigator protocol. 6 | 7 | The main entry point is the `check` function which explores the state space 8 | once and detects all violations during traversal." 9 | (:require [tech.thomascothran.pavlov.search :as search])) 10 | 11 | ;; Internal implementation details below 12 | 13 | (defn- assemble-all-bthreads 14 | "Assembles all bthreads with proper priority ordering." 15 | [config] 16 | (let [;; Create bthreads from each category 17 | safety-bthreads (get config :safety-bthreads) 18 | main-bthreads (get config :bthreads) 19 | env-bthreads (get config :environment-bthreads)] 20 | ;; Order matters: safety -> main -> env -> deadlock 21 | (reduce into [] 22 | [safety-bthreads 23 | main-bthreads 24 | env-bthreads]))) 25 | 26 | (defn- check-for-violations 27 | "Check if the current state represents a violation. 28 | Returns violation map or nil." 29 | [wrapped config] 30 | (let [{:keys [path] :bprogram/keys [state]} wrapped 31 | next-event (:next-event state) 32 | ;; Check if the next event has invariant-violated flag 33 | event-data (when next-event 34 | (if (keyword? next-event) 35 | {:type next-event} 36 | next-event)) 37 | invariant-violated? (get event-data :invariant-violated)] 38 | 39 | (cond 40 | ;; Check for safety violation 41 | invariant-violated? 42 | {:type :safety-violation 43 | :event event-data 44 | :path path 45 | :state state} 46 | 47 | ;; Check for deadlock 48 | (and (not= false (:check-deadlock? config)) 49 | (nil? next-event) 50 | (not (get-in state [:last-event :terminal]))) 51 | {:type :deadlock 52 | :path path 53 | :state state} 54 | 55 | ;; No violation 56 | :else 57 | nil))) 58 | 59 | (defn check 60 | "Model check a behavioral program for safety violations. 61 | 62 | Explores the state space once, checking for: 63 | - Safety violations (events with :invariant-violated true) 64 | - Deadlocks (unless :check-deadlock? is false) 65 | 66 | Parameters: 67 | - config: map with keys: 68 | :bthreads - the bthreads under test 69 | :safety-bthreads - bthreads that detect violations 70 | :environment-bthreads - bthreads that generate events 71 | :check-deadlock? - if true, detect deadlocks (default: true) 72 | Returns: 73 | - nil if no violations found 74 | - {:type :safety-violation :event event :path [events] :state state} 75 | - {:type :deadlock :path [events] :state state}" 76 | [config] 77 | (let [all-bthreads (assemble-all-bthreads config) 78 | navigator (search/make-navigator all-bthreads)] 79 | 80 | (search/bfs-reduce 81 | navigator 82 | (fn [acc wrapped] 83 | (if-let [violation (check-for-violations wrapped config)] 84 | (reduced violation) 85 | acc)) 86 | nil))) 87 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/test/tech/thomascothran/pavlov/test_test.clj: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.test-test 2 | (:require [clojure.test :refer [deftest is]] 3 | [tech.thomascothran.pavlov.test :as ptest] 4 | [tech.thomascothran.pavlov.event :as e] 5 | [tech.thomascothran.pavlov.bthread :as b])) 6 | 7 | (deftest test-scenario-success 8 | (let [bthreads 9 | [[:event-a (b/bids [{:request #{:event-a}}])] 10 | [:event-b (b/bids [{:wait-on #{:event-a}} 11 | {:request #{:event-b}}])] 12 | [:event-c (b/bids [{:wait-on #{:event-b}} 13 | {:request #{:event-c}}])]] 14 | 15 | result (ptest/scenario bthreads [:event-a :event-b :event-c])] 16 | (is (get result :success)) 17 | (is (= [:event-a :event-b :event-c] 18 | (->> (get result :execution-path) 19 | (take 3)))))) 20 | 21 | (deftest allow-skips 22 | (let [bthreads 23 | [[:event-a (b/bids [{:request #{:event-a}}])] 24 | [:event-b (b/bids [{:wait-on #{:event-a}} 25 | {:request #{:event-b}}])] 26 | [:event-c (b/bids [{:wait-on #{:event-b}} 27 | {:request #{:event-c}}])]] 28 | 29 | result (ptest/scenario bthreads [:event-a :event-c])] 30 | (is (get result :success)) 31 | (is (= [:event-a :event-b :event-c] 32 | (->> (get result :execution-path) 33 | (take 3)))))) 34 | 35 | (deftest test-scenario-fail 36 | (let [bthreads 37 | {:event-a (b/bids [{:request #{:event-a}}]) 38 | :event-b (b/bids [{:wait-on #{:event-a}} 39 | {:request #{:event-b}}]) 40 | 41 | :event-d (b/bids [{:wait-on #{:event-b}} 42 | {:request #{:event-d}}]) 43 | :event-e (b/bids [{:wait-on #{:event-b}} 44 | {:request #{:event-e}}])} 45 | 46 | result (ptest/scenario bthreads [:event-a :event-b :event-c])] 47 | (is (= false (get result :success))) 48 | (is (= :event-b (get result :stuck-at))) 49 | (is (= {:request #{:event-e}} 50 | (get-in result [:bthread->bid :event-e])) 51 | "Should have bthread->bid mapping") 52 | (is (nil? 53 | (get-in result [:bthread->bid 54 | :event-a]))))) 55 | 56 | (deftest test-branch-with-same-event-types 57 | (let [bthreads 58 | {:event-a (b/bids [{:request #{:event-a}}]) 59 | :branch (b/bids 60 | [{:wait-on #{:event-a}} 61 | {:request #{{:type :event-b 62 | :flag false}}}]) 63 | :event-b-handler 64 | (b/on :event-b 65 | (fn [{:keys [flag]}] 66 | (when flag 67 | {:request #{:terminate}})))} 68 | 69 | event-selector 70 | (fn [event] 71 | (and (= :event-b 72 | (e/type event)) 73 | (get event :flag))) 74 | result (ptest/scenario bthreads [:event-a 75 | event-selector 76 | :terminate])] 77 | (is (not (get result :success))) 78 | (is (= :event-a (get result :stuck-at))))) 79 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/viz/portal.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.viz.portal 2 | (:refer-clojure :exclude [ancestors]) 3 | (:require [clojure.core.protocols :as p] 4 | [portal.api :as portal] 5 | [tech.thomascothran.pavlov.event :as e] 6 | [tech.thomascothran.pavlov.search :as search])) 7 | 8 | (defn hiccup-viewer 9 | [x] 10 | (vary-meta x assoc :portal.viewer/default :portal.viewer/hiccup)) 11 | 12 | (defn- node->data 13 | [nav wrapped chosen ancestors] 14 | (let [succs (search/succ nav wrapped) 15 | bthread-states (:saved-bthread-states wrapped) 16 | bthread->bid (get-in wrapped [:bprogram/state 17 | :bthread->bid]) 18 | make-child (fn [state event] 19 | {:nav nav :wrapped state :chosen event 20 | :ancestors (conj ancestors {:nav nav :wrapped wrapped 21 | :chosen chosen :ancestors ancestors})}) 22 | branches (-> (mapv (fn [{:keys [state event]}] 23 | (-> (if (map? event) 24 | event 25 | {:type event}) 26 | (vary-meta assoc ::child 27 | (make-child state event)))) 28 | succs) 29 | (with-meta 30 | {`p/nav 31 | (fn [_coll _k v] 32 | (if-let [{:keys [nav wrapped chosen ancestors]} 33 | (::child (meta v))] 34 | (node->data nav wrapped chosen ancestors) 35 | v))})) 36 | crumbs (->> (mapv (fn [{:keys [chosen]}] 37 | (e/type chosen)) 38 | ancestors) 39 | (filterv identity))] 40 | (filterv 41 | identity 42 | [(hiccup-viewer 43 | [:h1 "Bthread Navigator"]) 44 | (hiccup-viewer 45 | [:p "Navigate around the bprogram by double clicking the events under branches"]) 46 | (when chosen 47 | (hiccup-viewer 48 | [:h2 (str "Event: " (e/type chosen))])) 49 | (hiccup-viewer 50 | [:h3 "Branches"]) 51 | branches 52 | (hiccup-viewer [:hr]) 53 | (hiccup-viewer 54 | [:h3 "History"]) 55 | crumbs 56 | (hiccup-viewer [:hr]) 57 | (hiccup-viewer [:h6 "Details"]) 58 | {:bthread-states bthread-states 59 | :bthread->bid bthread->bid}]))) 60 | 61 | (defn bthreads->navigable 62 | "Given a navigator from `search` return a navigable data structure." 63 | [bthreads] 64 | (let [nav (search/make-navigator bthreads)] 65 | (node->data nav (search/root nav) nil []))) 66 | 67 | (comment 68 | ;; setup 69 | (require '[tech.thomascothran.pavlov.bthread :as b]) 70 | (do (def p (portal/open)) 71 | (add-tap #'portal/submit)) 72 | 73 | (do (def bthreads {:letters (b/bids [{:request [:a]} 74 | {:request [:b]} 75 | {:request [:c]}]) 76 | :numbers (b/bids [{:request #{1 2}} 77 | {:request #{3}}])}) 78 | (tap> 79 | (bthreads->navigable bthreads)))) 80 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/viz/cytoscape.clj: -------------------------------------------------------------------------------- 1 | (ns ^:alpha tech.thomascothran.pavlov.viz.cytoscape 2 | (:require [clojure.string :as str] 3 | [tech.thomascothran.pavlov.event :as e] 4 | [tech.thomascothran.pavlov.graph :as graph])) 5 | 6 | (defn- path->id 7 | [path] 8 | (pr-str path)) 9 | 10 | (defn- label-for 11 | [path event] 12 | (cond 13 | (empty? path) "initialize" 14 | (some? event) (-> (or (e/type event) event) pr-str) 15 | :else (-> (last path) pr-str))) 16 | 17 | (def ^:private state-keys 18 | [:last-event :next-event :requests :waits :blocks :bthread->bid :bthreads-by-priority]) 19 | 20 | (def ^:private default-state 21 | {:last-event nil 22 | :next-event nil 23 | :requests {} 24 | :waits {} 25 | :blocks {} 26 | :bthread->bid {} 27 | :bthreads-by-priority #{}}) 28 | 29 | (defn- sanitize-state 30 | [state] 31 | (when (map? state) 32 | (merge default-state (select-keys state state-keys)))) 33 | 34 | (defn- wrapped->meta 35 | [wrapped] 36 | (let [wrapped-map (when (map? wrapped) wrapped)] 37 | {:saved-bthread-states (or (get wrapped-map :saved-bthread-states) {}) 38 | :bprogram/state (or (some-> wrapped-map :bprogram/state sanitize-state) 39 | default-state)})) 40 | 41 | (defn- node-meta 42 | [path event wrapped] 43 | (let [{saved-bthread-states :saved-bthread-states 44 | state :bprogram/state} (wrapped->meta wrapped)] 45 | {:path path 46 | :event event 47 | :saved-bthread-states saved-bthread-states 48 | :bprogram/state state})) 49 | 50 | (defn- event-flags 51 | [event] 52 | (let [flag? (fn [k] 53 | (boolean (and (map? event) 54 | (get event k))))] 55 | {:environment? (flag? :environment) 56 | :terminal? (flag? :terminal) 57 | :invariant? (flag? :invariant-violated)})) 58 | 59 | (defn- node->cy-data 60 | [[path {:keys [event wrapped]}]] 61 | (let [meta (node-meta path event wrapped) 62 | flags (event-flags event) 63 | classes (->> [(when (:environment? flags) "environment") 64 | (when (:terminal? flags) "terminal") 65 | (when (:invariant? flags) "invariant")] 66 | (remove nil?) 67 | (str/join " "))] 68 | (cond-> {:data {:id (path->id path) 69 | :label (label-for path event) 70 | :path path 71 | :event event 72 | :meta meta 73 | :flags flags}} 74 | (seq classes) (assoc :classes classes)))) 75 | 76 | (defn- edge->cy-data 77 | [{:keys [from to] :as edge}] 78 | {:data (assoc edge 79 | :id (str (path->id from) "->" (path->id to)) 80 | :source (path->id from) 81 | :target (path->id to))}) 82 | 83 | (defn -graph->cytoscape 84 | "Given a graph from `tech.thomascothran.pavlov.graph/->graph`, build Cytoscape elements. 85 | 86 | Example: 87 | (-graph->cytoscape {:nodes {...} :edges [...]}) 88 | ;; => {:nodes [...] 89 | ;; :edges [...]}" 90 | [graph] 91 | {:nodes (->> graph :nodes (sort-by key) (map node->cy-data) vec) 92 | :edges (->> graph :edges (map edge->cy-data) vec)}) 93 | 94 | (defn graph->cytoscape 95 | "Return Cytoscape-compatible graph data for the supplied bthreads map. 96 | 97 | Example: 98 | (graph->cytoscape {:foo bthread}) 99 | ;; => {:nodes [...] 100 | ;; :edges [...]}" 101 | [bthreads] 102 | (-> bthreads 103 | graph/->graph 104 | -graph->cytoscape)) 105 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/viz/cytoscape.clj: -------------------------------------------------------------------------------- 1 | (ns ^:alpha tech.thomascothran.pavlov.viz.cytoscape 2 | (:require [clojure.string :as str] 3 | [tech.thomascothran.pavlov.event :as e] 4 | [tech.thomascothran.pavlov.graph :as graph])) 5 | 6 | (defn- path->id 7 | [path] 8 | (pr-str path)) 9 | 10 | (defn- label-for 11 | [path event] 12 | (cond 13 | (empty? path) "initialize" 14 | (some? event) (-> (or (e/type event) event) pr-str) 15 | :else (-> (last path) pr-str))) 16 | 17 | (def ^:private state-keys 18 | [:last-event :next-event :requests :waits :blocks :bthread->bid :bthreads-by-priority]) 19 | 20 | (def ^:private default-state 21 | {:last-event nil 22 | :next-event nil 23 | :requests {} 24 | :waits {} 25 | :blocks {} 26 | :bthread->bid {} 27 | :bthreads-by-priority #{}}) 28 | 29 | (defn- sanitize-state 30 | [state] 31 | (when (map? state) 32 | (merge default-state (select-keys state state-keys)))) 33 | 34 | (defn- wrapped->meta 35 | [wrapped] 36 | (let [wrapped-map (when (map? wrapped) wrapped)] 37 | {:saved-bthread-states (or (get wrapped-map :saved-bthread-states) {}) 38 | :bprogram/state (or (some-> wrapped-map :bprogram/state sanitize-state) 39 | default-state)})) 40 | 41 | (defn- node-meta 42 | [path event wrapped] 43 | (let [{saved-bthread-states :saved-bthread-states 44 | state :bprogram/state} (wrapped->meta wrapped)] 45 | {:path path 46 | :event event 47 | :saved-bthread-states saved-bthread-states 48 | :bprogram/state state})) 49 | 50 | (defn- event-flags 51 | [event] 52 | (let [flag? (fn [k] 53 | (boolean (and (map? event) 54 | (get event k))))] 55 | {:environment? (flag? :environment) 56 | :terminal? (flag? :terminal) 57 | :invariant? (flag? :invariant-violated)})) 58 | 59 | (defn- node->cy-data 60 | [[path {:keys [event wrapped]}]] 61 | (let [meta (node-meta path event wrapped) 62 | flags (event-flags event) 63 | classes (->> [(when (:environment? flags) "environment") 64 | (when (:terminal? flags) "terminal") 65 | (when (:invariant? flags) "invariant")] 66 | (remove nil?) 67 | (str/join " "))] 68 | (cond-> {:data {:id (path->id path) 69 | :label (label-for path event) 70 | :path path 71 | :event event 72 | :meta meta 73 | :flags flags}} 74 | (seq classes) (assoc :classes classes)))) 75 | 76 | (defn- edge->cy-data 77 | [{:keys [from to] :as edge}] 78 | {:data (assoc edge 79 | :id (str (path->id from) "->" (path->id to)) 80 | :source (path->id from) 81 | :target (path->id to))}) 82 | 83 | (defn -graph->cytoscape 84 | "Given a graph from `tech.thomascothran.pavlov.graph/->graph`, build Cytoscape elements. 85 | 86 | Example: 87 | (-graph->cytoscape {:nodes {...} :edges [...]}) 88 | ;; => {:nodes [...] 89 | ;; :edges [...]}" 90 | [graph] 91 | {:nodes (->> graph :nodes (sort-by key) (map node->cy-data) vec) 92 | :edges (->> graph :edges (map edge->cy-data) vec)}) 93 | 94 | (defn graph->cytoscape 95 | "Return Cytoscape-compatible graph data for the supplied bthreads map. 96 | 97 | Example: 98 | (graph->cytoscape {:foo bthread}) 99 | ;; => {:nodes [...] 100 | ;; :edges [...]}" 101 | [bthreads] 102 | (-> bthreads 103 | graph/->graph 104 | -graph->cytoscape)) 105 | -------------------------------------------------------------------------------- /doc/design/003_bthread-macro.md: -------------------------------------------------------------------------------- 1 | # Bthread Macro 2 | 3 | Created: Sept 1, 2025. 4 | 5 | ## Context 6 | 7 | Defining bthreads can be insufficiently expressive. 8 | 9 | For example, we can define a step function as: 10 | 11 | ```clojure 12 | (def my-step-fn 13 | (fn [prev-state {event-type :type :as event}] 14 | (case event-type 15 | ;; Initialize 16 | nil [{:initialized true} {:wait-on #{:event-a}}] 17 | 18 | :event-a 19 | [(update prev-state :a-called inc) 20 | {:request #{{:type :event-c}}} 21 | :wait-on #{:event-d}}])) 22 | ``` 23 | 24 | This becomes quite repetitive and noisy. It's not immediately clear to the beginner that a `nil` event only occurs on initialization. Other forms often pop up that mean the same thing: 25 | 26 | 27 | ```clojure 28 | (def my-step-fn 29 | (fn [prev-state event] 30 | (if (nil? event) 31 | [{:initialized true} {:request #{{:type :event-a}} 32 | :wait-on #{:event-b}}]) 33 | ;; handle :event-a OR :event-b OR event-c OR event-d 34 | [(update prev-state :called-times inc) 35 | {:request #{{:type :event-c}}} 36 | :wait-on #{:event-d}}])) 37 | ``` 38 | 39 | And there are gotchas: 40 | 41 | 42 | ```clojure 43 | (def my-step-fn 44 | (fn [prev-state {event-type :type :as event}] 45 | (case event-type 46 | ;; Initialize 47 | nil 48 | [nil {:request #{#{:type :fire-missiles}}}] 49 | 50 | :fire-missiles 51 | (do (missile-api/fire!) 52 | [nil {:request #{{:type :missiles-fired}}}])))) 53 | ``` 54 | 55 | This will throw an error, and the reason why is not expressed clearly in the syntax. Unless the `:missiles-fired` event is blocked, this bthread will be notified of that event, and as it is not handled in the case statement, an error will be thrown. 56 | 57 | What is needed is a macro that expresses more clearly what the bthread is doing, and provides safeguards. 58 | 59 | ## Constraints 60 | 61 | We want something that will be easy to lint using clj-kondo and other tools. 62 | 63 | ## Options 64 | 65 | ### Option A: Mimic Case 66 | 67 | We could do something similar to `case`: 68 | 69 | ```clojure 70 | (def my-bthread 71 | (b/thread [prev-state event] 72 | :pavlov/init ;; required! 73 | [{:initialized true} 74 | {:wait-on #{:fire-missiles}}] 75 | 76 | #{:fire-missiles} ;; set of all events to trigger body 77 | (let [result (missiles-api/fire!)] 78 | [prev-state {:request #{{:type :missiles-fired 79 | :result result}}}]) 80 | 81 | ;; optional default, if not provided returns {} - no requests, 82 | ;; waits or blocks 83 | [prev-state {:wait-on #{:fire-missiles}}])) 84 | ``` 85 | 86 | One advantage of this is that we can lint `b/thread` as `defn`. In the future if we wanted to add metadata to it (e.g. for a label), we could. 87 | 88 | ### Option B: Mimic Defrecord 89 | 90 | Or we could do something like: 91 | 92 | ```clojure 93 | (def my-bthread 94 | (b/thread [prev-state event] 95 | (init []) ;; required! 96 | [{:initialized true} 97 | {:wait-on #{:fire-missiles}}] 98 | 99 | (on [:fire-missiles] ;; set of all events to trigger body 100 | (let [result (missiles-api/fire!)] 101 | [prev-state {:request #{{:type :missiles-fired 102 | :result result}}}]) 103 | 104 | ;; optional default, if not provided returns {} - no requests, 105 | ;; waits or blocks 106 | (default []) 107 | [prev-state {:wait-on #{:fire-missiles}}])) 108 | 109 | ``` 110 | 111 | ## Decision 112 | 113 | Option A 114 | -------------------------------------------------------------------------------- /dev/demo/bank/domain.cljc: -------------------------------------------------------------------------------- 1 | (ns demo.bank.domain 2 | (:require [tech.thomascothran.pavlov.bthread :as b] 3 | [tech.thomascothran.pavlov.viz.portal :as pvp] 4 | [tech.thomascothran.pavlov.model.check :as check])) 5 | 6 | (defn make-request-cip-verification-bthread 7 | [] 8 | (b/bids [{:wait-on #{:application-submitted}} 9 | {:request #{{:type :request-cip-verification}}}])) 10 | 11 | (defn make-request-ofac-screening-bthread 12 | [] 13 | (b/bids [{:wait-on #{:application-submitted}} 14 | {:request #{{:type :ofac-screening-requested}}}])) 15 | 16 | (defn make-cip-failure-rule-bthread 17 | [] 18 | (b/on :cip-failed 19 | (constantly 20 | {:request #{{:type :application-declined}}}))) 21 | 22 | (defn make-ofac-hit-rule-bthread 23 | [] 24 | (b/on :ofac-hit 25 | (constantly 26 | {:request #{{:type :application-declined}}}))) 27 | 28 | (defn make-request-initial-deposit-bthread 29 | [] 30 | (b/bids [{:request #{{:type :initial-deposit-requested}}}])) 31 | 32 | (defn make-block-deposit-until-cip-verified 33 | [] 34 | (b/bids [{:block #{:initial-deposit-requested} 35 | :wait-on #{:cip-verified}}])) 36 | 37 | (defn make-block-opening-until-ofac-cleared 38 | [] 39 | (b/bids [{:block #{:initial-deposit-requested} 40 | :wait-on #{:ofac-clear}}])) 41 | 42 | ;; When initial funds arrive, open the account (happy-path terminator). 43 | (defn make-open-on-funding-bthread 44 | [] 45 | (b/bids [{:wait-on #{:initial-deposit-paid}} 46 | {:request #{{:type :account-opened}}}])) 47 | 48 | (defn make-bthreads-v1 49 | [] 50 | {::request-cip-verification-bthread 51 | (make-request-cip-verification-bthread) 52 | 53 | ::request-ofac-screening-bthread 54 | (make-request-ofac-screening-bthread) 55 | 56 | ::cip-failure-rule-bthread 57 | (make-cip-failure-rule-bthread) 58 | 59 | ::ofac-hit-rule-bthread 60 | (make-ofac-hit-rule-bthread) 61 | 62 | ::request-initial-deposit-bthread 63 | (make-request-initial-deposit-bthread) 64 | 65 | ::block-deposit-until-cip-verified 66 | (make-block-deposit-until-cip-verified) 67 | 68 | ::block-opening-until-ofac-cleared 69 | (make-block-opening-until-ofac-cleared) 70 | 71 | ::open-on-funding 72 | (make-open-on-funding-bthread)}) 73 | 74 | (defn make-environment-bthreads-v1 75 | [] 76 | {::application-submitted 77 | (b/bids 78 | [{:request #{{:type :application-submitted}}}]) 79 | ::pay-deposit 80 | (b/bids [{:request #{{:type :initial-deposit-paid}}}])}) 81 | 82 | (defn make-account-opening-requires-ofac-screening-bthread 83 | [] 84 | (b/bids [{:wait-on #{:account-opened}} 85 | {:wait-on #{:ofac-clear} 86 | :request #{{:type :account-opened 87 | :invariant-violated true}}}])) 88 | 89 | (defn safety-bthreads-v1 90 | [] 91 | {::account-opening-requires-ofac-screening 92 | (make-account-opening-requires-ofac-screening-bthread)}) 93 | 94 | (comment 95 | ;; Uh oh - we can open an account before the ofac is clear! 96 | (-> {:bthreads (make-bthreads-v1) 97 | :environment-bthreads (make-environment-bthreads-v1) 98 | :safety-bthreads (safety-bthreads-v1) 99 | :check-deadlock? false #_true} 100 | (check/check) 101 | tap>)) 102 | 103 | (comment 104 | (-> (reduce into (safety-bthreads-v1) 105 | [(make-bthreads-v1) 106 | (make-environment-bthreads-v1)]) 107 | 108 | (pvp/bthreads->navigable) 109 | (tap>))) 110 | 111 | ;; More rules to consider: 112 | ;; 113 | ;; - PEPs 114 | ;; - Identity Theft Alerts 115 | ;; - Liquidity stress 116 | ;; - Large initial deposits 117 | ;; - Litigation hold 118 | ;; - Bankruptcy 119 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bprogram/state.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.state 2 | (:require [tech.thomascothran.pavlov.event :as event] 3 | [tech.thomascothran.pavlov.event.selection 4 | :as event-selection] 5 | [tech.thomascothran.pavlov.bprogram.notification :as notification])) 6 | 7 | (defn next-event 8 | "The winning bid will request a new event" 9 | [state] 10 | (let [bthreads-by-priority (get state :bthreads-by-priority) 11 | bthreads->bid (get state :bthread->bid)] 12 | (event-selection/prioritized-event 13 | bthreads-by-priority 14 | bthreads->bid))) 15 | 16 | ;; Here, we can put the bthreads in order of priority 17 | (defn init 18 | "Initiate the state" 19 | [named-bthreads] 20 | (let [ordered-bthreads? (not (map? named-bthreads)) 21 | name->bthread (into {} named-bthreads) 22 | bthreads-by-priority 23 | (if ordered-bthreads? 24 | (into [] (map first) named-bthreads) 25 | (into #{} (map first) named-bthreads)) 26 | 27 | initial-state {:bthread->bid {} 28 | :last-event nil 29 | :name->bthread name->bthread 30 | :bthreads-by-priority bthreads-by-priority} 31 | 32 | notification-results (notification/notify-bthreads! initial-state) 33 | 34 | state (merge initial-state notification-results) 35 | next-event' (next-event state)] 36 | (assoc state :next-event next-event'))) 37 | 38 | (defn- merge-event->bthreads 39 | [previous new] 40 | (merge-with #(into (or %1 #{}) %2) 41 | previous new)) 42 | 43 | (defn- remove-triggered-bthreads 44 | [triggered-bthreads event->threads] 45 | (into {} 46 | (map (fn [[event bthreads]] 47 | [event (->> bthreads 48 | (remove (or triggered-bthreads #{})) 49 | (into #{}))])) 50 | event->threads)) 51 | 52 | (defn next-state 53 | [{:keys [state event]} 54 | {new-bthread->bid :bthread->bid 55 | new-waits :waits 56 | new-requests :requests 57 | new-blocks :blocks}] 58 | 59 | (let [triggered-bthreads 60 | (into #{} 61 | (mapcat #(get % (event/type event))) 62 | [(get state :waits) 63 | (get state :requests)]) 64 | 65 | rm-triggered-bthreads 66 | #(remove-triggered-bthreads triggered-bthreads %) 67 | 68 | waits (-> (get state :waits) 69 | (dissoc event) 70 | rm-triggered-bthreads 71 | (merge-event->bthreads new-waits)) 72 | requests (-> (get state :requests) 73 | (dissoc event) 74 | rm-triggered-bthreads 75 | (merge-event->bthreads new-requests)) 76 | blocks (-> (get state :blocks) 77 | (dissoc event) 78 | rm-triggered-bthreads 79 | (merge-event->bthreads new-blocks)) 80 | 81 | next-bthread->bid 82 | (-> (get state :bthread->bid) 83 | (#(apply dissoc % triggered-bthreads)) 84 | (into new-bthread->bid)) 85 | 86 | next-state 87 | (assoc state 88 | :last-event event 89 | :waits waits 90 | :requests requests 91 | :blocks blocks 92 | :bthreads-by-priority (get state :bthreads-by-priority) 93 | :bthread->bid next-bthread->bid) 94 | 95 | next-event (next-event next-state)] 96 | (assoc next-state :next-event next-event))) 97 | 98 | (defn step 99 | "Return the next state based on the event" 100 | [state event] 101 | (let [last-event (get state :last-event) 102 | notification-results 103 | (notification/notify-bthreads! state event)] 104 | (next-state {:state state 105 | :last-event last-event 106 | :event event} 107 | notification-results))) 108 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/event/selection.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.event.selection 2 | "Contains strategies for select the next bid from a set of bthreads. 3 | 4 | Divides into three types of functions: 5 | 6 | `unblocked-bthreads?` 7 | --------------------- 8 | Returns a function to be applied to a a bthread to see if it is unblocked. 9 | 10 | This is a concrete function. 11 | 12 | Usage: 13 | 14 | ```clojure 15 | (defn unblocked-bthreads-by-priority 16 | [bthreads-by-priority bthread->bid blocked-event-types] 17 | (let [unblocked? (unblocked-bthread? bthread->bid blocked-event-types)] 18 | (filter unblocked? bthreads-by-priority))) 19 | ``` 20 | 21 | bid selection strategies 22 | ------------------------ 23 | There are different ways we can select winning bids. The simplest and 24 | easiest to think about is by priority, where every bthread has a unique 25 | priority order. 26 | 27 | If the bthreads are in an ordered collection, they are in priority order. If unordered they are all of equal priority 28 | 29 | request selection strategies 30 | ----------------------------- 31 | The winning bid may request multiple events and some of these events 32 | may be blocked. Thus there is a decision to be made about which of a 33 | bid's unblocked requests should be selected. 34 | 35 | If the requests ordered sequence, they are priortized from highest 36 | to lowest priority. The highest priority event is selected. " 37 | (:require [tech.thomascothran.pavlov.bid.proto :as bid] 38 | [tech.thomascothran.pavlov.event :as event] 39 | [clojure.set :as set])) 40 | 41 | (defn- blocked 42 | [bthread->bids] 43 | (into #{} 44 | (comp (map second) 45 | (mapcat bid/block) 46 | (map event/type)) 47 | bthread->bids)) 48 | 49 | (defn- unblocked-requests 50 | [blocked-events bid] 51 | (set/difference (into #{} 52 | (map event/type) 53 | (bid/request bid)) 54 | blocked-events)) 55 | (defn- unblocked? 56 | [blocked-events bid] 57 | (seq (unblocked-requests blocked-events bid))) 58 | 59 | ;; API functions 60 | 61 | (defn unblocked-bthread? 62 | "Returns a function that checks if a bthread is unblocked" 63 | [bthread->bid blocked-event-types] 64 | (comp 65 | #(unblocked? blocked-event-types %) 66 | #(get bthread->bid %))) 67 | 68 | ;; =============================| 69 | ;; bthread selection strategies | 70 | ;; =============================| 71 | 72 | (defn prioritized-bids 73 | "Returns the all bids which can be selected." 74 | 75 | ([bthreads-by-priority bthread->bid] 76 | (prioritized-bids bthreads-by-priority 77 | bthread->bid 78 | (blocked bthread->bid))) 79 | 80 | ([bthreads-by-priority bthread->bid blocked-event-types] 81 | (cond->> (into [] 82 | (comp (filter (unblocked-bthread? bthread->bid 83 | blocked-event-types)) 84 | (map #(get bthread->bid %))) 85 | bthreads-by-priority) 86 | (not (set? bthreads-by-priority)) 87 | (take 1)))) 88 | 89 | (defn- prioritized-events-from-request 90 | [request] 91 | (if (set? request) 92 | request 93 | (take 1 request))) 94 | 95 | ;; ===========================| 96 | ;; event selection strategies | 97 | ;; ===========================| 98 | 99 | (defn prioritized-events 100 | ([bthreads-by-priority bthread->bid] 101 | (prioritized-events bthreads-by-priority 102 | bthread->bid 103 | (blocked bthread->bid))) 104 | ([bthreads-by-priority bthread->bid blocked-event-types] 105 | (into [] 106 | (comp (map bid/request) 107 | (mapcat prioritized-events-from-request) 108 | (remove (comp blocked-event-types event/type))) 109 | (prioritized-bids bthreads-by-priority 110 | bthread->bid 111 | blocked-event-types)))) 112 | 113 | (defn prioritized-event 114 | [bthreads-by-priority bthread->bid] 115 | (let [blocked-event-types (blocked bthread->bid)] 116 | (some->> (prioritized-bids bthreads-by-priority bthread->bid) 117 | first 118 | bid/request 119 | (remove (comp blocked-event-types event/type)) 120 | first))) 121 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bprogram/notification.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.notification 2 | "Functions for notifying bthreads of events and collecting their bids." 3 | (:require [tech.thomascothran.pavlov.bthread :as b] 4 | [tech.thomascothran.pavlov.bid.proto :as bid] 5 | [tech.thomascothran.pavlov.event :as event])) 6 | 7 | (defn bthreads-to-notify 8 | "Returns the set of bthread names that should be notified for a given event. 9 | 10 | A bthread should be notified if it is either waiting on or requesting 11 | the event type. 12 | 13 | Parameters: 14 | - state: The current state map containing :waits and :requests indices 15 | - event: The event to check (must have a type via event/type) 16 | 17 | Returns: 18 | A vector of bthread names that are interested in this event type. 19 | Returns an empty vector if event is nil." 20 | [state event] 21 | (when event 22 | (reduce into [] [(get-in state [:waits (event/type event)]) 23 | (get-in state [:requests (event/type event)])]))) 24 | 25 | (defn index-bid-events 26 | "Indexes events from a bid by adding the bthread to the appropriate event-type sets. 27 | 28 | Creates an inverted index that maps event types to sets of interested bthreads, 29 | enabling fast lookup of which bthreads should be notified when an event occurs. 30 | 31 | Parameters: 32 | - state: The current state map containing event indices 33 | - bthread-name: The name/key of the bthread whose events are being indexed 34 | - bid: The bid containing the events to index 35 | - request-type: One of :requests, :waits, or :blocks 36 | 37 | Returns: 38 | Updated state with the bthread-name added to the sets for each event type 39 | in the bid under the path [request-type event-type]. 40 | 41 | Example: 42 | (index-bid-events {:requests {:click #{}}} 43 | :my-bthread 44 | {:request #{{:type :click} {:type :hover}}} 45 | :requests) 46 | => {:requests {:click #{:my-bthread} 47 | :hover #{:my-bthread}}}" 48 | [state bthread-name bid request-type] 49 | (let [event-fn (case request-type 50 | :requests bid/request 51 | :waits bid/wait-on 52 | :blocks bid/block) 53 | event-types (event-fn bid)] 54 | (if (seq event-types) 55 | (reduce (fn [state requested-event] 56 | (update-in state [request-type 57 | (if :requests 58 | (event/type requested-event) 59 | requested-event)] 60 | #(into #{bthread-name} %))) 61 | state 62 | event-types) 63 | state))) 64 | 65 | (defn notify-bthreads! 66 | "Notifies relevant bthreads of an event and collects their updated bids. 67 | 68 | This function: 69 | 1. Identifies which bthreads should be notified (those waiting on or requesting the event) 70 | 2. Calls each bthread's bid function with the event to get their new bid 71 | 3. Indexes the events from each new bid for fast lookup 72 | 73 | Parameters: 74 | - state: The current BP state containing: 75 | - :name->bthread - map of bthread names to bthread instances 76 | - :waits - index of event types to waiting bthreads 77 | - :requests - index of event types to requesting bthreads 78 | - event: The event that occurred (optional - if not provided, notifies ALL bthreads with nil event) 79 | 80 | Returns: 81 | A map containing only the updates from notified bthreads: 82 | - :bthread->bid - map of bthread names to their new bids 83 | - :requests - index of requested event types to bthread names 84 | - :waits - index of waited event types to bthread names 85 | - :blocks - index of blocked event types to bthread names 86 | 87 | The caller is responsible for merging these updates into the main state." 88 | ([state] 89 | (notify-bthreads! state nil (keys (:name->bthread state)))) 90 | ([state event] 91 | (notify-bthreads! state event (bthreads-to-notify state event))) 92 | ([state event bthread-names] 93 | (reduce (fn [acc bthread-name] 94 | (let [bthread (get-in state [:name->bthread bthread-name]) 95 | _ (when-not bthread (println "No bthread found for" bthread-name)) 96 | bid (b/notify! bthread event)] 97 | (-> acc 98 | (assoc-in [:bthread->bid bthread-name] bid) 99 | (index-bid-events bthread-name bid :requests) 100 | (index-bid-events bthread-name bid :waits) 101 | (index-bid-events bthread-name bid :blocks)))) 102 | {:bthread->bid {}} 103 | bthread-names))) 104 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/test.cljc: -------------------------------------------------------------------------------- 1 | (ns ^:alpha tech.thomascothran.pavlov.test 2 | "utilies to make testing easier for pavlov 3 | 4 | Disinction from model checker and `nav` 5 | -------------------------------------- 6 | Bthread states are also navigable via `nav` and 7 | the search functions. However, those will call all 8 | possible successor bthreads. For bthreads that don't 9 | do IO, this is fine. 10 | 11 | However, where bthreads have side effects, neither 12 | the model checker can roll those back. 13 | 14 | `scenario` allowed you to provide a sequence of events 15 | that you expect to occur, and checks whether they in fact 16 | occur in that order. It executes the bprogram normally. 17 | Hence it is suitable for integration tests with side 18 | effecting bthreads 19 | 20 | " 21 | (:require [tech.thomascothran.pavlov.bprogram.ephemeral :as bpe] 22 | [tech.thomascothran.pavlov.bprogram :as bp] 23 | [tech.thomascothran.pavlov.event :as e])) 24 | 25 | (defn passes? 26 | [scenario event] 27 | (let [passes* 28 | (if (fn? scenario) 29 | scenario 30 | (comp (partial = scenario) e/type))] 31 | (passes* event))) 32 | 33 | (defn scenario 34 | "Check whether `scenario` exists for a group of bthreads 35 | 36 | For example, given a `scenario` of `[:event-a :event-b :event-c]`, check 37 | whether a corresponding execution path is occurs given `bthreads`. 38 | 39 | Arguments 40 | ========= 41 | - `bthreads`: mapping of bthread-names to bthreads 42 | - `scenarios`: a sequence of either event types 43 | or predicate functions that take an event 44 | 45 | `scenarios` do not need to list *every* event that 46 | happens. The scenario is successful so long as 47 | the events specified by the scenario occur in 48 | the specified order, even if other events occur 49 | between or after them. 50 | 51 | Returns 52 | ======= 53 | A map with the keys: 54 | 55 | `:success` 56 | ---------- 57 | `true` if the scenario is occurs, else `false` 58 | 59 | `:stuck-at` 60 | ----------- 61 | If unsuccessful, the last event that was reachable for that scenario. 62 | 63 | For example, if, at the execution path `[:event-a :event-b]`, `:event-c` 64 | is not reachable, then `:stuck-at` will be `event-b` 65 | 66 | `:bthread->bid` 67 | ----------------- 68 | A map of the bthread name to its bid at the point 69 | the execution got stuck, if applicable. 70 | 71 | Example 72 | ------- 73 | (let [bthreads 74 | [[:event-a (b/bids [{:request #{:event-a}}])] 75 | [:event-b (b/bids [{:wait-on #{:event-a}} 76 | {:request #{:event-b}}])] 77 | [:event-c (b/bids [{:wait-on #{:event-b}} 78 | {:request #{:event-c}}])]]] 79 | (ptest/scenario bthreads [:event-a :event-b :event-c])) 80 | 81 | 82 | Caveats 83 | ------- 84 | If your bthreads are non-deterministic, then you 85 | may get different results on different runs. Use 86 | the model checker in that case. 87 | " 88 | [bthreads scenario & [config]] 89 | (let [!events (atom []) 90 | event-logger (fn [event program-state] 91 | (swap! !events conj 92 | [event 93 | (bp/bthread->bids program-state)])) 94 | config' (assoc config 95 | :subscribers {:event-logger event-logger}) 96 | _ @(bpe/execute! bthreads config')] 97 | 98 | (loop [processed-events [] 99 | remaining-scenarios scenario 100 | remaining-events @!events 101 | last-match nil] 102 | (let [current-scenario (first remaining-scenarios) 103 | [current-event 104 | current-state] (first remaining-events) 105 | scenario-passes? (passes? 106 | current-scenario 107 | current-event) 108 | stuck-at (first last-match)] 109 | (cond (nil? current-scenario) 110 | {:success true 111 | :execution-path (mapv first @!events)} 112 | 113 | (nil? current-event) 114 | {:success false 115 | :execution-path (mapv first @!events) 116 | :stuck-at stuck-at 117 | :bthread->bid (second last-match)} 118 | 119 | :else 120 | (recur (conj processed-events current-event) 121 | (if scenario-passes? 122 | (rest remaining-scenarios) 123 | remaining-scenarios) 124 | (rest remaining-events) 125 | (if scenario-passes? 126 | [current-event current-state] 127 | last-match))))))) 128 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/bprogram/state_test.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.state-test 2 | (:require #?(:clj [clojure.test :refer [deftest is]] 3 | :cljs [cljs.test :refer [deftest is]]) 4 | [tech.thomascothran.pavlov.event.defaults] 5 | [tech.thomascothran.pavlov.bid.defaults] 6 | [tech.thomascothran.pavlov.bthread.defaults] 7 | [tech.thomascothran.pavlov.bthread :as b] 8 | [tech.thomascothran.pavlov.bprogram.state :as s] 9 | [tech.thomascothran.pavlov.bprogram.notification :as notification])) 10 | 11 | (deftest test-init 12 | (let [bid-a {:request #{{:type :a}}} 13 | bid-b {:wait-on #{{:type :b}}} 14 | bid-c {:block #{{:type :c}}} 15 | 16 | expected-bids ;; Literals are both 17 | {:bid-a bid-a ;; bthread and bids 18 | :bid-b bid-b 19 | :bid-c bid-c} 20 | 21 | state (s/init [[:bid-a bid-a] 22 | [:bid-b bid-b] 23 | [:bid-c bid-c]])] 24 | 25 | (is (= {:a #{:bid-a}} 26 | (:requests state))) 27 | 28 | (is (= {:b #{:bid-b}} 29 | (:waits state))) 30 | 31 | (is (= {:c #{:bid-c}} 32 | (:blocks state))) 33 | 34 | (is (nil? (:last-event state))) 35 | 36 | (is (= 3 (count (:bthread->bid state)))) 37 | 38 | (is (= expected-bids 39 | (into {} (:bthread->bid state))) 40 | "Should have the expected bids") 41 | (is (= {:type :a} 42 | (:next-event state)) 43 | "Should queue up the next event"))) 44 | 45 | (deftest test-winning-bid 46 | (let [bthread-a {:request #{{:type :a}}} 47 | state (s/init {:bthread-a bthread-a})] 48 | (is (= {:type :a} 49 | (s/next-event state)))) 50 | 51 | (let [bthread-a {:request #{{:type :a}}} 52 | bthread-b {:request #{{:type :b}}} 53 | bthread-c {:request #{{:type :c}}} 54 | state (s/init [[:bthread-b bthread-b] 55 | [:bthread-c bthread-c] 56 | [:bthread-a bthread-a]])] 57 | 58 | (is (= {:type :b} 59 | (s/next-event state)))) 60 | 61 | (let [bthread-a {:request #{{:type :a}}} 62 | bthread-b {:request #{{:type :b}}} 63 | bthread-c {:request #{{:type :c}} 64 | :block #{:b}} 65 | state (s/init [[:bthread-c bthread-c] 66 | [:bthread-a bthread-a] 67 | [:bthread-b bthread-b]])] 68 | (is (= {:type :c} 69 | (s/next-event state))))) 70 | 71 | (deftest test-blocked-events-on-winning-bid 72 | (let [bthread-a {:request [:blocked :a]} 73 | bthread-b {:block #{:blocked}} 74 | state (s/init [[:bthread-a bthread-a] 75 | [:bthread-b bthread-b]])] 76 | (is (= :a (s/next-event state))))) 77 | 78 | (deftest test-notify-bthreads! 79 | (let [request-bthread-ab (b/bids [{:request #{:a}} 80 | {:request #{:b}}]) 81 | request-bthread-c {:request #{:c}} 82 | wait-bthread-d (b/bids [{:wait-on #{:a}} 83 | {:request #{:d}}]) 84 | 85 | state (s/init [[:request-bthread-ab request-bthread-ab] 86 | [:request-bthread-c request-bthread-c] 87 | [:wait-bthread-d wait-bthread-d]]) 88 | 89 | result 90 | (notification/notify-bthreads! state {:type :a})] 91 | 92 | (is (= {:request-bthread-ab {:request #{:b}} 93 | :wait-bthread-d {:request #{:d}}} 94 | (:bthread->bid result))) 95 | 96 | (is (= {:d #{:wait-bthread-d} 97 | :b #{:request-bthread-ab}} 98 | (:requests result))))) 99 | 100 | (deftest test-step-removes-requests 101 | (let [bthread-a (b/bids [{:request #{:a}}]) 102 | state (s/init [[:bthread-a bthread-a]]) 103 | next-state (s/step state {:type :a})] 104 | (is (= #{} (get-in next-state [:requests :a])))) 105 | 106 | (let [bthread-a (b/bids [{:request #{:a}}]) 107 | bthread-b (b/bids [{:wait-on #{:a}} 108 | {:request #{:b}}]) 109 | state (s/init [[:bthread-a bthread-a] 110 | [:bthread-b bthread-b]]) 111 | next-state (s/step state {:type :a})] 112 | (is (not (= bthread-a bthread-b))) 113 | (is (= #{} (get-in next-state [:requests :a]))) 114 | (is (= #{:bthread-b} 115 | (get-in next-state [:requests :b]))))) 116 | 117 | (deftest test-step-removes-terminated-bthreads 118 | (let [bthread-a (b/bids [{:request #{:a}}]) 119 | state (s/init [[:bthread-a bthread-a]]) 120 | next-state (s/step state {:type :a})] 121 | (is (nil? (get-in next-state [:bthread->bid bthread-a]))))) 122 | 123 | (deftest test-step 124 | (let [bid-a {:request #{:a}} 125 | bid-b (b/step (constantly {:request #{:b}})) 126 | state (s/init [[:bid-a bid-a] 127 | [:bid-b bid-b]]) 128 | next-state (s/step state {:type :a})] 129 | (is (= :a (:next-event next-state))))) 130 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/bprogram/ephemeral_test/bthreads.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.ephemeral-test.bthreads 2 | (:require 3 | [tech.thomascothran.pavlov.bthread :as b] 4 | [tech.thomascothran.pavlov.defaults] 5 | [tech.thomascothran.pavlov.event :as event])) 6 | 7 | (def straight-wins-paths 8 | (let [product 9 | (for [x (range 3) 10 | y (range 3)] 11 | [x y]) 12 | 13 | vertical 14 | (partition 3 product) 15 | 16 | horizontal 17 | (->> (sort-by second product) 18 | (partition 3))] 19 | (reduce into [] [vertical horizontal]))) 20 | 21 | (def crossing-win-bthreads 22 | [(map vector [0 1 2] [0 1 2]) 23 | (map vector [2 1 0] [0 1 2])]) 24 | 25 | (def winning-paths 26 | (into crossing-win-bthreads straight-wins-paths)) 27 | 28 | (def winning-event-set 29 | (for [paths winning-paths 30 | player [:x :o]] 31 | (into #{} (map #(conj % player)) paths))) 32 | 33 | (defn make-winning-bthreads 34 | "for a winning path (e.g., three diagonal squares 35 | selected by the same player), emit a win event 36 | and terminate the pogram." 37 | [path-events] 38 | (b/step 39 | (fn [{:keys [remaining-events] :as acc} event] 40 | (let [event-type (event/type event) 41 | remaining-events' (disj remaining-events event-type) 42 | events-to-watch 43 | (into #{} (map (fn [event] {:type event}) 44 | path-events)) 45 | default-bid {:wait-on events-to-watch}] 46 | (cond (nil? event) ;; event is nil on initialization 47 | [{:remaining-events (set path-events)} default-bid] 48 | 49 | ;; Terminate - we've won! 50 | (= remaining-events #{event-type}) 51 | [{:remaining-events remaining-events'} 52 | {:request #{{:type [(last event-type) :wins] 53 | :terminal true}}}] 54 | 55 | :else 56 | [(update acc :remaining-events disj event-type) default-bid]))))) 57 | 58 | ;; Now we need to handle moves. 59 | ;; But we need some rules. 60 | ;; First, you can't pick the same square 61 | (defn make-no-double-placement-bthreads 62 | "You can't pick another player's square!" 63 | [] 64 | (for [x-coordinate [0 1 2] 65 | y-coordinate [0 1 2]] 66 | [[::no-double-placement x-coordinate y-coordinate] 67 | (b/bids 68 | [{:wait-on #{[x-coordinate y-coordinate :x] 69 | [x-coordinate y-coordinate :o]}} 70 | {:block #{[x-coordinate y-coordinate :x] 71 | [x-coordinate y-coordinate :o]}}])])) 72 | 73 | (defn make-computer-picks-bthreads 74 | "Without worrying about strategy, let's pick a square" 75 | [player] 76 | (b/bids (for [x-coordinate [0 1 2] 77 | y-coordinate [0 1 2]] 78 | {:request #{{:type [x-coordinate y-coordinate player]}}}))) 79 | 80 | ;; But wait? Doesn't `make-computer-picks` need to account for 81 | ;; the squares that are already occupied? 82 | ;; 83 | ;; Nope! the no double placement bthread takes care of that for us. 84 | ;; 85 | ;; OK, but won't we have to rewrite it when we take strategy into 86 | ;; account, e.g., picking the winning square or blocking the other 87 | ;; player? 88 | ;; 89 | ;; Nope! We can add strategies incrementally and prioritize them. 90 | 91 | ;; We were able to get our computer to make moves. 92 | ;; But it's just going to keep picking without waiting for 93 | ;; the other player! 94 | ;; We need a bthread that enforces turns. 95 | 96 | (defn make-enforce-turn-bthreads 97 | [] 98 | (let [moves (for [x-coord [0 1 2] 99 | y-coord [0 1 2] 100 | player [:x :o]] 101 | [x-coord y-coord player]) 102 | 103 | x-moves 104 | (into #{} 105 | (comp (filter (comp (partial = :x) last))) 106 | moves) 107 | 108 | o-moves 109 | (into #{} 110 | (comp (filter (comp (partial = :o) last))) 111 | moves)] 112 | 113 | (b/round-robin [{:wait-on x-moves 114 | :block o-moves} 115 | {:wait-on o-moves 116 | :block x-moves}]))) 117 | 118 | ;; Notice that this rule could be generalized. 119 | ;; It could take the players and coordinates as parameters 120 | ;; and then be used for *any* turn based game. Chess, 121 | ;; checkers, poker, etc. 122 | 123 | ;; We also need a rule for a draw 124 | (defn make-draw-bthread 125 | [] 126 | (let [all-moves 127 | (into #{} 128 | (for [x-coord [0 1 2] 129 | y-coord [0 1 2] 130 | player [:x :o]] 131 | [x-coord y-coord player]))] 132 | (b/step (fn [state event] 133 | (cond (not event) 134 | [1 {:wait-on all-moves}] 135 | 136 | ;; board is full 137 | (= 9 state) 138 | [(inc state) {:request #{{:type :draw 139 | :terminal true}}}] 140 | :else 141 | [(inc state) {:wait-on all-moves}]))))) 142 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/test/tech/thomascothran/pavlov/viz/cytoscape_test.clj: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.viz.cytoscape-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [tech.thomascothran.pavlov.graph :as graph] 4 | [tech.thomascothran.pavlov.bthread :as b] 5 | [tech.thomascothran.pavlov.viz.cytoscape :as cytoscape])) 6 | 7 | (defn make-bthreads-linear 8 | [] 9 | {:single (b/bids [{:request #{:step/a}} 10 | {:request #{:step/b}}])}) 11 | 12 | (deftest graph-helper-builds-cytoscape-structure 13 | (testing "helper converts graph nodes and edges into cytoscape data" 14 | (let [graph {:nodes {[] {:path [] 15 | :identifier :root 16 | :event nil 17 | :wrapped {:path [] 18 | :saved-bthread-states {:single :s0} 19 | :bprogram/state {:last-event nil 20 | :next-event nil 21 | :requests {} 22 | :waits {} 23 | :blocks {} 24 | :bthread->bid {:single nil} 25 | :bthreads-by-priority #{:single}}}} 26 | [:a] {:path [:a] 27 | :identifier :foo 28 | :event :a 29 | :wrapped {:path [:a] 30 | :saved-bthread-states {:single :s1} 31 | :bprogram/state {:last-event :a 32 | :next-event :done 33 | :requests {:foo #{:single}} 34 | :waits {:foo #{:single}} 35 | :blocks {:foo #{:single}} 36 | :bthread->bid {:single {:request #{:foo}}} 37 | :bthreads-by-priority #{:single}}}}} 38 | :edges [{:from [] 39 | :to [:a] 40 | :event :a}]} 41 | result (cytoscape/-graph->cytoscape graph)] 42 | (is (= {:nodes [{:data {:id "[]" 43 | :label "initialize" 44 | :path [] 45 | :identifier :root 46 | :event nil 47 | :meta {:path [] 48 | :identifier :root 49 | :event nil 50 | :saved-bthread-states {:single :s0} 51 | :bprogram/state {:last-event nil 52 | :next-event nil 53 | :requests {} 54 | :waits {} 55 | :blocks {} 56 | :bthread->bid {:single nil} 57 | :bthreads-by-priority #{:single}}}}} 58 | {:data {:id "[:a]" 59 | :label ":a" 60 | :path [:a] 61 | :identifier :foo 62 | :event :a 63 | :meta {:path [:a] 64 | :identifier :foo 65 | :event :a 66 | :saved-bthread-states {:single :s1} 67 | :bprogram/state {:last-event :a 68 | :next-event :done 69 | :requests {:foo #{:single}} 70 | :waits {:foo #{:single}} 71 | :blocks {:foo #{:single}} 72 | :bthread->bid {:single {:request #{:foo}}} 73 | :bthreads-by-priority #{:single}}}}}] 74 | :edges [{:data {:id "[]->[:a]" 75 | :source "[]" 76 | :target "[:a]" 77 | :event :a 78 | :from [] 79 | :to [:a]}}]} 80 | result))))) 81 | 82 | (deftest graph->cytoscape-builds-from-bthreads 83 | (testing "graph->cytoscape integrates graph generation and conversion" 84 | (let [expected-bthreads (make-bthreads-linear) 85 | result-bthreads (make-bthreads-linear) 86 | expected (cytoscape/-graph->cytoscape (graph/->graph expected-bthreads)) 87 | result (cytoscape/graph->cytoscape result-bthreads)] 88 | (is (= expected result))))) 89 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/nav.cljc: -------------------------------------------------------------------------------- 1 | (ns ^:alpha tech.thomascothran.pavlov.nav 2 | "Tools to navigate bthread programs. 3 | 4 | Convert a group of bthreads to a navigable program with `root`. 5 | Then use `to` and `follow` to navigate around the branching 6 | execution paths." 7 | (:refer-clojure :exclude [ancestors]) 8 | (:require [clojure.core.protocols :as p] 9 | [clojure.datafy :refer [nav]] 10 | [tech.thomascothran.pavlov.event :as e] 11 | [tech.thomascothran.pavlov.search :as search])) 12 | 13 | (defn- node->data 14 | [nav wrapped chosen ancestors tf] 15 | (let [succs (search/succ nav wrapped) 16 | make-child (fn [state event] 17 | {:nav nav :wrapped state :chosen event 18 | :ancestors (conj ancestors {:nav nav :wrapped wrapped 19 | :chosen chosen :ancestors ancestors})}) 20 | branches (-> (mapv (fn [{:keys [state event]}] 21 | {:pavlov/event event 22 | :pavlov/path (:path state) 23 | ::child (make-child state event)}) 24 | succs) 25 | (with-meta 26 | {`p/nav 27 | (fn [_coll _k v] 28 | (if-let [{:keys [nav wrapped chosen ancestors]} (::child v)] 29 | (node->data nav wrapped chosen ancestors tf) 30 | v))})) 31 | crumbs (-> (mapv (fn [{:keys [wrapped chosen] :as n}] 32 | {:pavlov/event chosen 33 | :pavlov/path (:path wrapped) 34 | ::child n}) 35 | ancestors) 36 | (vec) 37 | (with-meta 38 | {`p/nav 39 | (fn [_coll _k v] 40 | (let [{:keys [nav wrapped chosen ancestors]} (::child v)] 41 | (node->data nav wrapped chosen ancestors tf)))}))] 42 | (tf 43 | {:pavlov/event chosen 44 | :pavlov/path (:path wrapped) 45 | :pavlov/branches branches 46 | :pavlov/crumbs crumbs 47 | :pavlov/bthreads 48 | {:pavlov/bthread-states (:saved-bthread-states wrapped) 49 | :pavlov/bthread->bid (get-in wrapped [:bprogram/state 50 | :bthread->bid]) 51 | :pavlov/bthreads-by-priority 52 | (get-in wrapped [:bprogram/state 53 | :bthreads-by-priority])}}))) 54 | 55 | (defn root 56 | "Given a navigator from `search` return a navigable data structure." 57 | ([bthreads] (root bthreads identity)) 58 | ([bthreads tf] 59 | (let [nav (search/make-navigator bthreads)] 60 | (node->data nav (search/root nav) nil [] tf)))) 61 | 62 | (defn to 63 | "Given a navigable, navigate to the path that matches the given 64 | `event-selector`. 65 | 66 | If the `event-selector` is a function, it will be used as 67 | a predicate to find which branch to take. 68 | 69 | Otherwise, the `event-selector` is an event type. In this case 70 | there may be more than one branch with the same event type. 71 | In that case, the first one is returned." 72 | [navigable event-selector] 73 | (let [branches (:pavlov/branches navigable) 74 | select-branch-fn (if (fn? event-selector) 75 | event-selector 76 | (comp (partial = event-selector) 77 | e/type)) 78 | branch 79 | (first (filter (comp select-branch-fn 80 | #(get % :pavlov/event)) 81 | branches))] 82 | (when branch 83 | (nav branches nil branch)))) 84 | 85 | (defn follow 86 | "Given a navigable, follow the path of event selectors. 87 | 88 | Event selectors only need to be specified where there are branches. 89 | 90 | If a there is only one branch to follow, it is followed automatically, 91 | even if it is not in the selectors list. 92 | 93 | If there are multiple options at a branch point, but none of them 94 | are in the event-types list, then nil is returned. 95 | 96 | Params 97 | ------ 98 | `navigable`: the product of calling `root` on a group of bthreads 99 | `event-selectors`: a sequence of either: 100 | - event types, or 101 | - predicate functions that return a truthy given an event if that 102 | branch ought to be followed" 103 | [navigable event-selectors] 104 | (loop [nav-position navigable 105 | remaining-event-types event-selectors] 106 | (let [event-type (first remaining-event-types) 107 | 108 | next-event-type 109 | (or (and (= 1 (count (:pavlov/branches nav-position))) 110 | (-> nav-position :pavlov/branches first 111 | :pavlov/event e/type)) 112 | event-type) 113 | 114 | next-position (to nav-position next-event-type)] 115 | 116 | (if (and nav-position (seq remaining-event-types)) 117 | (recur 118 | next-position 119 | (if (= next-event-type event-type) 120 | (rest remaining-event-types) 121 | remaining-event-types)) 122 | nav-position)))) 123 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/src/tech/thomascothran/pavlov/search.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.search 2 | (:refer-clojure :exclude [ancestors]) 3 | (:require [tech.thomascothran.pavlov.event.selection :as selection] 4 | [tech.thomascothran.pavlov.bthread :as b] 5 | [tech.thomascothran.pavlov.bprogram.state :as state]) 6 | #?(:clj (:import [clojure.lang PersistentQueue]))) 7 | 8 | ;; helper functions 9 | 10 | (defn- save-bthread-states 11 | "Save the current state of all bthreads." 12 | [bp-state] 13 | (let [name->bthread (:name->bthread bp-state)] 14 | (into {} 15 | (map (fn [[name bthread]] 16 | (let [bt-state (b/state bthread)] 17 | [name bt-state]))) 18 | name->bthread))) 19 | 20 | (defn- restore-bthread-states 21 | "Restore bthread states from a saved snapshot." 22 | [bp-state saved-states] 23 | (let [name->bthread (:name->bthread bp-state)] 24 | (doseq [[name bthread] name->bthread] 25 | (when-let [saved-state (get saved-states name)] 26 | (b/set-state bthread saved-state))) 27 | bp-state)) 28 | 29 | (defprotocol StateNavigator 30 | (root [_] "Returns an initial value") 31 | (succ [_ state] "returns (seq {:state s' :event e})") 32 | (identifier [_ state] "hash/keyword for caching")) 33 | 34 | (defn bfs-seq [nav] 35 | (letfn [(step [frontier seen] 36 | (lazy-seq 37 | (when-let [s (peek frontier)] 38 | (let [frontier' (pop frontier) 39 | sid (identifier nav s)] 40 | (if (contains? seen sid) 41 | (step frontier' seen) 42 | (cons s 43 | (step (into frontier' (map :state (succ nav s))) 44 | (conj seen sid))))))))] 45 | (step (conj #?(:clj PersistentQueue/EMPTY 46 | :cljs cljs.core/PersistentQueue.EMPTY) 47 | (root nav)) #{}))) 48 | 49 | (defn bfs-reduce 50 | "Breadth-first traversal of NAV. 51 | f – (fn [acc state]) ;; combine into an accumulator 52 | init – initial accumulator 53 | Returns the final accumulator, or a (reduced …) early-exit value." 54 | [nav f init] 55 | (loop [queue (conj #?(:clj PersistentQueue/EMPTY 56 | :cljs cljs.core/PersistentQueue.EMPTY) 57 | (root nav)) 58 | seen #{} 59 | acc init] 60 | (if (seq queue) 61 | (let [s (peek queue) 62 | queue (pop queue) 63 | sid (identifier nav s)] 64 | (if (contains? seen sid) ; duplicate, skip 65 | (recur queue seen acc) 66 | (let [acc' (f acc s)] 67 | (if (reduced? acc') ; found error → stop 68 | @acc' 69 | (recur (reduce conj queue (map :state (succ nav s))) 70 | (conj seen sid) 71 | acc'))))) 72 | acc))) ; frontier empty → done 73 | 74 | (defn dfs-seq [nav] 75 | (letfn [(step [stack seen] 76 | (lazy-seq 77 | (when-let [[s & rest] (seq stack)] 78 | (let [sid (identifier nav s)] 79 | (if (contains? seen sid) 80 | (step rest seen) 81 | (cons s 82 | (step (into (mapv :state (succ nav s)) rest) 83 | (conj seen sid))))))))] 84 | (step [(root nav)] #{}))) 85 | 86 | (defn dfs-reduce 87 | "Depth-first traversal of NAV. 88 | f – (fn [acc state]) ;; combine into an accumulator 89 | init – initial accumulator 90 | Returns (f ... (f init s0) ... sN) or a reduced value if 91 | `f` calls (reduced …) (e.g. when we detect a violation)." 92 | [nav f init] 93 | (loop [stack [(root nav)] 94 | seen #{} 95 | acc init] 96 | (if (empty? stack) 97 | acc 98 | (let [s (peek stack) 99 | stack (pop stack) 100 | sid (identifier nav s)] 101 | (if (seen sid) ; already explored 102 | (recur stack seen acc) ; skip 103 | (let [acc' (f acc s)] 104 | (if (reduced? acc') ; early exit 105 | @acc' 106 | ;; push children lazily, **one at a time** 107 | (recur (reduce conj stack (map :state (succ nav s))) 108 | (conj seen sid) 109 | acc')))))))) ; finished 110 | 111 | (defn make-navigator 112 | "Create a StateNavigator for the behavioral program." 113 | [all-bthreads] 114 | ;; Initialize the state first, which advances bthreads 115 | (let [initial-state (state/init all-bthreads) 116 | ;; Save bthread states AFTER init has advanced them 117 | saved-initial-states (save-bthread-states initial-state)] 118 | (reify StateNavigator 119 | (root [_] 120 | ;; Wrap state with path tracking and saved bthread states 121 | {:bprogram/state initial-state 122 | :path [] 123 | :saved-bthread-states saved-initial-states}) 124 | 125 | (succ [_ wrapped] 126 | (let [{:keys [path saved-bthread-states] :bprogram/keys [state]} wrapped 127 | ;; Get branches from current state (not restored) 128 | bthread->bid (get state :bthread->bid) 129 | bthreads-by-priority (get state :bthreads-by-priority) 130 | branches (selection/prioritized-events bthreads-by-priority 131 | bthread->bid)] 132 | ;; Return a sequence of successor states, one for each branch 133 | (into [] 134 | (map (fn [event] 135 | ;; Restore bthread states before stepping 136 | (restore-bthread-states state saved-bthread-states) 137 | (let [next-state (state/step state event)] 138 | {:state {:bprogram/state next-state 139 | :path (conj path event) 140 | :saved-bthread-states (save-bthread-states next-state)} 141 | :event event}))) 142 | branches))) 143 | 144 | (identifier [_ wrapped] 145 | ;; Use saved states instead of live bthread states to avoid mutation issues 146 | (let [saved-states (get wrapped :saved-bthread-states) 147 | bthread->bid (get-in wrapped 148 | [:bprogram/state :bthread->bid]) 149 | last-event (get-in wrapped [:bprogram/state :last-event])] 150 | [last-event saved-states bthread->bid]))))) 151 | -------------------------------------------------------------------------------- /doc/navigating-bprograms.md: -------------------------------------------------------------------------------- 1 | # Navigating Behavioral Programs (bprograms) via `tech.thomascothran.pavlov.nav` 2 | 3 | This guide shows how to explore a Pavlov behavioral program interactively using Clojure’s `nav` concept and the helpers in `tech.thomascothran.pavlov.nav`. 4 | 5 | Key tasks covered: 6 | - Build a group of bthreads 7 | - Make that group navigable 8 | - Navigate through possible execution paths, including branches introduced by environment bthreads 9 | - Inspect crumbs (history), branches (next choices), and bthread state snapshots 10 | 11 | Important: This guide uses `nav` (from `clojure.datafy`) for navigation. `datafy` is not used. 12 | 13 | ## Concepts 14 | 15 | - Behavioral Threads (bthreads): Independent units that advance by returning bids that request, wait-on, or block events. 16 | - Environment bthreads: Bthreads that request events originating outside the system. They introduce branching by offering multiple possible next events. 17 | - Branches: Alternative next events available at a state; these determine multiple successor states. 18 | - Navigable node shape: A plain map with keys you can inspect and navigate through: 19 | - `:pavlov/event` – the event chosen at this node (may be `nil` at the root) 20 | - `:pavlov/path` – vector of events from root to this node 21 | - `:pavlov/branches` – a vector of branch maps for the next possible events 22 | - `:pavlov/crumbs` – prior nodes along the current path (for backtracking) 23 | - `:pavlov/bthreads` – snapshot of bthread state and selection data (see below) 24 | 25 | Bthread state is snapshotted and restored for each branch. Side effects outside Pavlov (HTTP calls, DB writes, etc.) are not rolled back when you move around the execution graph. 26 | 27 | ## Quick Start (REPL) 28 | 29 | Require the libs: 30 | 31 | ```clojure 32 | (require '[tech.thomascothran.pavlov.nav :as pnav] 33 | '[tech.thomascothran.pavlov.bthread :as b] 34 | '[tech.thomascothran.pavlov.event :as e]) 35 | ``` 36 | 37 | Create a small program with two bthreads: one that emits letters in order and one that emits numbers with a branch on the first step. 38 | 39 | ```clojure 40 | (defn make-test-bthreads 41 | [] 42 | {:letters (b/bids [{:request [:a]} 43 | {:request [:b]} 44 | {:request [:c]}]) 45 | :numbers (b/bids [{:request #{1 2}} ; unordered → branch 46 | {:request #{3}}])}) 47 | ``` 48 | 49 | Turn the bthreads into a navigable root: 50 | 51 | ```clojure 52 | (def root (pnav/root (make-test-bthreads))) 53 | ``` 54 | 55 | Inspect the available next steps (branch event-types): 56 | 57 | ```clojure 58 | (->> (:pavlov/branches root) 59 | (mapv (comp e/type :pavlov/event))) 60 | ;=> [1 2 :a] 61 | ``` 62 | 63 | Navigate to the first number branch: 64 | 65 | ```clojure 66 | (def at-1 (pnav/to root 1)) 67 | (-> at-1 :pavlov/event e/type) 68 | ;=> 1 69 | ``` 70 | 71 | See what comes next from here (the next branches): 72 | 73 | ```clojure 74 | (->> (:pavlov/branches at-1) 75 | (mapv (comp e/type :pavlov/event))) 76 | ;=> [3 :a] 77 | ``` 78 | 79 | Follow a whole path by specifying the branch event-types at decision points. `follow` automatically advances through linear sections where there’s only one possible next event. 80 | 81 | ```clojure 82 | (-> (pnav/follow root [1]) :pavlov/event e/type) 83 | ;=> 1 84 | 85 | (-> (pnav/follow root [1 3]) :pavlov/event e/type) 86 | ;=> 3 87 | 88 | (-> (pnav/follow (pnav/root {:linear (b/bids [{:request [:a]} 89 | {:request [:b]} 90 | {:request [:c]}])}) 91 | [:a :c]) 92 | :pavlov/event e/type) 93 | ;=> :c 94 | 95 | (-> (pnav/follow (pnav/root {:linear (b/bids [{:request [:a]} 96 | {:request [:b]} 97 | {:request [:c]}])}) 98 | [:a :d]) 99 | :pavlov/event) 100 | ;=> nil ; no matching branch at that decision point 101 | ``` 102 | 103 | ## Reading Crumbs, Branches, Path, and Bthread State 104 | 105 | - Crumbs are your backtrack history; the first crumb has a `nil` event (the root): 106 | 107 | ```clojure 108 | (let [n1 (pnav/to root 1) 109 | n3 (pnav/to n1 3)] 110 | [(mapv (comp e/type :pavlov/event) (:pavlov/crumbs n3)) 111 | (mapv (comp e/type :pavlov/event) (:pavlov/branches n3)) 112 | (:pavlov/path n3)]) 113 | ;=> [[nil 1] [:a] [1 3]] 114 | ``` 115 | 116 | - Bthread snapshot data available at each node: 117 | 118 | ```clojure 119 | (keys (:pavlov/bthreads root)) 120 | ;=> (:pavlov/bthread-states :pavlov/bthread->bid :pavlov/bthreads-by-priority) 121 | 122 | (keys (get-in root [:pavlov/bthreads :pavlov/bthread-states])) 123 | ;=> (:letters :numbers) 124 | ``` 125 | 126 | The snapshot keeps per-bthread state stable per node as you navigate. External side effects are not part of this snapshot and won’t be reset when moving around. 127 | 128 | ## Branching with Environment Bthreads 129 | 130 | Environment bthreads express possible inputs from outside the system and are the main way to introduce branches intentionally during exploration. 131 | 132 | Branching patterns: 133 | - Within a single bthread’s bid, use an unordered `set` of requested events to signal equal-priority alternatives for that bthread. 134 | 135 | Example environment bthreads: 136 | 137 | ```clojure 138 | (defn make-env-bthreads 139 | [] 140 | {:submit (b/bids [{:request #{{:type :application-submitted}}}]) 141 | :pay-deposit (b/bids [{:request #{{:type :initial-deposit-paid}}}])}) 142 | ``` 143 | 144 | Combine domain bthreads with environment bthreads in a single map (unordered keys imply equal priority among bthreads). The selection engine will: 145 | - Collect unblocked bids from all unblocked bthreads (since the collection is unordered) 146 | - For each selected bid, if the `:request` is a set, include each requested event as an alternative branch 147 | 148 | Then explore with `pnav/root`, listing `:pavlov/branches` and stepping with `pnav/to` or `pnav/follow` as above. 149 | 150 | Tip: If you want a single bthread to offer multiple alternatives at once, use a set in its `:request`. If you need multiple sources of alternatives (e.g., two independent environment influences), use a map for your bthreads so both bthreads are considered at a step. 151 | 152 | ## Practical Workflow for LLMs (clojure-mcp) 153 | 154 | - Discover and require: 155 | - `tech.thomascothran.pavlov.nav` (entry points: `root`, `to`, `follow`) 156 | - `tech.thomascothran.pavlov.bthread` (helpers: `bids`, `on`, `thread`, etc.) 157 | - `tech.thomascothran.pavlov.event` (use `e/type` to read event types) 158 | - Construct bthreads from examples or tests 159 | - Build a navigable with `pnav/root` 160 | - Inspect `:pavlov/branches` to see alternatives at any node 161 | - Use `pnav/to` to pick a branch by event-type 162 | - Use `pnav/follow` to automate through linear stretches, only specifying event-types at branch points 163 | - Inspect `:pavlov/crumbs`, `:pavlov/path`, and `:pavlov/bthreads` to reason about history and state 164 | 165 | ## Troubleshooting 166 | 167 | - No branch found: `pnav/to` returns `nil` when there is no branch with the given event-type at the current node (or `pnav/follow` returns a node with `:pavlov/event` `nil` at the end). 168 | - Unexpected single-path advancement: `pnav/follow` auto-advances when exactly one branch exists (even if the event is not in the list provided); you only need to provide event-types when there are multiple options. 169 | - Side effects: Navigation keeps bthread state consistent per node but does not undo external side effects. 170 | - Priority and ordering: Ordered collections favor a single highest-priority bthread and event; unordered collections (sets, maps) allow multiple alternatives and are useful for branching during exploration. 171 | 172 | ## References in Code 173 | 174 | - Event selection and branching: `tech.thomascothran.pavlov.event.selection` 175 | - Navigator construction and state snapshotting: `tech.thomascothran.pavlov.search` 176 | - Navigation helpers: `tech.thomascothran.pavlov.nav` 177 | - Bthread construction: `tech.thomascothran.pavlov.bthread` 178 | - Examples and expectations: `test/tech/thomascothran/pavlov/nav_test.clj` 179 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bprogram/ephemeral.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.ephemeral 2 | (:refer-clojure :exclude [run!]) 3 | (:require [tech.thomascothran.pavlov.bprogram.proto :as bprogram] 4 | [tech.thomascothran.pavlov.event :as event] 5 | [tech.thomascothran.pavlov.event.publisher.defaults :as pub-default] 6 | [tech.thomascothran.pavlov.event.publisher.proto :as pub] 7 | [tech.thomascothran.pavlov.bthread :as b] 8 | [tech.thomascothran.pavlov.bprogram.state 9 | :as state]) 10 | #?(:clj (:import (java.util.concurrent LinkedBlockingQueue) 11 | (java.util.concurrent Executors TimeUnit)))) 12 | 13 | ;; move this elsewhere 14 | #?(:clj (extend-protocol bprogram/BProgramQueue 15 | LinkedBlockingQueue 16 | (conj [this event] 17 | (.put this event)) 18 | (pop [this] (.take this)))) 19 | 20 | #?(:cljs 21 | (defn deliver 22 | [m v] 23 | ((get m :resolve) v))) 24 | 25 | (defn- set-stopped! 26 | [program-opts terminal-event] 27 | (deliver (get program-opts :stopped) 28 | terminal-event)) 29 | 30 | (defn- set-killed! 31 | [program-opts] 32 | (deliver (get program-opts :killed) true)) 33 | 34 | #?(:cljs 35 | (defn- deferred-promise 36 | [] 37 | (let [resolve (volatile! nil) 38 | reject (volatile! nil)] 39 | {:promise 40 | (js/Promise. (fn [resolve' reject'] 41 | (vreset! resolve resolve') 42 | (vreset! reject reject'))) 43 | :resolve @resolve 44 | :reject @reject}))) 45 | 46 | (defn- handle-event! 47 | [bprogram program-opts event] 48 | (loop [event' event 49 | subscriber-requested-events' []] 50 | (let [!state (get program-opts :!state) 51 | publisher (get program-opts :publisher) 52 | state @!state 53 | next-state (reset! !state (state/step state event')) 54 | next-event (get next-state :next-event) 55 | terminate? (event/terminal? event') 56 | recur? (and next-event (not terminate?)) 57 | 58 | notification-result 59 | (pub/notify! publisher event' bprogram) 60 | 61 | subscriber-requested-events 62 | (when event 63 | (into [] 64 | (comp (map :event) 65 | (filter identity)) 66 | notification-result))] 67 | 68 | (cond recur? 69 | (recur next-event (into subscriber-requested-events 70 | subscriber-requested-events')) 71 | 72 | terminate? 73 | (set-stopped! program-opts event') 74 | 75 | :else 76 | (doseq [requested-event subscriber-requested-events'] 77 | (bprogram/submit-event! bprogram requested-event)))))) 78 | 79 | #?(:clj 80 | (defn- submit-event! 81 | [_ opts event] 82 | (let [in-queue (get opts :in-queue)] 83 | (bprogram/conj in-queue event))) 84 | 85 | :cljs 86 | (defn- submit-event! 87 | [bprogram opts event] 88 | (js/setTimeout #(handle-event! bprogram opts event) 0))) 89 | 90 | #?(:clj (defn- run-event-loop! 91 | [bprogram program-opts] 92 | (let [killed (get program-opts :killed) 93 | in-queue (get program-opts :in-queue)] 94 | (loop [next-event' (some-> program-opts 95 | (get :!state) 96 | deref 97 | (get :next-event))] 98 | (when-not (realized? killed) 99 | (when next-event' 100 | (handle-event! bprogram program-opts next-event')) 101 | (when-not (event/terminal? next-event') 102 | (recur (bprogram/pop in-queue)))))))) 103 | 104 | (defn kill! 105 | [program-opts] 106 | (set-killed! program-opts) 107 | (set-stopped! program-opts {:type :pavlov/kill 108 | :terminal true}) 109 | #?(:clj (get program-opts :killed) 110 | :cljs (get-in program-opts [:killed :promise]))) 111 | 112 | (defn- subscribe! 113 | [program k subscriber] 114 | (let [publisher (get program :publisher)] 115 | (pub/subscribe! publisher k subscriber))) 116 | 117 | (defn- stop! 118 | [bprogram program-opts] 119 | (submit-event! bprogram 120 | program-opts 121 | {:type :pavlov/terminate 122 | :terminal true}) 123 | #?(:clj (get program-opts :stopped) 124 | :cljs (get-in program-opts [:stopped :promise]))) 125 | 126 | (defn make-program! 127 | "Create a behavioral program comprising bthreads. 128 | 129 | Usage 130 | ------ 131 | ```clojure 132 | (make-program! {:bthread1 bthread1 133 | :bthread2 bthread2}...) 134 | ``` 135 | 136 | But note that bthread priority is random. 137 | 138 | ```clojure 139 | (make-program! [[:bthread1 bthread1] 140 | [:bthread2 bthread2]...]) 141 | ``` 142 | 143 | 144 | To control bthread priority: 145 | 146 | `opts` is a map of options for the behavioral program. 147 | Bthreads are supplied as individual arguments after opts. 148 | Their priority is determined by the order in which they are supplied. 149 | Earlier bthreads have higher priority. 150 | 151 | Returns the behavioral program." 152 | ([named-bthreads] (make-program! named-bthreads nil)) 153 | ([named-bthreads opts] 154 | (let [initial-state (state/init named-bthreads) 155 | !state (atom initial-state) 156 | in-queue (get opts :in-queue #?(:clj (LinkedBlockingQueue.))) 157 | subscribers (get opts :subscribers {}) 158 | publisher (get opts :publisher 159 | (pub-default/make-publisher! {:subscribers subscribers})) 160 | 161 | stopped #?(:clj (promise) 162 | :cljs (deferred-promise)) 163 | 164 | program-opts 165 | {:!state !state 166 | :in-queue in-queue 167 | :stopped stopped 168 | :killed #?(:clj (promise) 169 | :cljs (deferred-promise)) 170 | :publisher publisher} 171 | 172 | bprogram (reify 173 | bprogram/BProgram 174 | (stop! [this] (stop! this program-opts)) 175 | (kill! [_] (kill! program-opts)) 176 | (stopped [_] stopped) 177 | (subscribe! [_ k f] 178 | (pub/subscribe! publisher k f)) 179 | (submit-event! [this event] 180 | (submit-event! this program-opts event)) 181 | 182 | bprogram/BProgramIntrospectable 183 | (bthread->bids [_] 184 | (get @!state :bthread->bid)))] 185 | 186 | #?(:clj (future (run-event-loop! bprogram program-opts)) 187 | :cljs (when-let [next-event (get initial-state :next-event)] 188 | (submit-event! bprogram program-opts next-event))) 189 | bprogram))) 190 | 191 | (defn execute! 192 | "Execute a behavioral program. 193 | 194 | Usage 195 | ------ 196 | ```clojure 197 | (make-program! {:bthread1 bthread1 198 | :bthread2 bthread2}...) 199 | ``` 200 | 201 | But note that bthread priority is random when bthreads are defined 202 | with a map. 203 | 204 | ```clojure 205 | (make-program! [[:bthread1 bthread1] 206 | [:bthread2 bthread2]...]) 207 | ``` 208 | 209 | Returns a promise delivered with the value of the 210 | terminal event. 211 | 212 | Options 213 | ------- 214 | - `:request-event`: request an event. This is used to kick off the 215 | bprogram 216 | " 217 | ([bthreads] 218 | (execute! bthreads nil)) 219 | ([bthreads opts] 220 | (let [requested-event (get opts :request-event) 221 | 222 | requested-event-bthread 223 | (when requested-event 224 | (b/bids [{:request #{requested-event}}])) 225 | 226 | kill-after (get opts :kill-after) 227 | 228 | bthreads' 229 | (cond-> (into [] bthreads) 230 | requested-event-bthread 231 | (conj [::requested-event requested-event-bthread]) 232 | 233 | :then 234 | (conj [::deadlock {:request #{{:type ::deadlock 235 | :terminal true}}}])) 236 | 237 | bprogram (make-program! bthreads' opts)] 238 | (when kill-after 239 | (let [killfn (fn [] (bprogram/kill! bprogram))] 240 | #?(:clj (-> (Executors/newSingleThreadScheduledExecutor) 241 | (.schedule ^Runnable killfn 242 | kill-after 243 | TimeUnit/MILLISECONDS)) 244 | :cljs (js/setTimeout killfn kill-after)))) 245 | (bprogram/stopped bprogram)))) 246 | -------------------------------------------------------------------------------- /context/model_check_state_restore.md: -------------------------------------------------------------------------------- 1 | # Model Checker State Capture and Restoration Plan 2 | 3 | ## Background 4 | 5 | Pavlov is a behavioral programming library that implements the paradigm described in the paper "Behavioral Programming" (Harel et al.). The library enables event-driven programming through behavior threads (bthreads) that coordinate through a behavior program (bprogram). 6 | 7 | Currently, the model checker implementation in `tech.thomascothran.pavlov.check` uses a brute-force approach that re-executes the entire program for each path exploration. This is inefficient and doesn't scale well for complex programs with many possible execution paths. 8 | 9 | A proper model checker needs to: 10 | 1. Explore different execution paths systematically 11 | 2. Detect cycles to avoid infinite exploration 12 | 3. Backtrack to previous states efficiently 13 | 4. Check safety and liveness properties 14 | 15 | The key challenge is implementing efficient state capture and restoration to enable backtracking without re-execution. 16 | 17 | ## Problem Statement 18 | 19 | ### Core Challenge 20 | To implement an efficient model checker, we need to capture the complete state of a behavioral program at any point and restore it later. This requires: 21 | 22 | 1. **BThread State**: Each bthread maintains internal state through volatile references 23 | 2. **BProgram State**: The coordination state includes: 24 | - Current bids from each bthread 25 | - Event queues (requests, waits, blocks) 26 | - Priority ordering 27 | - Last processed event 28 | 29 | ### Technical Challenges 30 | 31 | 1. **Stateful BThreads**: BThreads use volatile references for state management, making direct serialization complex 32 | 2. **Object References**: The bprogram state contains direct object references to bthreads in its event maps 33 | 3. **Side Effects**: Getting a bid from a bthread may advance its internal state 34 | 4. **Different BThread Types**: Various bthread implementations (step, bids, etc.) have different serialization formats 35 | 5. **Deterministic Recreation**: Need to ensure bthreads can be recreated identically 36 | 37 | ### Current Implementation Issues 38 | 39 | 1. **Serialization Bug**: The `bids` bthread implementation incorrectly serializes the original sequence instead of the current position 40 | 2. **State Initialization**: The `state/init` function calls `bid` with `nil` event, causing unwanted state advancement 41 | 3. **No Checkpoint/Restore**: No existing mechanism for state capture and restoration 42 | 43 | ## Relevant Files 44 | 45 | ### Core Protocol Definitions 46 | - `src/tech/thomascothran/pavlov/bthread/proto.cljc`: BThread protocol with serialize/deserialize methods 47 | - `src/tech/thomascothran/pavlov/bprogram/proto.cljc`: BProgram protocol 48 | 49 | ### BThread Implementations 50 | - `src/tech/thomascothran/pavlov/bthread.cljc`: Core bthread functions (step, bids, etc.) 51 | - `src/tech/thomascothran/pavlov/bthread/defaults.cljc`: Default protocol implementations 52 | 53 | ### State Management 54 | - `src/tech/thomascothran/pavlov/bprogram/ephemeral/state.cljc`: BProgram state management 55 | - `src/tech/thomascothran/pavlov/event/selection.clj`: Event selection logic 56 | 57 | ### Model Checker 58 | - `src/tech/thomascothran/pavlov/check.clj`: Current model checker implementation 59 | 60 | ## Discovered Insights 61 | 62 | ### 1. BThread Serialization 63 | - The `serialize` method returns internal state data 64 | - The `deserialize` method mutates an existing bthread instance (doesn't create new ones) 65 | - Step bthreads correctly serialize their state value 66 | - Bids bthreads have a bug: they serialize the original sequence, not current position 67 | 68 | ### 2. BProgram State Structure 69 | ```clojure 70 | {:bthread->bid ; Map of bthread-name to current bid 71 | :bthreads-by-priority ; Ordered list of bthread names 72 | :last-event ; Last processed event 73 | :next-event ; Next selected event 74 | :requests ; Map of event-type to set of bthreads 75 | :waits ; Map of event-type to set of bthreads 76 | :blocks ; Map of event-type to set of bthreads} 77 | ``` 78 | 79 | ### 3. Key Insight 80 | The bprogram state already stores the current bids in `:bthread->bid`. We don't need to regenerate bids during restoration, avoiding potential non-determinism. 81 | 82 | ## Proposed Solution 83 | 84 | ### Overview 85 | Use the existing `make-bthreads` function as a factory for creating fresh bthread instances, then restore their internal state and use the saved bids to reconstruct the bprogram state. 86 | 87 | ### State Capture Process 88 | 89 | ```clojure 90 | (defn capture-model-checker-state 91 | [bprogram-state bthreads] 92 | {:bthread-states (into {} (map (fn [bt] 93 | [(b/name bt) (b/serialize bt)]) 94 | bthreads)) 95 | :bthread->bid (:bthread->bid bprogram-state) ; Current bids! 96 | :last-event (:last-event bprogram-state) 97 | :bthreads-by-priority (:bthreads-by-priority bprogram-state)}) 98 | ``` 99 | 100 | 1. Serialize each bthread's internal state 101 | 2. Save the current bid mapping (avoiding regeneration) 102 | 3. Save the last event and priority ordering 103 | 104 | ### State Restoration Process 105 | 106 | ```clojure 107 | (defn restore-model-checker-state 108 | [captured-state make-bthreads] 109 | (let [; Create fresh bthreads using the factory 110 | fresh-bthreads (make-bthreads) 111 | 112 | ; Restore internal states 113 | _ (doseq [bt fresh-bthreads] 114 | (when-let [saved-state (get-in captured-state 115 | [:bthread-states (b/name bt)])] 116 | (b/deserialize bt saved-state))) 117 | 118 | ; Reconstruct bprogram state using SAVED bids 119 | ; ... build event maps from saved bids ...])) 120 | ``` 121 | 122 | 1. Call `make-bthreads` to create fresh instances 123 | 2. Deserialize saved state into each bthread 124 | 3. Use the SAVED bids (not regenerated) to rebuild event maps 125 | 4. Calculate next-event from the saved bid data 126 | 127 | ### Integration with Model Checker 128 | 129 | The model checker can use this approach to: 130 | 1. Capture state at decision points 131 | 2. Explore one path 132 | 3. Backtrack by restoring a previous state 133 | 4. Explore alternative paths 134 | 135 | ```clojure 136 | (defn explore-path [state path-so-far make-bthreads] 137 | (if (seen? state) 138 | nil ; Cycle detected 139 | (let [checkpoint (capture-model-checker-state state bthreads)] 140 | ; Explore each possible next event 141 | (for [event (possible-events state)] 142 | (let [next-state (step state event) 143 | ; ... check properties ...] 144 | (if violation? 145 | {:violation true :path (conj path-so-far event)} 146 | ; Restore and continue exploration 147 | (let [restored (restore-model-checker-state checkpoint make-bthreads)] 148 | (explore-path restored (conj path-so-far event) make-bthreads)))))))) 149 | ``` 150 | 151 | ## Implementation Steps 152 | 153 | ### Phase 1: Fix Prerequisites 154 | 1. **Fix bids serialization bug**: Update `serialize` to return `@xs'` instead of `xs` 155 | 2. **Add tests**: Verify serialization/deserialization for all bthread types 156 | 157 | ### Phase 2: Implement State Management 158 | 1. Create `capture-model-checker-state` function 159 | 2. Create `restore-model-checker-state` function 160 | 3. Add helper functions for normalizing/denormalizing bthread references 161 | 162 | ### Phase 3: Integrate with Model Checker 163 | 1. Modify `tech.thomascothran.pavlov.check/run` to use state capture/restore 164 | 2. Implement cycle detection using state hashing 165 | 3. Add backtracking logic for path exploration 166 | 167 | ### Phase 4: Optimize 168 | 1. Implement state compression/hashing for cycle detection 169 | 2. Add memoization for previously explored states 170 | 3. Implement parallel exploration of different paths 171 | 172 | ## Advantages of This Approach 173 | 174 | 1. **No Additional Registry**: Uses existing `make-bthreads` as factory 175 | 2. **Preserves Semantics**: Works with current bthread/bprogram abstractions 176 | 3. **Avoids Non-determinism**: Uses saved bids instead of regenerating 177 | 4. **Minimal Changes**: Integrates cleanly with existing code 178 | 179 | ## Remaining Considerations 180 | 181 | 1. **Dynamic BThreads**: Handle bthreads created during execution 182 | 2. **State Equality**: Define efficient state comparison for cycle detection 183 | 3. **Memory Usage**: Consider state compression for large programs 184 | 4. **Partial Order Reduction**: Future optimization to reduce state space 185 | 186 | ## Conclusion 187 | 188 | This approach provides a solid foundation for implementing an efficient model checker for Pavlov. By leveraging the existing `make-bthreads` factory pattern and the saved bid information in the bprogram state, we can implement state capture and restoration without major architectural changes. The main prerequisite is fixing the bids serialization bug, after which the implementation is straightforward. 189 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/bprogram/ephemeral_test.clj: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.ephemeral-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [tech.thomascothran.pavlov.bthread :as b] 4 | [tech.thomascothran.pavlov.defaults] 5 | [tech.thomascothran.pavlov.bprogram.ephemeral-test.bthreads :as tb] 6 | [tech.thomascothran.pavlov.bprogram.proto :as bp] 7 | [tech.thomascothran.pavlov.bprogram.ephemeral :as bpe] 8 | [tech.thomascothran.pavlov.event :as event])) 9 | 10 | (deftest subscriber-should-receive-event-after-bthread-executes 11 | (let [!stack (atom []) 12 | bthread (b/step 13 | (fn [_ event] 14 | (swap! !stack conj [:bthread event]) 15 | [nil {:wait-on #{:test-event}}])) 16 | subscriber (fn [x _] (swap! !stack conj [:subscriber x])) 17 | program (bpe/make-program! {:test-bthread bthread} 18 | {:subscribers {:test subscriber}}) 19 | _ (bp/submit-event! program :test-event) 20 | _ @(bp/stop! program)] 21 | (is (= [[:bthread nil] 22 | [:bthread :test-event] 23 | [:subscriber :test-event]] 24 | (butlast @!stack))))) 25 | 26 | (deftest good-morning-and-evening 27 | (let [bthreads 28 | {:good-morning 29 | (b/repeat 4 30 | {:request #{:good-morning}}) 31 | 32 | :good-evening 33 | (b/repeat 4 {:request #{:good-evening}}) 34 | 35 | :interlace 36 | (b/round-robin 37 | [{:wait-on #{:good-morning} 38 | :block #{:good-evening}} 39 | {:wait-on #{:good-evening} 40 | :block #{:good-morning}}])} 41 | 42 | !a (atom []) 43 | subscriber (fn [x _] (swap! !a conj x)) 44 | program 45 | (bpe/make-program! bthreads 46 | {:subscribers {:test subscriber}}) 47 | return @(bp/stop! program)] 48 | 49 | (is (= (interleave (repeat 4 :good-morning) 50 | (repeat 4 :good-evening)) 51 | (butlast @!a))) 52 | (is (= {:type :pavlov/terminate 53 | :terminal true} 54 | return)))) 55 | 56 | (deftest add-subscriber 57 | (let [bthreads {:wait-on-go 58 | (b/bids [{:wait-on #{:go}} 59 | {:request #{:some-event}}])} 60 | 61 | !a (atom []) 62 | subscriber (fn [x _] (swap! !a conj x)) 63 | program (bpe/make-program! bthreads) 64 | _ (bp/subscribe! program :test subscriber) 65 | _ (bp/submit-event! program :go) 66 | _ @(bp/stop! program)] 67 | (is (= [:go :some-event] 68 | (butlast @!a))))) 69 | 70 | ;; Note that we test our behavioral threads in isolation 71 | ;; from the bprogram. 72 | (deftest test-winning-bthreads 73 | (testing "Given a bthread that watches a crossing win pattern for player x 74 | When that crossing pattern is filled in by player x 75 | Then the bthread requests a win event" 76 | (let [bthread (tb/make-winning-bthreads 77 | #{[0 0 :x] [2 2 :x] [1 1 :x]}) 78 | bid1 (b/notify! bthread nil) ;; initialization 79 | bid2 (b/notify! bthread {:type [1 1 :x]}) 80 | bid3 (b/notify! bthread {:type [2 2 :x]}) 81 | bid4 (b/notify! bthread {:type [0 0 :x]})] 82 | 83 | (is (= #{:wait-on} 84 | (set (keys bid1)) 85 | (set (keys bid2)) 86 | (set (keys bid3))) 87 | "The first three bids should just wait") 88 | (is (= #{{:type [:x :wins] :terminal true}} 89 | (:request bid4)) 90 | "The last bid should request a win, because all the winning moves have been made")))) 91 | 92 | ;; Let's see if it can detect a win! 93 | ;; We'll ignore player moves for now. 94 | (deftest tic-tac-toe-simple-win 95 | (let [bthreads (into [] 96 | (map 97 | (fn [events] 98 | [[:winning-bthreads events] 99 | (tb/make-winning-bthreads events)])) 100 | tb/winning-event-set) 101 | events [{:type [0 0 :o]} 102 | {:type [1 1 :o]} 103 | {:type [2 2 :o]}] 104 | !a (atom []) 105 | subscriber (fn [x _] (swap! !a conj x)) 106 | program 107 | (bpe/make-program! bthreads 108 | {:subscribers {:test subscriber}}) 109 | 110 | _ (doseq [event events] 111 | (bp/submit-event! program event)) 112 | _ @(bp/stopped program) 113 | 114 | expected (conj events {:terminal true, :type [:o :wins]}) 115 | actual (take 5 @!a)] 116 | (is (= expected actual)))) 117 | 118 | (deftest test-simple-computer-picks 119 | ;; This needs names 120 | (let [winning-bthreads (for [event-set tb/winning-event-set] 121 | [[:winning-bthreads event-set] 122 | (tb/make-winning-bthreads event-set)]) 123 | 124 | no-double-placement (tb/make-no-double-placement-bthreads) 125 | 126 | other-bthreads [[:computer-o-picks (tb/make-computer-picks-bthreads :o)] 127 | [:o-top-left-corner (b/bids [{:type [0 0 :o]}])]] 128 | 129 | bthreads (reduce into [] 130 | [winning-bthreads 131 | no-double-placement 132 | other-bthreads]) 133 | 134 | !a (atom []) 135 | subscriber (fn [x _] (swap! !a conj x)) 136 | program 137 | (bpe/make-program! bthreads 138 | {:subscribers {:test subscriber}}) 139 | 140 | _ @(bp/stop! program) 141 | out-events @!a] 142 | (is (= 4 (count out-events))) 143 | (is (= #{:o} (->> out-events 144 | (take 3) 145 | (mapv (comp last event/type)) 146 | set)) 147 | "The first three events should be o moves") 148 | (is (= [:o :wins] 149 | (event/type (last out-events)))))) 150 | 151 | (deftest test-taking-turns 152 | (let [winning-bthreads (for [event-set tb/winning-event-set] 153 | [[:winning-bthreads event-set] 154 | (tb/make-winning-bthreads event-set)]) 155 | 156 | no-double-placement (tb/make-no-double-placement-bthreads) 157 | 158 | other-bthreads [[:computer-o-picks (tb/make-computer-picks-bthreads :o)] 159 | [:enforce-turns (tb/make-enforce-turn-bthreads)]] 160 | 161 | bthreads (reduce into [] 162 | [winning-bthreads 163 | no-double-placement 164 | other-bthreads]) 165 | 166 | !a (atom []) 167 | subscriber (fn [x _] (swap! !a conj x)) 168 | program (bpe/make-program! bthreads 169 | {:subscribers {:test subscriber}}) 170 | _ (bp/submit-event! program {:type [1 1 :x]}) 171 | _ @(bp/stop! program)] 172 | 173 | (is (= [{:type [1 1 :x]} {:type [0 0 :o]}] 174 | (butlast @!a))))) 175 | 176 | (deftest test-sync-call 177 | (let [bthreads 178 | {:request-a 179 | (b/bids [{:request #{:a}}]) 180 | 181 | :request-b 182 | (b/bids [{:wait-on #{:a}} 183 | {:request #{:b}}]) 184 | :request-c 185 | (b/bids [{:wait-on #{:b}} 186 | {:request #{{:type :c 187 | :terminal true}}}])} 188 | 189 | return-value @(bpe/execute! bthreads)] 190 | (is (= {:type :c 191 | :terminal true} 192 | return-value)))) 193 | 194 | ;; Test that a subscriber can return an `:event` which will be handled by the program 195 | (deftest test-subscriber-returning-event 196 | (let [bthreads 197 | {:request-a 198 | (b/bids [{:request #{:a}}]) 199 | 200 | :request-b 201 | (b/bids [{:wait-on #{:a}} 202 | {:request #{:b}}]) 203 | 204 | :block-deadlock 205 | {:block #{:tech.thomascothran.pavlov.bprogram.ephemeral/deadlock}}} 206 | 207 | !a (atom []) 208 | 209 | log-subscriber 210 | (fn [event _] 211 | (swap! !a conj event)) 212 | 213 | event-subscriber 214 | (fn [_event _] 215 | {:event {:type :c 216 | :terminal true}}) 217 | 218 | opts {:subscribers {:a event-subscriber 219 | :log-subscriber 220 | log-subscriber}} 221 | 222 | return-value @(bpe/execute! bthreads opts)] 223 | (is (= {:type :c 224 | :terminal true} 225 | return-value)))) 226 | 227 | (deftest check-terminate-on-deadlock-works 228 | (is (:terminal 229 | @(bpe/execute! {:wait-forever (b/bids [{:wait-on #{:godot}}])} 230 | {:terminate-on-deadlock true})))) 231 | 232 | (deftest check-kill-after-works 233 | (is true 234 | @(bpe/execute! {:wait-forever (b/bids [{:wait-on #{:godot}}])} 235 | {:kill-after 50}))) 236 | -------------------------------------------------------------------------------- /modules/pavlov/src/tech/thomascothran/pavlov/bthread.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bthread 2 | (:refer-clojure :exclude [repeat]) 3 | (:require [tech.thomascothran.pavlov.bthread.proto :as proto] 4 | [tech.thomascothran.pavlov.event.proto :as event-proto] 5 | [tech.thomascothran.pavlov.defaults]) 6 | #?(:cljs (:require-macros [tech.thomascothran.pavlov.bthread]))) 7 | 8 | (defn notify! 9 | [bthread event] 10 | (some-> (proto/notify! bthread event) 11 | (vary-meta assoc :pavlov/bthread bthread))) 12 | 13 | (defn state 14 | [bthread] 15 | (proto/state bthread)) 16 | 17 | (defn set-state 18 | [bthread serialized] 19 | (proto/set-state bthread serialized)) 20 | 21 | (defn bids 22 | "Make a bthread from a finite sequence of bids. 23 | 24 | The sequence *will* be fully realized. 25 | 26 | Items in the sequence may be: 27 | - bthreads (including bid maps) 28 | - functions of event to bid: (fn [event] -> bid) 29 | 30 | Functions are detected with `fn?` and called with the event. 31 | 32 | If nil is received, the bthread stops." 33 | [xs] 34 | (let [xs' (volatile! xs)] 35 | (reify proto/BThread 36 | (state [_] @xs') 37 | (set-state [_ serialized] (vreset! xs' serialized)) 38 | (label [_] @xs') 39 | (notify! [_ event] 40 | (when-let [x (first @xs')] 41 | (let [bid' (if (fn? x) 42 | (x event) 43 | (notify! x event))] 44 | (vreset! xs' (rest @xs')) 45 | bid')))))) 46 | 47 | (defn- default-label 48 | [bthread] 49 | (proto/state bthread)) 50 | 51 | (defn step 52 | "Create bthread with a step function. 53 | 54 | The `step-name` *must* be globally unique within 55 | a bprogram. If it is not globally unique you will 56 | see unpredictable behavior. 57 | 58 | A step function is: 59 | - Pure (has no side effects) 60 | - Takes (current state, event) 61 | - Returns (new state, bid) 62 | " 63 | ([f] (step f nil)) 64 | ([f opts] 65 | (let [state (volatile! nil) 66 | label-fn (get opts :label default-label)] 67 | (reify proto/BThread 68 | (state [_] @state) 69 | (set-state [_ serialized] (vreset! state serialized)) 70 | (label [this] (label-fn this)) 71 | (notify! [_ event] 72 | (try (let [result (f @state event) 73 | next-state (first result) 74 | bid (second result)] 75 | (vreset! state next-state) 76 | bid) 77 | (catch #?(:clj Throwable :cljs :default) e 78 | {:request #{{:type ::unhandled-step-fn-error 79 | :event event 80 | :error e 81 | :invariant-violated true 82 | :terminal true}}}))))))) 83 | 84 | (defn repeat 85 | ([x] (repeat nil x)) 86 | ([n x] 87 | (let [repeat-forever? (nil? n) 88 | step-fn 89 | (fn [invocations _] 90 | (let [invocations' (or invocations 1)] 91 | (if (and (not repeat-forever?) 92 | (< n invocations')) 93 | [(inc invocations') nil] 94 | [(inc invocations') x])))] 95 | (step step-fn)))) 96 | 97 | (defn on 98 | "Run `f` always and only when the specified event-type occurs. 99 | 100 | `f` is a function of an event to a bid. 101 | 102 | `f` is only invoked on an event in `event-names` - even if 103 | it returns a bid that requests or waits on other events." 104 | [event-type f] 105 | (step (fn [_prev-state event] 106 | (if-not (and event 107 | (= event-type (event-proto/type event))) 108 | [:initialized {:wait-on #{event-type}}] ;; initialize 109 | (let [bid (f event) 110 | wait-on (->> (get event :wait-on #{}) 111 | (into #{event-type}))] 112 | [:initialized (assoc bid :wait-on wait-on)]))))) 113 | 114 | (defn after-all 115 | "After *all* events occur, call `f` to return the next bid. 116 | 117 | Params 118 | ------ 119 | - `event-types` is the set of events that must be selected 120 | before `f`'s bid 121 | - `f` is a function of all the events to the bid." 122 | [event-types f] 123 | (assert (set? event-types)) 124 | (step (fn [prev-state event] 125 | (let [done (get prev-state :done) 126 | previous-events (get prev-state :previous-events []) 127 | seen-event-types (into #{} 128 | (comp (filter identity) 129 | (map event-proto/type)) 130 | (conj previous-events event)) 131 | default-bid {:wait-on event-types} 132 | new-events (if event 133 | (conj previous-events event) 134 | previous-events) 135 | new-state (assoc prev-state :previous-events new-events)] 136 | (when-not done 137 | (if (= event-types seen-event-types) 138 | [(assoc new-state :done true) (f new-events)] 139 | [new-state default-bid])))))) 140 | 141 | (defn round-robin 142 | "Ask bthreads for bids in round-robin fashion 143 | in order, until one bthread returns a bid of `nil`." 144 | [bthreads] 145 | (let [bthread-count (count bthreads) 146 | step-fn (fn [state event] 147 | (let [idx (get state :idx 0) 148 | active-bthread (nth bthreads idx) 149 | next-idx (if (= (inc idx) bthread-count) 0 (inc idx)) 150 | current-bid (notify! active-bthread event)] 151 | [{:idx next-idx 152 | :bid-states (mapv proto/state bthreads)} ;; helps w/lasso detection 153 | current-bid]))] 154 | (step step-fn))) 155 | 156 | (defn- thread* 157 | [forms] 158 | (let [binding-vector (first forms) 159 | _ (assert (= 2 (count binding-vector)) 160 | "Only two arguments, for previous state and the event") 161 | event (second binding-vector) 162 | init-key (second forms) 163 | init-case (nth forms 2) 164 | _ (assert (= init-key :pavlov/init) 165 | "Must provide :pavlov/init case") 166 | cases (->> (rest forms) 167 | (drop 2) 168 | (partition 2) 169 | (mapcat (fn [[fst snd]] 170 | [(into '() (if (keyword? fst) 171 | [fst] fst)) 172 | snd]))) 173 | default-case (when (odd? (count (rest forms))) 174 | (last (rest forms)))] 175 | `(step (fn ~binding-vector 176 | (let [event-type# (get ~event :type)] 177 | (case event-type# 178 | nil ~init-case 179 | ~@cases 180 | ~default-case)))))) 181 | 182 | #?(:clj 183 | (defmacro thread 184 | "Create a bthread. 185 | 186 | When the bthread is notified with an event you specified, 187 | the corresponding form will be evaludated. 188 | 189 | Each form most return a tuple of `next-state`, `bid`. 190 | 191 | You must first handle initialization with `:pavlov/init`. 192 | 193 | Simple example 194 | -------------- 195 | ```clojure 196 | (b/thread [prev-state event] 197 | ;; First, you *must* handle the initialization of the bthread 198 | :pavlov/init 199 | [{:event-a-count 0} ;; tuple of next state 200 | {:wait-on #{:event-a}}] ;; and bid 201 | 202 | ;; bthread will park until it is notified of `:event-a` 203 | :event-a ;; when notified of `:event-a`, return the next 204 | [(update prev-state :event-a-count inc) 205 | {:request #{{:type :event-a-handled}}}]) 206 | ``` 207 | 208 | 209 | You may also pass a next-state, bid tuple in the last position. 210 | Analogous with `case`, this will be the default when the bthread 211 | is notified of an event and that event is not explicitly handled. 212 | 213 | 214 | Example with defaults 215 | -------- 216 | ```clojure 217 | (b/thread [prev-state event] 218 | :pavlov/init ;; <- always required in this position to initialize bthread 219 | [{:initialized true} ;; <- initialized bthread state 220 | {:wait-on #{:fire-missiles}}] ;; <- bid, wait until someone 221 | ;; wants to fire missiles 222 | 223 | :fire-missiles ;; when this event in this set occurs, execute form 224 | (let [result (missiles-api/fire!)] ;; do something 225 | [prev-state ;; return previous state and bid 226 | {:request #{{:type :missiles-fired 227 | :result result}}}]) 228 | 229 | ;; if bthread notified of any other event, then return the previous 230 | ;; state and this bid. 231 | [prev-state {:wait-on #{:fire-missiles}}]) 232 | ```" 233 | {:clj-kondo/lint-as 'clojure.core/fn 234 | :style/indent [:block 1]} 235 | [& forms] 236 | (thread* forms))) 237 | 238 | (comment 239 | (macroexpand-1 240 | '(thread [prev-state event] 241 | 242 | :pavlov/init 243 | [{:initialized true} 244 | {:wait-on #{:fire-missiles}}] 245 | 246 | #{:fire-missiles} 247 | (let [result (missiles-api/fire!)] 248 | [prev-state {:request #{{:type :missiles-fired 249 | :result result}}}]) 250 | 251 | [prev-state {:wait-on #{:fire-missiles}}]))) 252 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/bthread_test.cljc: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bthread-test 2 | (:require #?(:clj [clojure.test :refer [deftest is testing]] 3 | :cljs [cljs.test :refer-macros [deftest is testing]]) 4 | [tech.thomascothran.pavlov.bthread :as b] 5 | [tech.thomascothran.pavlov.bthread.defaults])) 6 | 7 | (deftest test-serde-on-maps 8 | (let [bthread {:name :test-bthread 9 | :request #{:test-event}}] 10 | (is (= bthread 11 | (->> bthread 12 | b/state 13 | (b/set-state bthread)))))) 14 | 15 | (deftest test-serde-on-nil 16 | (is (= nil 17 | (->> nil 18 | b/state 19 | (b/set-state nil))))) 20 | 21 | (deftest test-bid-sequence 22 | (let [abc [{:name `request-a 23 | :request #{:a}} 24 | {:name `request-b 25 | :request #{:b}} 26 | {:name `request-c 27 | :request #{:c}}] 28 | bthread (b/bids abc)] 29 | (is (= (first abc) 30 | (b/notify! bthread {:type :test}))) 31 | (is (= (second abc) 32 | (b/notify! bthread {:type :test}))) 33 | (b/notify! bthread {:type :test}) 34 | (is (nil? (b/notify! bthread {:type :test}))))) 35 | 36 | (deftest test-bids-with-function 37 | (testing "bids accepts a function that receives event and returns bid" 38 | (let [bid-fn (constantly {:request #{:test-event1}}) 39 | fn-bthread (b/bids [bid-fn]) 40 | literal-bthread (b/bids [{:request #{:test-event1}}])] 41 | (is (= {:request #{:test-event1}} 42 | (b/notify! fn-bthread nil) 43 | (b/notify! literal-bthread nil)) 44 | "Initialization") 45 | (is (= nil 46 | (b/notify! fn-bthread {:type :test-event}) 47 | (b/notify! literal-bthread {:type :test-event})))))) 48 | 49 | (deftest test-bids-with-mixed-sequence 50 | (testing "bids accepts a mix of functions and literal bids" 51 | (let [fn-bthread (b/bids [(constantly {:request #{:event-a}}) 52 | {:request #{:event-b}} 53 | (constantly {:request #{:event-c}})]) 54 | literal-bthread (b/bids [{:request #{:event-a}} 55 | {:request #{:event-b}} 56 | {:request #{:event-c}}])] 57 | (is (= {:request #{:event-a}} 58 | (b/notify! fn-bthread nil) 59 | (b/notify! literal-bthread nil)) 60 | "First bid (from function)") 61 | (is (= {:request #{:event-b}} 62 | (b/notify! fn-bthread nil) 63 | (b/notify! literal-bthread nil)) 64 | "Second bid (literal)") 65 | (is (= {:request #{:event-c}} 66 | (b/notify! fn-bthread nil) 67 | (b/notify! literal-bthread nil)) 68 | "Third bid (from function)") 69 | (is (= nil 70 | (b/notify! fn-bthread nil) 71 | (b/notify! literal-bthread nil)) 72 | "Sequence exhausted")))) 73 | 74 | (deftest test-bids-function-returning-nil 75 | (testing "function returning nil behaves like nil item in sequence" 76 | (let [fn-bthread (b/bids [(fn [_event] nil)]) 77 | literal-bthread (b/bids [nil])] 78 | (is (= nil 79 | (b/notify! fn-bthread nil) 80 | (b/notify! literal-bthread nil)) 81 | "Both should return nil when first item is nil/returns nil")))) 82 | 83 | (deftest test-bids-function-receives-event 84 | (testing "function in bids receives the event argument" 85 | (let [received-events (atom []) 86 | fn-bthread (b/bids [(fn [event] 87 | (swap! received-events conj event) 88 | {:request #{:got-event}})])] 89 | (b/notify! fn-bthread nil) ;; initialization 90 | (is (= [nil] @received-events) 91 | "Function should have received the nil initialization event") 92 | 93 | ;; Reset and test with a real event 94 | (reset! received-events []) 95 | (let [fn-bthread2 (b/bids [(fn [event] 96 | (swap! received-events conj event) 97 | {:request #{:got-event}})])] 98 | (b/notify! fn-bthread2 {:type :my-event :data 123}) 99 | (is (= [{:type :my-event :data 123}] @received-events) 100 | "Function should have received the actual event"))))) 101 | 102 | (comment 103 | (test-bids-with-function)) 104 | 105 | (deftest test-repeat 106 | (let [bthread (b/repeat {:request #{:test}}) 107 | _ (doseq [_ (range 3)] 108 | (b/notify! bthread {:type :test}))] 109 | (is (= {:request #{:test}} 110 | (b/notify! bthread {:type :test})))) 111 | 112 | (let [bthread (b/repeat 3 {:request #{:test}}) 113 | _ (doseq [_ (range 3)] 114 | (b/notify! bthread {:type :test}))] 115 | (is (= nil (b/notify! bthread {:type :test}))))) 116 | 117 | (deftest test-fuse 118 | (let [bid-a {:request #{:test-a 119 | :wait-on #{:trigger}}} 120 | bid-b {:request #{:test-b 121 | :wait-on #{:trigger}}} 122 | bthread (b/round-robin 123 | [bid-a 124 | (b/bids [bid-b bid-b])]) 125 | bid1 (b/notify! bthread :trigger) 126 | bid2 (b/notify! bthread :trigger) 127 | bid3 (b/notify! bthread :trigger) 128 | bid4 (b/notify! bthread :trigger) 129 | bid5 (b/notify! bthread :trigger) 130 | bid6 (b/notify! bthread :trigger)] 131 | (is (= bid-a bid1 bid3 bid5)) 132 | (is (= bid-b bid2 bid4)) 133 | (is (nil? bid6)))) 134 | 135 | (defn count-down-step-fn 136 | [prev-state _event] 137 | (if prev-state 138 | [(dec prev-state) {:wait-on #{:test}}] 139 | [3 {:wait-on #{:test}}])) 140 | 141 | (deftest test-step-function 142 | (testing "Should retain state" 143 | (let [bthread (b/step count-down-step-fn)] 144 | (is (= {:wait-on #{:test}} 145 | (b/notify! bthread nil)) 146 | "Should return the correct bid") 147 | (is (= 3 (b/state bthread)) 148 | "Should initialize state correctly") 149 | (is (= {:wait-on #{:test}} 150 | (b/notify! bthread {:type :test})) 151 | "Should return the correct bid after initialization") 152 | (is (= 2 (b/state bthread)) 153 | "Should decrement state"))) 154 | (testing "should handle round trip serialization" 155 | (let [bthread (b/step count-down-step-fn) 156 | _ (b/notify! bthread nil) 157 | _ (b/notify! bthread {:type :test}) 158 | ser (b/state bthread) 159 | de (b/set-state bthread ser)] 160 | (is (= 2 ser de)))) 161 | (testing "should work with anonymous functions" 162 | (let [bthread (b/step #(apply count-down-step-fn %&))] 163 | (is (= {:wait-on #{:test}} 164 | (b/notify! bthread nil)) 165 | "Should return the correct bid") 166 | (is (= 3 (b/state bthread)) 167 | "Should initialize state correctly") 168 | (is (= {:wait-on #{:test}} 169 | (b/notify! bthread {:type :test})) 170 | "Should return the correct bid after initialization") 171 | (is (= 2 (b/state bthread)) 172 | "Should decrement state")))) 173 | 174 | (deftest test-step-function-error 175 | (testing "When a bthread step function throws an error 176 | Should emit a terminal event with an error 177 | And that event should be terminal" 178 | (let [divide-by-0-step-fn (fn [& _] (/ 1 0)) 179 | 180 | event {:type :some-event} 181 | 182 | bid (b/notify! (b/step divide-by-0-step-fn) 183 | event) 184 | 185 | requests (get bid :request) 186 | error-event (first requests)] 187 | (is (= 1 (count requests))) 188 | (is (get error-event :terminal)) 189 | (is (get error-event :error))))) 190 | 191 | (deftest test-on 192 | (let [!events (atom []) 193 | bthread 194 | (b/on :test-event 195 | (fn [event] 196 | (swap! !events conj event) 197 | {:request #{:test-event-received}})) 198 | init-bid (b/notify! bthread nil) ;; initialize 199 | bid (b/notify! bthread {:type :test-event}) 200 | ;; because :test-event-received was requested, the 201 | ;; bthread will be notified. However, `f` should not 202 | ;; be invoked - unless you want an endless loop 203 | _ (b/notify! bthread {:type :test-event-received})] 204 | 205 | (is (= {:wait-on #{:test-event}} init-bid)) 206 | (is (= [{:type :test-event}] @!events)) 207 | 208 | (is (= {:wait-on #{:test-event} 209 | :request #{:test-event-received}} 210 | bid)))) 211 | 212 | (deftest test-after-all 213 | (let [event-set #{:a :b :c} 214 | 215 | bthread (b/after-all event-set identity) 216 | 217 | _initialize (b/notify! bthread nil) 218 | 219 | results (mapv #(b/notify! bthread {:type %}) event-set) 220 | last-bid (b/notify! bthread {:type :d})] 221 | (is (= [{:wait-on #{:a :b :c}} 222 | {:wait-on #{:a :b :c}} 223 | [{:type :c} {:type :b} {:type :a}]] 224 | results)) 225 | (is (nil? last-bid)))) 226 | 227 | (deftest simple-thread-test 228 | (let [bthread 229 | (b/thread [prev-state _event] 230 | :pavlov/init 231 | [prev-state {:wait-on #{:event-a}}] 232 | 233 | :event-a 234 | [prev-state {:request #{{:type :event-b}}}]) 235 | bid1 (b/notify! bthread nil) 236 | bid2 (b/notify! bthread {:type :event-a})] 237 | (is (= {:wait-on #{:event-a}} bid1)) 238 | (is (= {:request #{{:type :event-b}}} bid2)))) 239 | -------------------------------------------------------------------------------- /modules/pavlov-devtools/test/tech/thomascothran/pavlov/model/check_test.clj: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.model.check-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [tech.thomascothran.pavlov.model.check :as check] 4 | [tech.thomascothran.pavlov.bthread :as b])) 5 | 6 | (deftest good-morning-evening-model-check 7 | (testing "Model checker should verify good-morning/good-evening alternation" 8 | (let [result 9 | (check/check 10 | {:check-deadlock? false 11 | :bthreads 12 | {:good-morning 13 | (b/repeat 4 {:request #{:good-morning}}) 14 | 15 | :good-evening 16 | (b/repeat 4 {:request #{:good-evening}}) 17 | 18 | :interlace 19 | (b/round-robin 20 | [{:wait-on #{:good-morning} 21 | :block #{:good-evening}} 22 | {:wait-on #{:good-evening} 23 | :block #{:good-morning}}])}})] 24 | 25 | ;; Should find no violations - the bthreads correctly alternate 26 | (is (nil? result) 27 | "Should find no violations with proper alternation")))) 28 | 29 | (deftest good-morning-evening-deadlock 30 | (testing "Model checker should detect deadlock when both are blocked" 31 | (let [result 32 | (check/check 33 | {:bthreads {:good-morning 34 | (b/bids [{:request #{:good-morning}}]) 35 | 36 | :good-evening 37 | (b/bids [{:request #{:good-evening}}]) 38 | 39 | :block-all 40 | (b/bids [{:block #{:good-morning :good-evening}}])} 41 | :check-deadlock? true})] 42 | 43 | ;; Should find a deadlock 44 | (is (some? result) 45 | "Should detect deadlock") 46 | 47 | (when result 48 | (is (= :deadlock (:type result)) 49 | "Violation type should be :deadlock"))))) 50 | 51 | (deftest simple-deadlock 52 | (let [result (check/check 53 | {:bthreads 54 | [[:test (b/bids [{:request #{{:type :a}}} 55 | {:request #{{:type :b}}}])]] 56 | :check-deadlock? true})] 57 | (is result))) 58 | 59 | (deftest deadlock-after-first-event 60 | (testing "Model checker should detect deadlock after first event" 61 | (let [result 62 | (check/check 63 | {:bthreads {:requester 64 | (b/bids [{:request #{:first-event}}]) 65 | 66 | :blocker 67 | (b/bids [{:wait-on #{:first-event}} 68 | {:block #{:second-event}}]) 69 | 70 | :second-requester 71 | (b/bids [{:wait-on #{:first-event}} 72 | {:request #{:second-event}}])} 73 | :check-deadlock? true})] 74 | 75 | ;; Should find a deadlock after :first-event 76 | (is (some? result) 77 | "Should detect deadlock after first event") 78 | 79 | (when result 80 | (is (= :deadlock (:type result)) 81 | "Violation type should be :deadlock") 82 | 83 | (is (= [:first-event] (:path result)) 84 | "Path should show :first-event happened before deadlock"))))) 85 | 86 | (deftest deadlock-not-triggered-on-terminal-event 87 | ;; Catches the case where the state of a bthread does not change 88 | ;; and the bids are the same. In order to identify a unique bprogram 89 | ;; you *also* need the event. Otherwise different bprograms in the 90 | ;; same state can be identified as dupes 91 | (let [bthreads {:request-a 92 | (b/bids [{:request [{:type :a}]}]) 93 | 94 | :request-b 95 | (b/on :a (constantly {:request #{{:type :b} 96 | {:type :c}}})) 97 | 98 | :request-c 99 | (b/on :b (constantly {:request #{{:type :d 100 | :terminal true}}}))} 101 | result (check/check {:bthreads bthreads 102 | :check-deadlock? true})] 103 | (is result))) 104 | 105 | (deftest error-thrown-in-step-fn 106 | (let [bthreads {:throw (b/step (fn [state event] 107 | (throw (ex-info "boom" {:state state 108 | :event event}))))} 109 | result (check/check {:bthreads bthreads 110 | :check-deadlock? true})] 111 | (is result))) 112 | 113 | (defn make-update-sync-bthreads 114 | [] 115 | [[:request-cms-sync-bthreads 116 | (b/bids 117 | [{:request #{{:type ::sync-thing-from-cms}}}])] 118 | 119 | [::terminate-on-not-found 120 | (b/on ::thing-not-found-in-cms 121 | (constantly {:request #{{:type ::terminate-on-not-found 122 | :terminal true}}}))] 123 | [::terminate-on-unknown-error 124 | (b/on ::unknown-error-fetching-thing-from-cms 125 | (constantly {:request #{{:type ::terminate-on-unknown-error 126 | :terminal true}}}))] 127 | 128 | [::fetch-from-cms 129 | (b/on ::sync-thing-from-cms 130 | (fn [_] 131 | {:request #{{:type ::thing-fetched-from-cms 132 | :a {:test :data}} 133 | {:type ::thing-not-found-in-cms} 134 | {:type ::unknown-error-fetching-thing-from-cms 135 | :cms-response {:status 404}}}}))] 136 | 137 | [::update-thing 138 | (b/on ::thing-fetched-from-cms 139 | (fn [_] 140 | {:request #{{:type ::update-thing}}}))]]) 141 | 142 | (deftest test-complex-identifier-bug 143 | ;; Catches another case where the state of a bthread does not change 144 | ;; and the bids are the same. In order to identify a unique bprogram 145 | ;; you *also* need the event. Otherwise different bprograms in the 146 | ;; same state can be identified as dupes 147 | (let [violation (check/check {:bthreads (make-update-sync-bthreads) 148 | :check-deadlock? true})] 149 | (is violation))) 150 | 151 | (deftest simple-invariant-violation 152 | (testing "Model checker should detect invariant violations" 153 | (let [result (check/check 154 | {:bthreads 155 | {:violator 156 | (b/bids [{:request #{{:type :violation 157 | :invariant-violated true}}}])}})] 158 | 159 | ;; Should find the violation immediately 160 | (is (some? result) 161 | "Should detect violation") 162 | 163 | (when result 164 | (is (= :safety-violation (:type result)) 165 | "Violation type should be :safety-violation") 166 | 167 | (is (= :violation (:type (:event result))) 168 | "The violating event should have type :violation"))))) 169 | 170 | (deftest branching-exploration-required-test 171 | (testing "Model checker should explore all branches when multiple events could be selected" 172 | (let [;; Create a scenario where different paths lead to different outcomes 173 | ;; If model checker explores all branches, it should find the violation 174 | result 175 | (check/check 176 | {:bthreads {:racer-a 177 | (b/bids [{:request #{:event-b :event-a}}]) 178 | 179 | ;; This bthread creates different outcomes based on order 180 | :conditional-violator 181 | (b/bids [{:wait-on #{:event-a}} 182 | ;; If event-a happens first, request a violation 183 | {:request #{{:type :violation 184 | :invariant-violated true}}}])} 185 | :check-deadlock? false})] 186 | 187 | (is result 188 | "Should find a violation (but only because it takes the :event-a path)") 189 | 190 | (when result 191 | (is (= :safety-violation (:type result))) 192 | (is (= [:event-a] (:path result)) 193 | "Path should show only :event-a was explored"))))) 194 | 195 | (deftest directly-check-branching 196 | (testing "Model checker should explore all branches when multiple events could be selected" 197 | (let [;; Create a scenario where different paths lead to different outcomes 198 | ;; If model checker explores all branches, it should find the violation 199 | !events (atom []) 200 | _result 201 | (check/check 202 | {:bthreads {:top-level-events 203 | (b/bids [{:request #{:event-b :event-a}}]) 204 | 205 | :a-mid-level-events 206 | (b/bids [{:wait-on #{:event-a}} 207 | {:request #{:event-a1}}]) 208 | 209 | :b-mid-level-events 210 | (b/bids [{:wait-on #{:event-b}} 211 | {:request #{:event-b1}}]) 212 | 213 | :a-terminate 214 | (b/bids [{:wait-on #{:event-a1}} 215 | {:request #{{:type :a-is-done 216 | :terminal true}}}]) 217 | 218 | :b1-low-level-events 219 | (b/bids [{:wait-on #{:event-b1}} 220 | {:request #{:event-b1i :event-b1ii 221 | :event-b1iii}}]) 222 | 223 | :b1i-terminal-event 224 | (b/bids [{:wait-on #{:event-b1i}} 225 | {:request #{{:type :bi1-is-done 226 | :terminal true}}}]) 227 | :b1ii-low-level-events 228 | (b/bids [{:wait-on #{:event-b1ii}} 229 | {:request #{:event-b1iiA}}]) 230 | 231 | :b1iii-low-level-events 232 | (b/bids [{:wait-on #{:event-b1iii}} 233 | {:request #{:event-b1iiiA :event-b1iiiB}}]) 234 | 235 | :watcher-bthread 236 | (b/step (fn [_prev-state event] 237 | (swap! !events conj event) 238 | [nil {:wait-on #{:event-a :event-a1 239 | :event-b :event-b1 :event-b1i 240 | :event-b1ii :event-b1iiA 241 | :event-b1iii :event-b1iiiA :event-b1iiiB}}]))} 242 | 243 | :check-deadlock? false})] 244 | (is (= #{nil :event-a :event-b :event-a1 :event-b1 :event-b1i 245 | :event-b1ii :event-b1iiA 246 | :event-b1iii :event-b1iiiA :event-b1iiiB} 247 | (into #{} @!events)))))) 248 | -------------------------------------------------------------------------------- /modules/pavlov/test/tech/thomascothran/pavlov/bprogram/ephemeral_test.cljs: -------------------------------------------------------------------------------- 1 | (ns tech.thomascothran.pavlov.bprogram.ephemeral-test 2 | (:require [clojure.test :refer [deftest is async testing]] 3 | [tech.thomascothran.pavlov.bthread :as bthread] 4 | [tech.thomascothran.pavlov.defaults] 5 | [tech.thomascothran.pavlov.bprogram.proto :as bp] 6 | [tech.thomascothran.pavlov.bprogram.ephemeral :as bpe] 7 | [tech.thomascothran.pavlov.event :as event])) 8 | 9 | (deftest good-morning-and-evening 10 | (async done 11 | (let [bthreads 12 | [[:good-morning (bthread/repeat 4 {:request #{:good-morning}})] 13 | 14 | [:good-even (bthread/repeat 4 {:request #{:good-evening}})] 15 | 16 | [:round-robin 17 | (bthread/round-robin 18 | [{:wait-on #{:good-morning} 19 | :block #{:good-evening}} 20 | {:wait-on #{:good-evening} 21 | :block #{:good-morning}}])]] 22 | !a (atom []) 23 | subscriber (fn [x _] 24 | (swap! !a conj x)) 25 | program (bpe/make-program! bthreads 26 | {:subscribers {:test subscriber}}) 27 | stop-p (bp/stop! program)] 28 | (.then stop-p 29 | (fn [& _] 30 | (is (= (interleave (repeat 4 :good-morning) 31 | (repeat 4 :good-evening)) 32 | (butlast @!a))) 33 | (done)))))) 34 | 35 | (deftest add-subscriber 36 | (async done 37 | (let [bthreads [[:bthread 38 | (bthread/bids [{:wait-on #{:go}} 39 | {:request #{:some-event}}])]] 40 | 41 | !a (atom []) 42 | subscriber (fn [x _] (swap! !a conj x)) 43 | program (bpe/make-program! bthreads) 44 | _ (bp/subscribe! program :test subscriber) 45 | _ (bp/submit-event! program :go) 46 | stopped (bp/stop! program)] 47 | (.then stopped 48 | (fn [& _] 49 | (is (= [:go :some-event] 50 | (butlast @!a))) 51 | (done)))))) 52 | 53 | (def straight-wins-paths 54 | (let [product 55 | (for [x (range 3) 56 | y (range 3)] 57 | [x y]) 58 | 59 | vertical 60 | (partition 3 product) 61 | 62 | horizontal 63 | (->> (sort-by second product) 64 | (partition 3))] 65 | (reduce into [] [vertical horizontal]))) 66 | 67 | (def crossing-win-bthreads 68 | [(map vector [0 1 2] [0 1 2]) 69 | (map vector [2 1 0] [0 1 2])]) 70 | 71 | (def winning-paths 72 | (into crossing-win-bthreads straight-wins-paths)) 73 | 74 | (def winning-event-set 75 | (for [paths winning-paths 76 | player [:x :o]] 77 | (into #{} (map #(conj % player)) paths))) 78 | 79 | (defn make-winning-bthreads 80 | "for a winning path (e.g., three diagonal squares 81 | selected by the same player), emit a win event 82 | and terminate the pogram." 83 | [path-events] 84 | (bthread/step 85 | (fn [{:keys [remaining-events] :as acc} event] 86 | (let [event-type (event/type event) 87 | remaining-events' (disj remaining-events event-type) 88 | events-to-watch 89 | (into #{} (map (fn [event] {:type event}) 90 | path-events)) 91 | default-bid {:wait-on events-to-watch}] 92 | (cond (nil? event) ;; event is nil on initialization 93 | [{:remaining-events (set path-events)} default-bid] 94 | 95 | ;; Terminate - we've won! 96 | (= remaining-events #{event-type}) 97 | [{:remaining-events remaining-events'} 98 | {:request #{{:type [(last event-type) :wins] 99 | :terminal true}}}] 100 | 101 | :else 102 | [(update acc :remaining-events disj event-type) default-bid]))))) 103 | 104 | ;; Note that we test our behavioral threads in isolation 105 | ;; from the bprogram. 106 | (deftest test-winning-bthreads 107 | (testing "Given a bthread that watches a crossing win pattern for player x 108 | When that crossing pattern is filled in by player x 109 | Then the bthread requests a win event" 110 | (let [bthread (make-winning-bthreads 111 | #{[0 0 :x] [2 2 :x] [1 1 :x]}) 112 | bid1 (bthread/notify! bthread nil) ;; initialization 113 | bid2 (bthread/notify! bthread {:type [1 1 :x]}) 114 | bid3 (bthread/notify! bthread {:type [2 2 :x]}) 115 | bid4 (bthread/notify! bthread {:type [0 0 :x]})] 116 | 117 | (is (= #{:wait-on} 118 | (set (keys bid1)) 119 | (set (keys bid2)) 120 | (set (keys bid3))) 121 | "The first three bids should just wait") 122 | (is (= #{{:type [:x :wins] :terminal true}} 123 | (:request bid4)) 124 | "The last bid should request a win, because all the winning moves have been made")))) 125 | 126 | ;; Let's see if it can detect a win! 127 | ;; We'll ignore player moves for now. 128 | (deftest tic-tac-toe-simple-win 129 | (async 130 | done 131 | (let [bthreads (mapv (fn [evts] 132 | [[::winning-evts evts] 133 | (make-winning-bthreads evts)]) 134 | winning-event-set) 135 | events [{:type [0 0 :o]} 136 | {:type [1 1 :o]} 137 | {:type [2 2 :o]}] 138 | !a (atom []) 139 | subscriber (fn [x _] (swap! !a conj x)) 140 | program (bpe/make-program! bthreads 141 | {:subscribers {:test subscriber}}) 142 | _ (doseq [event events] 143 | (bp/submit-event! program event)) 144 | stopped (bp/stop! program)] 145 | (.then stopped 146 | (fn [& _] 147 | (is (= (conj events {:terminal true, :type [:o :wins]}) 148 | (take 5 @!a))) 149 | (done)))))) 150 | 151 | ;; ;; Now we need to handle moves. 152 | ;; ;; But we need some rules. 153 | ;; ;; First, you can't pick the same square 154 | (defn make-no-double-placement-bthreads 155 | "You can't pick another player's square!" 156 | [] 157 | (for [x-coordinate [0 1 2] 158 | y-coordinate [0 1 2] 159 | player [:x :o]] 160 | [[::make-no-double-placement-bthreads {:x-coordinate x-coordinate 161 | :y-coordinate y-coordinate 162 | :player player}] 163 | (bthread/bids 164 | [{:wait-on #{[x-coordinate y-coordinate player]}} 165 | {:block #{[x-coordinate y-coordinate (if (= player :x) :o :x)]}}])])) 166 | 167 | (defn make-computer-picks-bthreads 168 | "Without worrying about strategy, let's pick a square" 169 | [player] 170 | [::computer-picks 171 | (bthread/bids 172 | (for [x-coordinate [0 1 2] 173 | y-coordinate [0 1 2]] 174 | {:request #{{:type [x-coordinate y-coordinate player]}}}))]) 175 | 176 | ;; But wait? Doesn't `make-computer-picks` need to account for 177 | ;; the squares that are already occupied? 178 | ;; 179 | ;; Nope! the no double placement bthread takes care of that for us. 180 | ;; 181 | ;; OK, but won't we have to rewrite it when we take strategy into 182 | ;; account, e.g., picking the winning square or blocking the other 183 | ;; player? 184 | ;; 185 | ;; Nope! We can add strategies incrementally and prioritize them. 186 | 187 | (deftest test-simple-computer-picks 188 | (async 189 | done 190 | (let [bthreads 191 | (reduce into 192 | [] 193 | [(mapv (fn [e] 194 | [[::winning-event e] 195 | (make-winning-bthreads e)]) 196 | winning-event-set) 197 | (make-no-double-placement-bthreads) 198 | [(make-computer-picks-bthreads :o) 199 | [:o-pick-00 (bthread/bids [{:type [0 0 :o]}])]]]) 200 | 201 | !a (atom []) 202 | subscriber (fn [x _] (swap! !a conj x)) 203 | program (bpe/make-program! bthreads 204 | {:subscribers {:test subscriber}}) 205 | 206 | stopped (bp/stop! program)] 207 | (.then stopped 208 | (fn [] 209 | (is (= 4 (count @!a))) 210 | (is (= #{:o} 211 | (->> @!a 212 | (take 3) 213 | (mapv (comp last event/type)) 214 | set)) 215 | "The first three events should be o moves") 216 | (is (= [:o :wins] 217 | (event/type (last @!a)))) 218 | (done)))))) 219 | ;; ;; Great! 220 | ;; ;; We were able to get our computer to make moves. 221 | ;; ;; But it's just going to keep picking without waiting for 222 | ;; ;; the other player! 223 | ;; ;; We need a bthread that enforces turns. 224 | 225 | (defn make-enforce-turn-bthreads 226 | [] 227 | (let [moves (for [x-coord [0 1 2] 228 | y-coord [0 1 2] 229 | player [:x :o]] 230 | [x-coord y-coord player]) 231 | 232 | x-moves 233 | (into #{} 234 | (comp (filter (comp (partial = :x) last))) 235 | moves) 236 | 237 | o-moves 238 | (into #{} 239 | (comp (filter (comp (partial = :o) last))) 240 | moves)] 241 | 242 | (bthread/bids 243 | (interleave (repeat {:wait-on x-moves 244 | :block o-moves}) 245 | (repeat {:wait-on o-moves 246 | :block x-moves}))))) 247 | 248 | ;; Notice that this rule could be generalized. 249 | ;; It could take the players and coordinates as parameters 250 | ;; and then be used for *any* turn based game. Chess, 251 | ;; checkers, poker, etc. 252 | 253 | #_(deftest test-taking-turns 254 | ;; Problem is that blocked events 255 | ;; are being represented both as a map with a :type key 256 | ;; and as the type itself. Can we support both? 257 | (async 258 | done 259 | (let [bthreads 260 | (reduce into [(make-computer-picks-bthreads :o) 261 | (make-enforce-turn-bthreads)] 262 | [(mapv make-winning-bthreads winning-event-set) 263 | (make-no-double-placement-bthreads)]) 264 | 265 | !a (atom []) 266 | subscriber (fn [x _] (swap! !a conj x)) 267 | program (bpe/make-program! bthreads 268 | {:subscribers {:test subscriber}}) 269 | _ (bp/submit-event! program {:type [1 1 :x]}) 270 | stopped (bp/stop! program)] 271 | 272 | (.then stopped 273 | (fn [& _] 274 | (is (= [{:type [1 1 :x]} {:type [0 0 :o]} 275 | (butlast @!a)])) 276 | (done)))))) 277 | -------------------------------------------------------------------------------- /doc/what-is-a-bthread.md: -------------------------------------------------------------------------------- 1 | # What is a bthread? 2 | 3 | In behavioral programming, a *behavioral thread* (bthread) is the smallest unit of behavior you compose into a behavioral program. Every bthread receives a stream of events and returns *bids* that describe how it wants the program to evolve next. 4 | 5 | Bthreads never talk to each other directly—coordination happens exclusively through the events they request, wait on, or block. 6 | 7 | Bthreads can be composed with each other freely. Different behavioral programs can use the same bthreads in different combinations to achieve different overall behavior. 8 | 9 | This document describes how to create an individual bthread and explore its behavior in isolation at the REPL or in a test -- without needing to start up a full behavioral program. 10 | 11 | ## Creating bthreads 12 | 13 | Bthreads are stateful. Therefore, you should not `def` a bthread at the top level of a namespace. Instead, define a function that returns a new instance of the bthread each time it is called. 14 | 15 | ## Lifecycle and bids 16 | 17 | A bthread is always invoked through `tech.thomascothran.pavlov.bthread/notify!`. You will never call `notify!` directly in your application code. Instead, you will create a behavioral program, and it will handle calling `notify!` on each bthread as events are dispatched. See, for example, `tech.thomascothran.pavlov.bprogram.ephemeral/execute!`. 18 | 19 | However, `notify!` is very useful at the REPL and in tests. 20 | 21 | The behavioral program will first call uses a `nil` event so the bthread can initialize its state and announce the events it cares about: events that are either requested or waited on. Afterwards the bthread is only reactivated when the behavioral program dispatches an event that matches one of the event types it waited on or requested. 22 | 23 | Each time the bthread runs it returns a *bid*, a map that can contain any combination of: 24 | 25 | - `:request` — a collection of events the bthread would like the program to select next 26 | - `:wait-on` — event types that should wake this bthread up the next time they occur 27 | - `:block` — event types that should be prevented from running while this bid is active 28 | 29 | The behavioral program collects the bids from every active bthread, filters out any events that are currently blocked, and then selects the highest-priority unblocked event. Bthreads have priority amongst themselves when they are in an ordered collection: 30 | 31 | ```clojure 32 | (def bthreads 33 | [[:bthread-a (make-bthread-a)] ;; a has priority 34 | [:bthread-b (make-bthread-b)]]) 35 | ``` 36 | 37 | Bthreads that supplied an *ordered* request collection (typically a vector or list) set an explicit priority for the events inside the bid—the earliest element wins. If bthreads are provided in an unordered collection (a set or map), their priority is non-deterministic: 38 | 39 | ```clojure 40 | (def bthreads 41 | {:bthread-a (make-bthread-a) ;; no priority, selected non-deterministically 42 | :bthread-b (make-bthread-b)}) 43 | ``` 44 | 45 | The first selected bthread with an unblocked request will result in one of its requested events being selected. If the request is unordered (a set), one of the requested events is selected non-deterministically. If the request is ordered (a vector or list), the first unblocked event in the request is selected. 46 | 47 | ```clojure 48 | (def bthread-a 49 | (b/bids [{:request #{{:type :a1} {:type :at}}}])) ;; event selected non-deterministically 50 | 51 | (def bthread-b 52 | (b/bids [{:request [{:type :b1} {:type :b2}]}])) ;; :b1 has priority over :b2 53 | ``` 54 | 55 | ## The step function is the core 56 | 57 | At the heart of Pavlov’s bthread story is the step function. This is not a feature of standard behavioral programming but a Pavlov-specific convention that enables a number of capabilities. 58 | 59 | A step function is a pure function that receives the previous state of the bthread and the event selected by the bprogram's algorithm, and returns the new state plus the next bid (the `:request`, `:wait-on`, and `:blocked`) map. 60 | 61 | `tech.thomascothran.pavlov.bthread/step` wraps such a function with the plumbing the behavioral program expects. 62 | 63 | There are convenience functions to create bthreads which have some nice advantages. If one of those other bthread functions meets your needs, prefer it to using a step function directly. 64 | 65 | ```clojure 66 | (require '[tech.thomascothran.pavlov.bthread :as b]) 67 | 68 | (def three-ticks 69 | (b/step (fn [state _event] 70 | (cond 71 | (nil? state) 72 | [0 {:wait-on #{:tick}}] 73 | 74 | (< state 2) 75 | [(inc state) {:wait-on #{:tick}}] 76 | 77 | (= state :finished) 78 | [:finished nil] 79 | 80 | :else 81 | [:finished {:request #{{:type :counter/done}}}]]))) 82 | ``` 83 | 84 | Stepping the bthread at the REPL shows the complete lifecycle: 85 | 86 | ```clojure 87 | [(b/notify! three-ticks nil) 88 | (b/notify! three-ticks {:type :tick}) 89 | (b/notify! three-ticks {:type :tick}) 90 | (b/notify! three-ticks {:type :tick}) 91 | (b/notify! three-ticks {:type :tick})] 92 | ;; => [{:wait-on #{:tick}} 93 | ;; {:wait-on #{:tick}} 94 | ;; {:wait-on #{:tick}} 95 | ;; {:request #{{:type :counter/done}}} 96 | ;; nil] 97 | ``` 98 | 99 | On initialization the bthread announces that it cares about `:tick`. After three ticks it requests a terminal `:counter/done` event and then yields `nil`, which deregisters the bthread. 100 | 101 | ## Helper constructors 102 | 103 | Writing step functions directly is flexible but verbose. Pavlov provides convenience constructors that build common bthread patterns on top of `step`. This not only reduces boilerplate but also makes your intent clearer. 104 | 105 | ### `b/bids` — finite scripted behavior 106 | 107 | Use `b/bids` when you want to replay a finite sequence of bids. The bthread walks the sequence once and removes itself when the sequence is exhausted. 108 | 109 | Items in the sequence may be: 110 | - Bid maps (or any bthread) 111 | - Functions of event to bid: `(fn [event] -> bid)` 112 | 113 | Functions are detected with `fn?` and called with the current event, allowing bids to be computed dynamically. 114 | 115 | ```clojure 116 | (def staged-requests 117 | (b/bids 118 | [{:request #{:prep/begin}} 119 | {:request #{:prep/finish}} 120 | {:request #{:ship}}])) 121 | 122 | [(b/notify! staged-requests nil) 123 | (b/notify! staged-requests {:type :prep/begin}) 124 | (b/notify! staged-requests {:type :prep/finish}) 125 | (b/notify! staged-requests {:type :ship})] 126 | ;; => [{:request #{:prep/begin}} 127 | ;; {:request #{:prep/finish}} 128 | ;; {:request #{:ship}} 129 | ;; nil] 130 | ``` 131 | 132 | You can also mix literal bids with functions that compute bids from event data: 133 | 134 | ```clojure 135 | (def order-flow 136 | (b/bids 137 | [{:wait-on #{:order/placed}} 138 | (fn [event] 139 | {:request #{{:type :order/confirm 140 | :order-id (:order-id event)}}})])) 141 | ``` 142 | 143 | ### `b/on` — react to a specific event 144 | 145 | `b/on` is ideal when you need a bthread that wakes up for exactly one event type and computes a new bid from the current event -- without keeping any state. 146 | 147 | ```clojure 148 | (def review-on-receipt 149 | (b/on :invoice/received 150 | (fn [event] 151 | {:request #{{:type :invoice/reviewed 152 | :invoice/id (:invoice/id event)}}}))) 153 | 154 | [(b/notify! review-on-receipt nil) 155 | (b/notify! review-on-receipt {:type :invoice/received :invoice/id 17}) 156 | (b/notify! review-on-receipt {:type :invoice/reviewed :invoice/id 17})] 157 | ;; => [{:wait-on #{:invoice/received}} 158 | ;; {:request #{{:type :invoice/reviewed, :invoice/id 17}}, 159 | ;; :wait-on #{:invoice/received}} 160 | ;; {:wait-on #{:invoice/received}}] 161 | ``` 162 | 163 | The handler runs only when the subscribed event arrives—even though it requests `:invoice/reviewed`, that follow-up event will not retrigger the handler. 164 | 165 | ### `b/after-all` — wait for several prerequisites 166 | 167 | `b/after-all` coordinates independent event sources. It waits until every event type in the provided set has occurred (in any order) before forwarding to the supplied function. 168 | 169 | ```clojure 170 | (def ready-when-packed 171 | (b/after-all #{:payment/authorized :packing/completed} 172 | (fn [events] 173 | (let [order-id (->> events (keep :order/id) first)] 174 | {:request #{{:type :order/ready 175 | :order/id order-id 176 | :sources (mapv :type events)}}})))) 177 | 178 | [(b/notify! ready-when-packed nil) 179 | (b/notify! ready-when-packed {:type :packing/completed :order/id 42}) 180 | (b/notify! ready-when-packed {:type :payment/authorized :order/id 42}) 181 | (b/notify! ready-when-packed {:type :extra :order/id 42})] 182 | ;; => [{:wait-on #{:packing/completed :payment/authorized}} 183 | ;; {:wait-on #{:packing/completed :payment/authorized}} 184 | ;; {:request #{{:type :order/ready, 185 | ;; :order/id 42, 186 | ;; :sources [:packing/completed :payment/authorized]}}} 187 | ;; nil] 188 | ``` 189 | 190 | Once all prerequisites are satisfied the bthread emits its completion request and then terminates. 191 | 192 | ### `b/thread` — declarative branching 193 | 194 | The `b/thread` macro lets you describe a bthread as a set of event-specific clauses, similar to writing a `case`. It is great when the bthread maintains meaningful state across several event types. 195 | 196 | ```clojure 197 | (def door-alarm 198 | (b/thread [state event] 199 | :pavlov/init 200 | [{:door :closed} 201 | {:wait-on #{:door/opened}}] 202 | 203 | :door/opened 204 | [{:door :open} 205 | {:wait-on #{:door/closed} 206 | :block #{:door/opened} 207 | :request #{{:type :alarm/check}}}] 208 | 209 | :door/closed 210 | [{:door :closed} 211 | {:wait-on #{:door/opened} 212 | :request #{{:type :alarm/reset}}}] 213 | 214 | ;; remember this! This is easy to forget. This will be called 215 | ;; when an event is received that doesn't match any other clause. 216 | [state {:wait-on #{:door/opened :door/closed}}])) 217 | 218 | [(b/notify! door-alarm nil) 219 | (b/notify! door-alarm {:type :door/opened}) 220 | (b/notify! door-alarm {:type :door/closed}) 221 | (b/notify! door-alarm {:type :door/locked})] 222 | ;; => [{:wait-on #{:door/opened}} 223 | ;; {:wait-on #{:door/closed}, 224 | ;; :block #{:door/opened}, 225 | ;; :request #{{:type :alarm/check}}} 226 | ;; {:wait-on #{:door/opened}, 227 | ;; :request #{{:type :alarm/reset}}} 228 | ;; {:wait-on #{:door/opened :door/closed}}] 229 | ``` 230 | 231 | Here the bthread blocks a second `:door/opened` event while the door is already open, requests downstream checks, and keeps listening for state changes until it terminates or the program stops. 232 | 233 | --- 234 | 235 | Bthreads give you a lightweight way to isolate behavior into independent units. Understanding how they consume events, produce bids, and leverage helper constructors makes it straightforward to model complex coordination without entangling logic or state between components. 236 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor to control, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | --------------------------------------------------------------------------------