luciano/coffi
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add a function to make a serde wrapper fn

Browse source
This commit is contained in:
Joshua Suskalo 2021-09-20 14:13:26 -05:00
parent 6014ace2a4
commit 382f342aa5
1 changed files with 17 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
src/coffi/ffi.clj
View file

@ -752,6 +752,19 @@
:complex-type (s/cat :base-type qualified-keyword? :complex-type (s/cat :base-type qualified-keyword?
:type-args (s/* any?))))) :type-args (s/* any?)))))
(defn make-serde-wrapper
"Constructs a wrapper function for the `downcall` which serializes the arguments
and deserializes the return value."
[downcall arg-types ret-type]
(fn native-fn [& args]
(with-open [scope (stack-scope)]
(deserialize (apply downcall (map #(serialize %1 %2 scope) args arg-types))
ret-type))))
(s/fdef make-serde-wrapper
:args (s/cat :downcall ifn?
:arg-types (s/coll-of ::type :kind vector?)
:ret-type ::type))
(s/def ::defcfn-args (s/def ::defcfn-args
(s/and (s/and
(s/cat :name simple-symbol? (s/cat :name simple-symbol?
@ -800,9 +813,7 @@
[name docstring? attr-map? symbol arg-types ret-type native-fn & fn-tail])} [name docstring? attr-map? symbol arg-types ret-type native-fn & fn-tail])}
[& args] [& args]
(let [args (s/conform ::defcfn-args args) (let [args (s/conform ::defcfn-args args)
scope (gensym "scope") args-types (gensym "args-types")
arg-syms (repeatedly (count (:native-arglist args)) #(gensym "arg"))
arg-types (repeatedly (count (:native-arglist args)) #(gensym "arg-type"))
ret-type (gensym "ret-type") ret-type (gensym "ret-type")
invoke (gensym "invoke") invoke (gensym "invoke")
native-sym (gensym "native") native-sym (gensym "native")
@ -815,24 +826,16 @@
:single-arity [fn-tail] :single-arity [fn-tail]
:multi-arity fn-tail :multi-arity fn-tail
nil))] nil))]
`(let [args-types# ~(:native-arglist args) `(let [~args-types ~(:native-arglist args)
[~@arg-types] args-types#
~ret-type ~(:return-type args) ~ret-type ~(:return-type args)
~invoke (make-downcall ~(name (:symbol args)) args-types# ~ret-type) ~invoke (make-downcall ~(name (:symbol args)) ~args-types ~ret-type)
~(or (-> args :wrapper :native-fn) native-sym) ~(or (-> args :wrapper :native-fn) native-sym)
~(if (and (every? #(= % (primitive-type %)) ~(if (and (every? #(= % (primitive-type %))
(:native-arglist args)) (:native-arglist args))
(= (:return-type args) (= (:return-type args)
(primitive-type (:return-type args)))) (primitive-type (:return-type args))))
invoke invoke
`(fn [~@arg-syms] `(make-serde-wrapper ~invoke ~args-types ~ret-type))
(with-open [~scope (stack-scope)]
(deserialize (~invoke
~@(map
(fn [sym type]
`(serialize ~sym ~type ~scope))
arg-syms arg-types))
~ret-type))))
fun# ~(if (:wrapper args) fun# ~(if (:wrapper args)
`(fn ~(:name args) `(fn ~(:name args)
~@fn-tail) ~@fn-tail)