97 lines
2.9 KiB
Clojure
97 lines
2.9 KiB
Clojure
(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.util.magic :as magic]
|
|
[emptyhead.idea.property :as prop]))
|
|
|
|
(defn make-thought
|
|
"Helper function to make thought object.
|
|
You may want `register-thought!` instead."
|
|
[operator & {:keys [data ext-stages return transient]
|
|
:or {data {}
|
|
ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]
|
|
transient true
|
|
return []}}]
|
|
(hash-map :operator operator
|
|
:data data
|
|
:ext-stages ext-stages
|
|
:transient transient
|
|
:return return))
|
|
|
|
(defn register-thought!
|
|
"Create a thought and register it in the state.
|
|
Returns a reference to the created thought."
|
|
[operator & {:keys [data ext-stages return transient]
|
|
:as args}]
|
|
(idea/have-idea!
|
|
:prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
|
|
:properties [magic/thought-ns
|
|
(magic/operator-property [operator])]
|
|
:data (make-thought operator args)))
|
|
|
|
(defn deref-primitive_
|
|
[operator]
|
|
(prop/with-property (magic/operator-property [operator])))
|
|
|
|
(defn deref-primitive
|
|
[operator]
|
|
(let [existing (deref-primitive_ operator)
|
|
n (count existing)]
|
|
(when (> n 1)
|
|
(throw (ex-info (str "ERROR: Primitive " operator " has " n " implementations.")
|
|
{:n n :operator operator})))
|
|
(first existing)))
|
|
|
|
(defn register-singleton!
|
|
"Register a thought of which only one is meant to exist."
|
|
[operator & {:keys [data ext-stages]
|
|
:as args}]
|
|
(let [existing (deref-primitive_ operator)]
|
|
(run! idea/forget-idea! existing)
|
|
(register-thought! operator args)))
|
|
|
|
(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))
|
|
|
|
(defn data
|
|
"Get the data field of a `thought`."
|
|
[thought]
|
|
(prtc/val-fn :data thought))
|
|
|
|
(defn stack
|
|
[thought]
|
|
(prtc/val-fn :return thought))
|
|
|
|
(defn pop-stack
|
|
[thought]
|
|
[(assoc thought :return (-> thought prtc/copy stack butlast vec)) (-> thought prtc/copy stack peek)])
|
|
|
|
(defn empty-stack
|
|
[thought]
|
|
[(assoc thought :return []) (:return thought)])
|
|
|
|
(defn pop-args
|
|
[thought dest]
|
|
(let [sentinel (into [:_FOR] (prtc/val-fn :operator dest))
|
|
stack (prtc/val-fn :return thought)
|
|
idx (.lastIndexOf stack sentinel)
|
|
before (subvec stack 0 idx)
|
|
after (subvec stack (+ 1 idx))]
|
|
[(assoc thought :return before)
|
|
after]))
|
|
|
|
(defn add-ext-stage!
|
|
[thought stage]
|
|
(idea/mutate-idea! #(update % :ext-stages conj stage) thought))
|