Replace defstruct style macros with a defalias
This commit is contained in:
parent
bb4c9d89f2
commit
b6fbd3eccb
1 changed files with 25 additions and 65 deletions
|
|
@ -1145,73 +1145,33 @@
|
||||||
(s/fdef defcfn
|
(s/fdef defcfn
|
||||||
:args ::defcfn-args)
|
:args ::defcfn-args)
|
||||||
|
|
||||||
(s/def ::defcstruct-args
|
(defmacro defalias
|
||||||
(s/cat :struct-name qualified-keyword?
|
"Defines a type alias from `new-type` to `aliased-type`.
|
||||||
;:layout (s/? keyword?)
|
|
||||||
;:docstring (s/? string?)
|
|
||||||
:fields (s/* (s/cat :field-name simple-keyword?
|
|
||||||
:field-type ::type))))
|
|
||||||
|
|
||||||
(defmacro defcstruct
|
This creates needed serialization and deserialization implementations for the
|
||||||
"Defines a type alias for a struct with the given name and fields.
|
aliased type."
|
||||||
|
[new-type aliased-type]
|
||||||
The fields are provided as keyword args.
|
(if (primitive-type aliased-type)
|
||||||
|
`(let [aliased# ~aliased-type]
|
||||||
Currently no padding is provided into the structure."
|
(defmethod primitive-type ~new-type
|
||||||
{:arglists '([struct-name & fields])}
|
|
||||||
[& args]
|
|
||||||
;; TODO(Joshua): Support adding padding to the structure (and make it
|
|
||||||
;; extensible?)
|
|
||||||
(let [args (s/conform ::defcstruct-args args)]
|
|
||||||
`(let [struct-type# [::struct ~(mapv (juxt :field-name :field-type) (:fields args))]]
|
|
||||||
(defmethod c-layout ~(:struct-name args)
|
|
||||||
[_type#]
|
[_type#]
|
||||||
(c-layout struct-type#))
|
(primitive-type aliased#))
|
||||||
(defmethod serialize-into ~(:struct-name args)
|
(defmethod serialize* ~new-type
|
||||||
[obj# _type# segment# scope#]
|
[obj# _type# scope#]
|
||||||
(serialize-into obj# struct-type# segment# scope#))
|
(serialize* obj# aliased# scope#))
|
||||||
(defmethod deserialize-from ~(:struct-name args)
|
(defmethod deserialize* ~new-type
|
||||||
[segment# _type#]
|
[obj# _type#]
|
||||||
(deserialize-from segment# struct-type#)))))
|
(deserialize* obj# aliased#)))
|
||||||
(s/fdef defcstruct
|
`(let [aliased# ~aliased-type]
|
||||||
:args ::defcstruct-args)
|
(defmethod c-layout ~new-type
|
||||||
|
|
||||||
(s/def ::defcunion-args
|
|
||||||
(s/cat :union-name qualified-keyword?
|
|
||||||
;:docstring (s/? string?)
|
|
||||||
:types (s/coll-of ::type :kind set?)
|
|
||||||
:kwargs (s/* (s/cat :key #{:extract}
|
|
||||||
:val any?))
|
|
||||||
:dispatch (s/cat :obj-sym simple-symbol?
|
|
||||||
:body (s/* any?))))
|
|
||||||
|
|
||||||
(defmacro defcunion
|
|
||||||
"Defines a type alias for a union with the given name and types.
|
|
||||||
|
|
||||||
The `obj-sym` is a binding for the duration of `body` which is run as a
|
|
||||||
function which returns one of the items of the set `types`, and specifies how
|
|
||||||
an object from this union must be serialized.
|
|
||||||
|
|
||||||
`kwargs*` is keyword arguments to the function, accepting the following
|
|
||||||
arguments:
|
|
||||||
|
|
||||||
- :extract :: A function of the passed object which returns the value to be serialized"
|
|
||||||
{:arglists '([union-name types kwargs* obj-sym & body])}
|
|
||||||
[& args]
|
|
||||||
(let [args (s/conform ::defcunion-args args)]
|
|
||||||
`(let [union-type# [::union
|
|
||||||
(fn [~(-> args :dispatch :obj-sym)]
|
|
||||||
~@(-> args :dispatch :body))
|
|
||||||
~(:types args)
|
|
||||||
~@(mapcat (juxt :obj-sym :body) (:dispatch args))]]
|
|
||||||
(defmethod c-layout ~(:union-name args)
|
|
||||||
[_type#]
|
[_type#]
|
||||||
(c-layout union-type#))
|
(c-layout aliased#))
|
||||||
(defmethod serialize-into ~(:union-name args)
|
(defmethod serialize-into ~new-type
|
||||||
[obj# _type# segment# scope#]
|
[obj# _type# segment# scope#]
|
||||||
(serialize-into obj# union-type# segment# scope#))
|
(serialize-into obj# aliased# segment# scope#))
|
||||||
(defmethod deserialize-from ~(:union-name args)
|
(defmethod deserialize-from ~new-type
|
||||||
[segment# _type#]
|
[segment# _type#]
|
||||||
(deserialize-from segment# union-type#)))))
|
(deserialize-from segment# aliased#)))))
|
||||||
(s/fdef defcunion
|
(s/fdef defalias
|
||||||
:args ::defcunion-args)
|
:args (s/cat :new-type qualified-keyword?
|
||||||
|
:aliased-type ::type))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue