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

add :raw-arrays? option

Browse source
This commit is contained in:
Kristin Rutenkolk 2024-10-30 20:28:20 +01:00
parent 69a99d5521
commit 56a0df3257
1 changed files with 49 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
src/clj/coffi/mem.clj
View file

@ -1573,6 +1573,12 @@
(pos? r) (conj [::padding [::padding (- strongest-alignment r)]])))))]
(assoc struct-spec 1 aligned-fields)))
(defmethod c-layout ::vector-array
[[_vector-array type count]]
(MemoryLayout/sequenceLayout
count
(c-layout type)))
(defn- typename->coffi-typename [_type]
(get
{'byte ::byte
@ -1592,9 +1598,11 @@
_type
(keyword (str *ns*) (str _type))))
(defn- coffitype->typename [_type]
(defn- coffitype->typename [_type raw-arrays?]
(cond
(and (vector? _type) (= ::array (first _type))) (get {::byte 'bytes
(and (vector? _type)
(= ::array (first _type))
raw-arrays?) (get {::byte 'bytes
::short 'shorts
::int 'ints
::long 'longs
@ -1602,6 +1610,9 @@
::float 'floats
::double 'doubles}
(second _type) 'objects)
(and (vector? _type)
(= ::array (first _type))
(not raw-arrays?)) `clojure.lang.IPersistentVector
:default (get {::byte 'byte
::short 'short
::int 'int
@ -1646,15 +1657,24 @@
(generate-deserialize
(second _type)
(+ offset (* (size-of (second _type)) index)))]
(list `aset gen-arr index (first deserialize-instructions))
#_(if true #_(vector? deserialize-instructions)
(list index (first deserialize-instructions))
(list index deserialize-instructions))
))
(list `aset gen-arr index (first deserialize-instructions))))
(range (second (rest _type))))
[gen-arr])]))
(defmethod generate-deserialize :coffi.mem/vector-array [_type offset]
(let [outer-code `(let [arr# (~(coffitype->array-fn (second _type)) ~(second (rest _type)))] arr# )
gen-arr (nth outer-code 2)]
[(concat (butlast outer-code)
(map
(fn [index]
(let [deserialize-instructions
(generate-deserialize
(second _type)
(+ offset (* (size-of (second _type)) index)))]
(list `aset gen-arr index (first deserialize-instructions))))
(range (second (rest _type))))
[(list `vec gen-arr)])]))
(defn typelist [typename fields]
(->>
(partition 2 2 (interleave (reductions + 0 (map (comp size-of second) fields)) fields))
@ -1669,8 +1689,7 @@
(generate-deserialize field-type (+ global-offset offset))))
(reduce concat)
(cons (symbol (str (name typename) ".")))
(list)
))))
(list)))))
(defmulti generate-serialize (fn [& xs] (if (vector? (first xs)) (first (first xs)) (first xs))))
@ -1694,6 +1713,16 @@
(+ offset (* (size-of member-type) index))))
(range length))))
(defmethod generate-serialize :coffi.mem/vector-array [[_arr member-type length] source-form offset]
(concat
(list `let ['array-obj source-form])
(map
(fn [index]
(generate-serialize member-type
(list `nth 'array-obj index)
(+ offset (* (size-of member-type) index))))
(range length))))
(defn register-new-struct-serialization [typename [_struct fields]]
(let [typelist (typelist typename fields)
fieldnames (filter #(not= ::padding %) (map first fields))]
@ -1951,7 +1980,7 @@
This creates needed serialization and deserialization implementations for the new type."
{:style/indent [:defn]}
[typename members]
[typename members & {:keys [raw-arrays?] :or {raw-arrays? true} :as opts}]
(let [invalid-typenames (filter #(try (c-layout (first %)) nil (catch Exception e (first %))) (partition 2 members))]
(cond
(odd? (count members)) (throw (Exception. "uneven amount of members supplied. members have to be typed and are required to be supplied in the form of `typename member-name`. the typename has to be coffi typename, like `:coffi.mem/int` or `[:coffi.mem/array :coffi.mem/byte 3]`"))
@ -1961,13 +1990,14 @@
typed-symbols (->>
members
(partition 2 2)
(map (fn [[_type sym]] (with-meta sym {:tag (coffitype->typename _type)})))
(map (fn [[_type sym]] (with-meta sym {:tag (coffitype->typename _type raw-arrays?)})))
(vec))
struct-layout (with-c-layout [::struct
(->>
members
(partition 2 2)
(map vec)
(clojure.walk/postwalk (if raw-arrays? identity #(if (= % ::array) ::vector-array %)))
(map #(update % 1 keyword))
(map reverse)
(map vec))])]