Add an optional attribute map to defcfn

This commit is contained in:
Joshua Suskalo 2021-09-16 15:14:11 -05:00
parent d6d9ac316c
commit d05b5596f8

View file

@ -536,6 +536,7 @@
(s/def ::defcfn-args (s/def ::defcfn-args
(s/cat :name simple-symbol? (s/cat :name simple-symbol?
:doc (s/? string?) :doc (s/? string?)
:attr-map (s/? map?)
:symbol (s/nonconforming :symbol (s/nonconforming
(s/or :string string? (s/or :string string?
:symbol simple-symbol?)) :symbol simple-symbol?))
@ -546,7 +547,8 @@
:body (s/* any?))))) :body (s/* any?)))))
(defmacro defcfn (defmacro defcfn
{:arglists '([name docstring? symbol arg-types ret-type arglist & body])} {:arglists '([name docstring? attr-map? symbol arg-types ret-type]
[name docstring? attr-map? symbol arg-types ret-type arglist & body])}
[& args] [& args]
(let [args (s/conform ::defcfn-args args) (let [args (s/conform ::defcfn-args args)
scope (gensym "scope") scope (gensym "scope")
@ -570,8 +572,8 @@
~@(-> args :fn-tail :body)) ~@(-> args :fn-tail :body))
(:name args))] (:name args))]
(def (def
~(vary-meta (:name args) ~(with-meta (:name args)
update :arglists (merge (update (meta (:name args)) :arglists
(fn [old-list] (fn [old-list]
(list (list
'quote 'quote
@ -580,6 +582,7 @@
(or (-> args :fn-tail :arglist) (or (-> args :fn-tail :arglist)
(mapv (comp symbol name) (mapv (comp symbol name)
(:native-arglist args)))))))) (:native-arglist args))))))))
(:attr-map args)))
~@(list (:doc args)) ~@(list (:doc args))
fun#)))) fun#))))