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

Merge branch 'develop'

Browse source
This commit is contained in:
Joshua Suskalo 2021-10-14 18:34:57 -05:00
commit a9a0d3d074
2 changed files with 135 additions and 99 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
CHANGELOG.md
View file

@ -1,6 +1,10 @@
# Change Log # Change Log
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
## [Unreleased]
### Fixed
- Bug with the inline expansion of `make-serde-wrapper`, make it more maintainable
## [0.1.246] - 2021-10-14 ## [0.1.246] - 2021-10-14
### Fixed ### Fixed
- Incorrect inline expansion of `make-serde-wrapper` in cases where a function has no arguments - Incorrect inline expansion of `make-serde-wrapper` in cases where a function has no arguments
@ -59,6 +63,7 @@ All notable changes to this project will be documented in this file. This change
- Support for serializing and deserializing arbitrary Clojure functions - Support for serializing and deserializing arbitrary Clojure functions
- Support for serializing and deserializing arbitrary Clojure data structures - Support for serializing and deserializing arbitrary Clojure data structures
[Unreleased]: https://github.com/IGJoshua/coffi/compare/v0.1.246...HEAD
[0.1.246]: https://github.com/IGJoshua/coffi/compare/v0.1.241...v0.1.246 [0.1.246]: https://github.com/IGJoshua/coffi/compare/v0.1.241...v0.1.246
[0.1.241]: https://github.com/IGJoshua/coffi/compare/v0.1.220...v0.1.241 [0.1.241]: https://github.com/IGJoshua/coffi/compare/v0.1.220...v0.1.241
[0.1.220]: https://github.com/IGJoshua/coffi/compare/v0.1.205...v0.1.220 [0.1.220]: https://github.com/IGJoshua/coffi/compare/v0.1.205...v0.1.220

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

@ -250,112 +250,143 @@
primitive, the `downcall` is returned directly. In cases where arguments must primitive, the `downcall` is returned directly. In cases where arguments must
be serialized, a new [[mem/stack-scope]] is generated." be serialized, a new [[mem/stack-scope]] is generated."
[downcall arg-types ret-type] [downcall arg-types ret-type]
(let [const-ret? (s/valid? ::mem/type ret-type) (let [;; Complexity of types
primitive-ret? (mem/primitive? ret-type) const-args? (or (vector? arg-types) (nil? arg-types))
scope (gensym "scope") simple-args? (when const-args?
downcall-sym (gensym "downcall")] (every? mem/primitive? arg-types))
`(let [~downcall-sym ~downcall] const-ret? (s/valid? ::mem/type ret-type)
~(if-not (seqable? arg-types) primitive-ret? (and const-ret? (or (mem/primitive? ret-type)
(let [args (gensym "args") (#{::mem/void} ret-type)))
ret (gensym "ret") simple-ret? (and const-ret? (mem/primitive-type ret-type))
serialized-args `(map (fn [arg# type#] (mem/serialize arg# type# ~scope)) ~args ~arg-types) no-serde? (and const-args? (empty? arg-types)
prim-call `(apply ~downcall-sym ~serialized-args) primitive-ret?)]
non-prim-call `(apply ~downcall-sym (mem/scope-allocator ~scope) ~serialized-args)] (if no-serde?
(cond `(let [downcall# ~downcall]
(and const-ret? ;; NOTE(Joshua): These are here to ensure that evaluation order is
primitive-ret?) ;; preserved as equivalent to a function call.
`(fn ~'native-fn ~arg-types
[~'& ~args] ~ret-type
(with-open [~scope (mem/stack-scope)] downcall#)
~prim-call)) (let [;; All our symbols
scope (gensym "scope")
downcall-sym (gensym "downcall")
args-sym (when-not const-args?
(gensym "args"))
args-types-sym (when-not const-args?
(gensym "args-types"))
arg-syms (when const-args?
(repeatedly (count arg-types) #(gensym "arg")))
arg-type-syms (when const-args?
(repeatedly (count arg-types) #(gensym "arg-type")))
ret-type-sym (gensym "ret-type")
const-ret? ;; Helper Functions
`(let [~ret ~ret-type] make-serialized-binding
(fn ~'native-fn ;; Given a symbol and its type, make a partial binding to serialize and shadow it
[~'& ~args] (fn [sym type type-sym]
(with-open [~scope (mem/stack-scopee)] (some->>
~(if (mem/primitive-type ret-type) (cond
`(mem/deserialize* ~prim-call ~ret) (not (s/valid? ::mem/type type))
`(mem/deserialize-from ~non-prim-call ~ret))))) `(mem/serialize ~sym ~type-sym ~scope)
:else (and (mem/primitive? type)
`(let [~ret ~ret-type] (not (#{::mem/pointer} type)))
(if (mem/primitive-type ~ret) (list (primitive-cast-sym type) sym)
(fn ~'native-fn
[~'& ~args]
(with-open [~scope (mem/stack-scope)]
(mem/deserialize* ~prim-call ~ret)))
(fn ~'native-fn
[~'& ~args]
(with-open [~scope (mem/stack-scope)]
(mem/deserialize-from ~non-prim-call ~ret)))))))
(let [arg-syms (repeatedly (count arg-types) #(gensym "arg"))
ret (gensym "ret")
serialize-args (map (fn [sym type]
(if (s/valid? ::mem/type type)
(if-not (mem/primitive? type)
(list sym
(if (mem/primitive-type type)
`(mem/serialize* ~sym ~type ~scope)
`(let [alloc# (mem/alloc-instance ~type ~scope)]
(mem/serialize-into ~sym ~type alloc# ~scope)
alloc#)))
(if (primitive-cast-sym type)
(list sym (list (primitive-cast-sym type) sym))
nil))
(list sym `(mem/serialize ~sym ~type ~scope))))
arg-syms arg-types)
wrap-scope (fn [expr]
`(with-open [~scope (mem/stack-scope)]
~expr))
wrap-serialize (fn [expr]
`(let [~@(mapcat identity serialize-args)]
~expr))
native-fn (fn [expr]
`(fn ~'native-fn [~@arg-syms]
~expr))
none-to-serialize? (zero? (count (filter some? serialize-args)))]
(cond
(and none-to-serialize?
primitive-ret?)
downcall-sym
primitive-ret? (#{::mem/pointer} type)
(-> (cons downcall-sym arg-syms) nil
wrap-serialize
wrap-scope
native-fn)
:else (mem/primitive-type type)
`(let [~ret ~ret-type] `(mem/serialize* ~sym ~type-sym ~scope)
~(let [call (cons downcall-sym arg-syms)
prim-call `(mem/deserialize* ~call ~ret)
non-prim-call `(mem/deserialize-from ~(list* (first call)
`(mem/scope-allocator ~scope)
(rest call))
~ret)]
(cond
(and none-to-serialize?
const-ret?)
(native-fn (if (mem/primitive-type ret-type)
prim-call
(wrap-scope non-prim-call)))
none-to-serialize? :else
`(if (mem/primitive-type ~ret) `(let [alloc# (mem/alloc-instance ~type-sym)]
~(native-fn prim-call) (mem/serialize-into ~sym ~type-sym alloc# ~scope)
~(native-fn (wrap-scope non-prim-call))) alloc#))
(list sym)))
const-ret? arg-serializers
(native-fn (wrap-serialize ;; Binding forms that rebind the arg symbols to their serialized counterparts
(if (mem/primitive-type ret-type) (when const-args?
prim-call (->> (map make-serialized-binding
non-prim-call))) arg-syms arg-types arg-type-syms)
(filter some?)))
:else wrap-serialize
`(if (mem/primitive-type ~ret) ;; Wrap an expression to shadow args to their serialized counterparts
~(native-fn (wrap-serialize prim-call)) (fn [expr]
~(native-fn (wrap-serialize non-prim-call)))))))))))) (cond
(and const-args?
(zero? (count arg-types)))
expr
const-args?
(if (seq arg-serializers)
`(let [~@(mapcat identity arg-serializers)]
~expr)
expr)
:else
`(let [~args-sym (map (fn [obj# type#]
(mem/serialize obj# type# ~scope))
~args-sym ~args-types-sym)]
~expr)))
make-call (fn [args & {:keys [allocator?]}]
;; NOTE(Joshua): If `args` is a symbol, that means we're
;; taking restargs, and so the downcall must be applied
(-> `(~@(when (symbol? args) [`apply])
~downcall-sym
~@(when allocator? [`(mem/scope-allocator ~scope)])
~@(if (symbol? args)
[args]
args))
wrap-serialize))
deserialize-prim (fn [expr]
`(mem/deserialize* ~expr ~ret-type-sym))
deserialize-segment (fn [expr]
`(mem/deserialize-from ~expr ~ret-type-sym))
deserialize-ret (fn [expr]
(cond
(or (mem/primitive? ret-type)
(#{::mem/void} ret-type))
expr
(mem/primitive-type ret-type)
(deserialize-prim expr)
:else
(deserialize-segment expr)))
wrap-scope (fn [expr]
`(with-open [~scope (mem/stack-scope)]
~expr))
wrap-fn (fn [call needs-scope?]
`(fn [~@(if const-args? arg-syms ['& args-sym])]
~(cond-> call needs-scope? wrap-scope)))]
`(let [;; NOTE(Joshua): To ensure all arguments are evaluated once and
;; in-order, they must be bound here
~downcall-sym ~downcall
~@(if const-args?
(mapcat vector arg-type-syms arg-types)
[args-types-sym arg-types])
~ret-type-sym ~ret-type]
~(if const-ret?
(-> (make-call (if const-args? arg-syms args-sym)
:allocator? (not (mem/primitive-type ret-type)))
deserialize-ret
(wrap-fn (or (not simple-args?)
(not simple-ret?))))
(let [prim-call (-> (make-call (if const-args? arg-syms args-sym)
:allocator? false)
deserialize-prim)
non-prim-call (-> (make-call (if const-args? arg-syms args-sym)
:allocator? true)
deserialize-segment)]
`(if (mem/primitive-type ~ret-type-sym)
~(wrap-fn prim-call (not simple-args?))
~(wrap-fn non-prim-call true)))))))))
(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