(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)))))