Have to start being more leGit about this hehe :3

2024-07-22 18:04:36 +02:00
parent 1cf0709056
commit b29ad92192
27 changed files with 588 additions and 227 deletions
--- a/.clj-kondo/buddho/macros/dhamma.clj
+++ b/.clj-kondo/buddho/macros/dhamma.clj
@@ -0,0 +1,69 @@
+(ns buddho.macros.dhamma
+  (:require [clojure.set :as set]))
+
+(defmacro defconstructor
+  [dh-name & {:keys [meta data defaults dh-defaults]
+              :or {meta {} data {} dh-defaults {}}}]
+  `(defn ~(symbol (str dh-name "!"))
+     [& {:keys [~@(concat (keys meta) (keys data)) ~'dh-args]
+         :or ~defaults}]
+     (#'buddho.core.dhamma/register-dhamma!
+      ~(keyword dh-name)
+      (merge
+       ~(merge {:name (keyword dh-name)}
+               dh-defaults
+               {:data (set/map-invert data)}
+               {:meta {(keyword dh-name) (set/map-invert meta)}})
+       ~'dh-args))))
+
+(defn extraction-bindings [datasym bindings extractor defaults]
+  `(~datasym
+    (~extractor
+     [~'dhamma ~'parent]
+     ~defaults)
+
+    ~@(mapcat (fn [[k v]] `(~k (~v ~datasym))) bindings)))
+
+(defmacro defdhamma [name docstring
+                     {:keys [data meta
+                             defaults
+                             dh-defaults
+                             meta-as data-as]
+                      :or {defaults {}}}
+                     & body]
+  (let [kw (keyword name)
+        default-data
+        (->> data
+             (map (fn [[k v]] [v (defaults k)]))
+             (into {}))
+        default-meta
+        (->> meta
+             (map (fn [[k v]] [v (defaults k)]))
+             (into {}))]
+    `(do
+       (defconstructor ~name
+         :data ~data
+         :meta ~meta
+         :dh-defaults ~dh-defaults
+         :defaults ~defaults)
+
+       (#'buddho.core.state/describe-dhamma!
+        ~kw
+        ~docstring)
+
+       (defmethod buddho.core.dhamma/impl! ~kw ~(symbol (str "impl-" name))
+         [~'dhamma & [~'parent]]
+         (let [~@(when (or data data-as)
+                   (extraction-bindings
+                    (or data-as `data#)
+                    data
+                    '#'buddho.core.dhamma/extract-data
+                    default-data))
+
+               ~@(when (or meta meta-as)
+                   (extraction-bindings
+                    (or meta-as `meta#)
+                    meta
+                    '#'buddho.core.dhamma/extract-meta
+                    default-meta))]
+           ~@body)))))