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

Ensure there's no double-evaluation of the return types

Browse source
This commit is contained in:
Joshua Suskalo 2021-10-13 13:46:03 -05:00
parent 6f28994526
commit b1133811a0
1 changed files with 45 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
src/clj/coffi/ffi.clj
View file

@ -255,6 +255,7 @@
scope (gensym "scope")] scope (gensym "scope")]
(if-not (seqable? arg-types) (if-not (seqable? arg-types)
(let [args (gensym "args") (let [args (gensym "args")
ret (gensym "ret")
serialized-args `(map (fn [arg# type#] (mem/serialize arg# type# ~scope)) ~args ~arg-types) serialized-args `(map (fn [arg# type#] (mem/serialize arg# type# ~scope)) ~args ~arg-types)
prim-call `(apply ~downcall ~serialized-args) prim-call `(apply ~downcall ~serialized-args)
non-prim-call `(apply ~downcall (mem/scope-allocator ~scope) ~serialized-args)] non-prim-call `(apply ~downcall (mem/scope-allocator ~scope) ~serialized-args)]
@ -267,24 +268,27 @@
~prim-call)) ~prim-call))
const-ret? const-ret?
`(fn ~'native-fn `(let [~ret ~ret-type]
(fn ~'native-fn
[~'& ~args] [~'& ~args]
(with-open [~scope (mem/stack-scopee)] (with-open [~scope (mem/stack-scopee)]
~(if (mem/primitive-type ret-type) ~(if (mem/primitive-type ret-type)
`(mem/deserialize* ~prim-call ~ret-type) `(mem/deserialize* ~prim-call ~ret)
`(mem/deserialize-from ~non-prim-call ~ret-type)))) `(mem/deserialize-from ~non-prim-call ~ret)))))
:else :else
`(if (mem/primitive-type ~ret-type) `(let [~ret ~ret-type]
(if (mem/primitive-type ~ret)
(fn ~'native-fn (fn ~'native-fn
[~'& ~args] [~'& ~args]
(with-open [~scope mem/stack-scope] (with-open [~scope mem/stack-scope]
(mem/deserialize* ~prim-call ~ret-type))) (mem/deserialize* ~prim-call ~ret)))
(fn ~'native-fn (fn ~'native-fn
[~'& ~args] [~'& ~args]
(with-open [~scope mem/stack-scope] (with-open [~scope mem/stack-scope]
(mem/deserialize-from ~non-prim-call ~ret-type)))))) (mem/deserialize-from ~non-prim-call ~ret)))))))
(let [arg-syms (repeatedly (count arg-types) #(gensym "arg")) (let [arg-syms (repeatedly (count arg-types) #(gensym "arg"))
ret (gensym "ret")
serialize-args (map (fn [sym type] serialize-args (map (fn [sym type]
(if (s/valid? ::mem/type type) (if (s/valid? ::mem/type type)
(if-not (mem/primitive? type) (if-not (mem/primitive? type)
@ -318,12 +322,13 @@
native-fn) native-fn)
:else :else
(let [call (cons downcall arg-syms) `(let [~ret ~ret-type]
prim-call `(mem/deserialize* ~call ~ret-type) ~(let [call (cons downcall arg-syms)
prim-call `(mem/deserialize* ~call ~ret)
non-prim-call `(mem/deserialize-from ~(list* (first call) non-prim-call `(mem/deserialize-from ~(list* (first call)
`(mem/scope-allocator ~scope) `(mem/scope-allocator ~scope)
(rest call)) (rest call))
~ret-type)] ~ret)]
(cond (cond
(and none-to-serialize? (and none-to-serialize?
const-ret?) const-ret?)
@ -332,7 +337,7 @@
non-prim-call)) non-prim-call))
none-to-serialize? none-to-serialize?
`(if (mem/primitive-type ~ret-type) (if (mem/primitive-type ~ret)
~(native-fn prim-call) ~(native-fn prim-call)
~(native-fn non-prim-call)) ~(native-fn non-prim-call))
@ -343,9 +348,9 @@
non-prim-call))) non-prim-call)))
:else :else
`(if (mem/primitive-type ~ret-type) `(if (mem/primitive-type ~ret)
~(native-fn (wrap-serialize prim-call)) ~(native-fn (wrap-serialize prim-call))
~(native-fn (wrap-serialize non-prim-call)))))))))) ~(native-fn (wrap-serialize non-prim-call)))))))))))
(defn make-serde-wrapper (defn make-serde-wrapper
"Constructs a wrapper function for the `downcall` which serializes the arguments "Constructs a wrapper function for the `downcall` which serializes the arguments