diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7c40d68 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.clj-kondo/ +public/js/ +.shadow-cljs/ +.lsp/ diff --git a/src/cljs/emptyhead/idea/crud.cljs b/src/cljs/emptyhead/idea/crud.cljs index 374d357..c35f6e4 100644 --- a/src/cljs/emptyhead/idea/crud.cljs +++ b/src/cljs/emptyhead/idea/crud.cljs @@ -49,8 +49,8 @@ Additionally allows you to immediately attach `properties` and `data`. Returns a single idea or a list of ideas depending on whether `count` was given." [& {:keys [prefix count properties data] - :or {count 1 prefix "idea_" properties []}}] - (let [fun #(register-idea! (gensym prefix)) + :or {count 1 prefix "idea" properties []}}] + (let [fun #(register-idea! (gensym (str prefix "$"))) ideas (take count (repeatedly fun))] (run! #(apply prop/register-property! % properties) ideas) (when data (run! #(extend-idea! % data) ideas)) diff --git a/src/cljs/emptyhead/lib/io/print.cljs b/src/cljs/emptyhead/lib/io/print.cljs new file mode 100644 index 0000000..7d752bb --- /dev/null +++ b/src/cljs/emptyhead/lib/io/print.cljs @@ -0,0 +1,7 @@ +(ns emptyhead.lib.io.print + "Basic printing thoughts." + (:require [emptyhead.thought.define :as def])) + +; should this be [:emptyhead :io :print :print]? should internal and external namespaces match? +(def/define! "emptyhead.io.print" + (fn [arg] (print arg))) diff --git a/src/cljs/emptyhead/principle/crud.cljs b/src/cljs/emptyhead/principle/crud.cljs deleted file mode 100644 index 72a86f8..0000000 --- a/src/cljs/emptyhead/principle/crud.cljs +++ /dev/null @@ -1,50 +0,0 @@ -(ns emptyhead.principle.crud - "Implements CRUD operations on principles. - Since principles are ideas, 'missing' operations here are implemented in [[emptyhead.idea.crud]]." - (:require [emptyhead.idea.protocol :as prtc] - [emptyhead.idea.crud :as idea] - [emptyhead.idea.property :as prop] - [emptyhead.contract.eval :as contract] - [emptyhead.util.magic :as magic])) - -(defn make-principle - "Helper function to make principle object. - You may want `register-principle!` instead." - [operator & {:keys [data ext-contract ext-stages transient] - :or {data {} ext-contract {} - ext-stages [[:principle operator]] - transient true}}] - (hash-map :operator operator - :data data - :ext-contract ext-contract - :ext-stages ext-stages - :return {} - :transient (not (false? transient)))) - -(defn register-principle! - "Create a principle and register it in the state. - Returns a reference to the created principle." - [operator & {:keys [data ext-contract ext-stages transient] - :as args}] - (idea/have-idea! - :prefix (str "principle_" (name operator) "_") - :properties [magic/principle-ns] - :data (make-principle operator args))) - -(defn contract - "Get the extension contract of a `principle`. - Returns the contract." - [principle] - (prtc/val-fn :ext-contract principle)) - -(defn stages - "Get the extension stages of a `principle`. - Returns the list of stages." - [principle] - (prtc/val-fn :ext-stages principle)) - -(defn operator - "Get the operator id of a `principle`. - Returns the operator keyword." - [principle] - (prtc/val-fn :operator principle)) diff --git a/src/cljs/emptyhead/principle/eval.cljs b/src/cljs/emptyhead/principle/eval.cljs deleted file mode 100644 index f74e900..0000000 --- a/src/cljs/emptyhead/principle/eval.cljs +++ /dev/null @@ -1,46 +0,0 @@ -(ns emptyhead.principle.eval - "Implements evaluation of principles." - (:require [emptyhead.idea.protocol :as prtc] - [emptyhead.principle.extend :as extend] - [emptyhead.principle.crud :as principle] - [emptyhead.util.logging :as logging] - [emptyhead.principle.return :as return] - [emptyhead.idea.property :as prop] - [emptyhead.idea.crud :as idea] - [emptyhead.util.magic :as magic])) - -(defn- impl! [principle & [parent]] - (let [impl-idea (prop/just-property (magic/principle-impl-prop (principle/operator principle)))] - (if-not impl-idea - (logging/error (str "No implementation for principle `" (principle/operator principle) "`.") - {:principle principle :parent parent :type :unimplemented-principle}) - ((prtc/copy-fn :implementation impl-idea) principle parent)))) - -(def root-principle (principle/make-principle :root)) - -;; at what point do returns get cleared? -(defn execute! - "Execute `principle` with `parent`, applying aspects to `principle` according to its :extension-stages. - Returns (potentially modified) `parent`." - [principle & [parent]] - (loop [th (prtc/copy principle) - parent (or parent root-principle)] - (let [cur (first (principle/stages principle)) - [extensions th] (extend/pop-stage th) - - ;; Execute extensions, potentially modifying th - th (reduce #(execute! %2 %1) th extensions) - ;; If it's time for `principle`'s implementation to run, do so, - ;; potentially modifying `parent`. - [parent return] - (if (= cur [:principle (principle/operator th)]) - (impl! th parent) - parent) - - ;; Fold return value into `parent`. - parent (return/with-return parent (principle/operator th) return)] - - ;; Recur if there's remaining aspects, otherwise return `parent`. - (if (not-empty (principle/stages th)) - (recur th parent) - parent)))) diff --git a/src/cljs/emptyhead/principle/extend.cljs b/src/cljs/emptyhead/principle/extend.cljs deleted file mode 100644 index 4815408..0000000 --- a/src/cljs/emptyhead/principle/extend.cljs +++ /dev/null @@ -1,61 +0,0 @@ -(ns emptyhead.principle.extend - (:require [emptyhead.contract.eval :as contract] - [emptyhead.idea.property :as prop] - [emptyhead.idea.protocol :as prtc] - [emptyhead.principle.crud :as principle] - [emptyhead.util.magic :as magic] - [clojure.set :refer [union]])) - -(defn register-extension - "Register `principle` as extension for one or more `stages`." - [principle & stages] - (doseq [stage stages] - (prop/register-property! principle (magic/extension-prop stage))) - principle) - -(defn remove-extension! - "Remove `principle` as extension for one or more `stages`." - [principle & stages] - (doseq [stage stages] - (prop/remove-property! principle (magic/extension-prop stage))) - principle) - -(defn- get-extensions - "Get extensions for `stage`; - e.g. for `stage` of [:foo :bar :baz], get extensions for [:foo :bar :baz], [:foo :bar], [:foo]" - [stage] - (loop [property-segment stage - acc []] - (if (empty? property-segment) - acc - (recur (butlast property-segment) - (union acc (prop/with-property (magic/extension-prop property-segment))))))) - -(defn extensions - "Get extensions of `principle`. - Returns a map of {stage => #{principle}}." - [principle] - (let [stages (principle/stages principle) - filter-fn #(contract/evaluate (principle/contract principle) %) - aspects (map - #(->> % get-extensions (filter filter-fn)) - stages)] - (zipmap stages aspects))) - -(defn pop-stage - "Get aspects of next stage of principle execution. - Returns a tuple of (#{extension-dhammas}, - a copy of `principle` with its first extension-stage removed)." - [principle] - (let [stages (principle/stages principle) - aspects (filter #(contract/evaluate (principle/contract principle) %) - (get-extensions (first stages))) - modified (prtc/copy-fn #(assoc % :ext-stages (rest stages)) - principle)] - (list aspects modified))) - -(defn has-stage? - "Return true if `principle` has extension stage `stage`. - Also works if e.g. `stage` is [:foo] and `principle` has [:foo :bar]." - [principle stage] - (some #(= stage (take (count stage) %)) (principle/stages principle))) diff --git a/src/cljs/emptyhead/thought/crud.cljs b/src/cljs/emptyhead/thought/crud.cljs new file mode 100644 index 0000000..2221d21 --- /dev/null +++ b/src/cljs/emptyhead/thought/crud.cljs @@ -0,0 +1,50 @@ +(ns emptyhead.thought.crud + "Implements CRUD operations on thoughts. + Since thoughts are ideas, 'missing' operations here are implemented in [[emptyhead.idea.crud]]." + (:require [emptyhead.idea.protocol :as prtc] + [emptyhead.idea.crud :as idea] + [emptyhead.idea.property :as prop] + [emptyhead.contract.eval :as contract] + [emptyhead.util.magic :as magic])) + +(defn make-thought + "Helper function to make thought object. + You may want `register-thought!` instead." + [operator & {:keys [data ext-contract ext-stages transient] + :or {data {} ext-contract {} + ext-stages [[:thought operator]] + transient true}}] + (hash-map :operator operator + :data data + :ext-contract ext-contract + :ext-stages ext-stages + :return {} + :transient (not (false? transient)))) + +(defn register-thought! + "Create a thought and register it in the state. + Returns a reference to the created thought." + [operator & {:keys [data ext-contract ext-stages transient] + :as args}] + (idea/have-idea! + :prefix (str "thought_" (magic/symbolize-ns operator) "_") + :properties [magic/thought-ns] + :data (make-thought operator args))) + +(defn contract + "Get the extension contract of a `thought`. + Returns the contract." + [thought] + (prtc/val-fn :ext-contract thought)) + +(defn stages + "Get the extension stages of a `thought`. + Returns the list of stages." + [thought] + (prtc/val-fn :ext-stages thought)) + +(defn operator + "Get the operator id of a `thought`. + Returns the operator keyword." + [thought] + (prtc/val-fn :operator thought)) diff --git a/src/cljs/emptyhead/principle/define.cljs b/src/cljs/emptyhead/thought/define.cljs similarity index 56% rename from src/cljs/emptyhead/principle/define.cljs rename to src/cljs/emptyhead/thought/define.cljs index 7eecbb7..91d3792 100644 --- a/src/cljs/emptyhead/principle/define.cljs +++ b/src/cljs/emptyhead/thought/define.cljs @@ -1,29 +1,29 @@ -(ns emptyhead.principle.define - "Utilities for defining new principles." - (:require [emptyhead.principle.crud :as principle] - [emptyhead.principle.eval :as eval] +(ns emptyhead.thought.define + "Utilities for defining new thoughts." + (:require [emptyhead.thought.crud :as thought] + [emptyhead.thought.eval :as eval] [emptyhead.idea.crud :as idea] [emptyhead.util.magic :as magic])) (defn register-implementation! [operator impl] - (idea/have-idea! :prefix (str "impl_principle_" (name operator)) - :properties [(magic/principle-impl-prop operator)] + (idea/have-idea! :prefix (str "impl_thought#" (magic/symbolize-ns operator)) + :properties [(magic/thought-impl-prop operator)] :data {:implementation impl})) (defn register-constructor! [operator & {:keys [constr-fn defaults] :or {constr-fn identity defaults {}}}] - (let [constr-op (keyword (str (name operator) ".construct"))] + (let [constr-op (conj operator :construct)] (register-implementation! constr-op - (fn [principle & [parent]] + (fn [thought & [parent]] [parent - (principle/register-principle! + (thought/register-thought! operator (merge defaults {:operator operator} - (constr-fn (merge parent principle))))])))) + (constr-fn (merge parent thought))))])))) (defn define! [operator impl & {:keys [constr-fn defaults] diff --git a/src/cljs/emptyhead/thought/eval.cljs b/src/cljs/emptyhead/thought/eval.cljs new file mode 100644 index 0000000..97d3baf --- /dev/null +++ b/src/cljs/emptyhead/thought/eval.cljs @@ -0,0 +1,47 @@ +(ns emptyhead.thought.eval + "Implements evaluation of thoughts." + (:require [emptyhead.idea.protocol :as prtc] + [emptyhead.thought.extend :as extend] + [emptyhead.thought.crud :as thought] + [emptyhead.util.logging :as logging] + [emptyhead.thought.return :as return] + [emptyhead.idea.property :as prop] + [emptyhead.idea.crud :as idea] + [emptyhead.util.magic :as magic])) + +(defn- impl! [thought & [parent]] + (let [impl-idea + (-> thought prtc/value thought/operator magic/thought-impl-prop prop/just-property)] + (if-not impl-idea + (logging/error (str "No implementation for thought `" (thought/operator thought) "`.") + {:thought thought :parent parent :type :unimplemented-thought}) + ((prtc/copy-fn :implementation impl-idea) thought parent)))) + +(def root-thought (thought/make-thought :root)) + +;; at what point do returns get cleared? +(defn execute! + "Execute `thought` with `parent`, applying aspects to `thought` according to its :extension-stages. + Returns (potentially modified) `parent`." + [thought & [parent]] + (loop [th (prtc/copy thought) + parent (or parent root-thought)] + (let [cur (first (thought/stages thought)) + [extensions th] (extend/pop-stage th) + + ;; Execute extensions, potentially modifying th + th (reduce #(execute! %2 %1) th extensions) + ;; If it's time for `thought`'s implementation to run, do so, + ;; potentially modifying `parent`. + [parent return] + (if (= cur [:thought (thought/operator th)]) + (impl! th parent) + parent) + + ;; Fold return value into `parent`. + parent (return/with-return parent (thought/operator th) return)] + + ;; Recur if there's remaining aspects, otherwise return `parent`. + (if (not-empty (thought/stages th)) + (recur th parent) + parent)))) diff --git a/src/cljs/emptyhead/thought/extend.cljs b/src/cljs/emptyhead/thought/extend.cljs new file mode 100644 index 0000000..f4a4274 --- /dev/null +++ b/src/cljs/emptyhead/thought/extend.cljs @@ -0,0 +1,61 @@ +(ns emptyhead.thought.extend + (:require [emptyhead.contract.eval :as contract] + [emptyhead.idea.property :as prop] + [emptyhead.idea.protocol :as prtc] + [emptyhead.thought.crud :as thought] + [emptyhead.util.magic :as magic] + [clojure.set :refer [union]])) + +(defn register-extension + "Register `thought` as extension for one or more `stages`." + [thought & stages] + (doseq [stage stages] + (prop/register-property! thought (magic/extension-prop stage))) + thought) + +(defn remove-extension! + "Remove `thought` as extension for one or more `stages`." + [thought & stages] + (doseq [stage stages] + (prop/remove-property! thought (magic/extension-prop stage))) + thought) + +(defn- get-extensions + "Get extensions for `stage`; + e.g. for `stage` of [:foo :bar :baz], get extensions for [:foo :bar :baz], [:foo :bar], [:foo]" + [stage] + (loop [property-segment stage + acc []] + (if (empty? property-segment) + acc + (recur (butlast property-segment) + (union acc (prop/with-property (magic/extension-prop property-segment))))))) + +(defn extensions + "Get extensions of `thought`. + Returns a map of {stage => #{thought}}." + [thought] + (let [stages (thought/stages thought) + filter-fn #(contract/evaluate (thought/contract thought) %) + aspects (map + #(->> % get-extensions (filter filter-fn)) + stages)] + (zipmap stages aspects))) + +(defn pop-stage + "Get aspects of next stage of thought execution. + Returns a tuple of (#{extension-dhammas}, + a copy of `thought` with its first extension-stage removed)." + [thought] + (let [stages (thought/stages thought) + aspects (filter #(contract/evaluate (thought/contract thought) %) + (get-extensions (first stages))) + modified (prtc/copy-fn #(assoc % :ext-stages (rest stages)) + thought)] + (list aspects modified))) + +(defn has-stage? + "Return true if `thought` has extension stage `stage`. + Also works if e.g. `stage` is [:foo] and `thought` has [:foo :bar]." + [thought stage] + (some #(= stage (take (count stage) %)) (thought/stages thought))) diff --git a/src/cljs/emptyhead/principle/return.cljs b/src/cljs/emptyhead/thought/return.cljs similarity index 100% rename from src/cljs/emptyhead/principle/return.cljs rename to src/cljs/emptyhead/thought/return.cljs diff --git a/src/cljs/emptyhead/util/magic.cljs b/src/cljs/emptyhead/util/magic.cljs index f0cfa12..00e3b75 100644 --- a/src/cljs/emptyhead/util/magic.cljs +++ b/src/cljs/emptyhead/util/magic.cljs @@ -1,14 +1,18 @@ (ns emptyhead.util.magic - "Magic values for EmptyHead.") + "Magic values for EmptyHead." + (:require [clojure.string :as str])) -(def principle-ns [:emptyhead :principle]) +(def thought-ns [:emptyhead :thought]) -(def principle-impl-ns (conj principle-ns :implementation)) +(def thought-impl-ns (conj thought-ns :implementation)) -(defn principle-impl-prop [operator] - (conj principle-impl-ns operator)) +(defn thought-impl-prop [operator] + (conj thought-impl-ns operator)) -(def extension-ns (conj principle-ns :extends)) +(def extension-ns (conj thought-ns :extends)) (defn extension-prop [stage] (conj extension-ns stage)) + +(defn symbolize-ns [ns] + (str/join "." (map name ns)))