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

Optimize the output of defcfn slightly

Browse source
This commit is contained in:
Joshua Suskalo 2021-09-16 15:38:04 -05:00
parent 6dd90d279c
commit 1461dbcf81
1 changed files with 24 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
src/coffi/ffi.clj
View file

@ -551,21 +551,31 @@
[& args] [& args]
(let [args (s/conform ::defcfn-args args) (let [args (s/conform ::defcfn-args args)
scope (gensym "scope") scope (gensym "scope")
arg-syms (repeatedly (count (:native-arglist args)) #(gensym "arg"))] arg-syms (repeatedly (count (:native-arglist args)) #(gensym "arg"))
arg-types (repeatedly (count (:native-arglist args)) #(gensym "arg-type"))
ret-type (gensym "ret-type")
invoke (gensym "invoke")]
`(let [args-types# ~(:native-arglist args) `(let [args-types# ~(:native-arglist args)
ret-type# ~(:return-type args) [~@arg-types] args-types#
downcall# (downcall-handle ~ret-type ~(:return-type args)
(find-symbol ~(name (:symbol args))) ~invoke (-> (find-symbol ~(name (:symbol args)))
(method-type args-types# ret-type#) (downcall-handle
(function-descriptor args-types# ret-type#)) (method-type args-types# ~ret-type)
invoke# (downcall-fn downcall# args-types# ret-type#) (function-descriptor args-types# ~ret-type))
~(:name args) (fn [~@arg-syms] (downcall-fn args-types# ~ret-type))
(with-open [~scope (stack-scope)] ~(:name args) ~(if (and (every? #(= % (primitive-type %))
(let [[~@arg-syms] (map #(serialize %1 %2 ~scope) (:native-arglist args))
[~@arg-syms] (= (:return-type args)
args-types#)] (primitive-type (:return-type args))))
(deserialize (invoke# ~@arg-syms) invoke
ret-type#)))) `(fn [~@arg-syms]
(with-open [~scope (stack-scope)]
(deserialize (~invoke
~@(map
(fn [sym type]
`(serialize ~sym ~type ~scope))
arg-syms arg-types))
~ret-type))))
fun# ~(if (:fn-tail args) fun# ~(if (:fn-tail args)
`(fn ~(-> args :fn-tail :arglist) `(fn ~(-> args :fn-tail :arglist)
~@(-> args :fn-tail :body)) ~@(-> args :fn-tail :body))