70 lines
2.1 KiB
Clojure
70 lines
2.1 KiB
Clojure
(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)))))
|