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

fix array handling for defstruct macro

Browse source
This commit is contained in:
Kristin Rutenkolk 2024-10-12 00:36:21 +02:00
parent eea1b43da3
commit f702096ed5
1 changed files with 43 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1593,15 +1593,35 @@
'float ::float 'float ::float
'double ::double 'double ::double
'bytes [::array ::byte] 'bytes [::array ::byte]
'shorts [::array ::byte] 'shorts [::array ::short]
'ints [::array ::byte] 'ints [::array ::int]
'longs [::array ::byte] 'longs [::array ::long]
'chars ::c-string 'chars ::c-string
'floats [::array ::byte] 'floats [::array ::float]
'doubles [::array ::byte]} 'doubles [::array ::double]}
_type _type
(keyword (str *ns*) (str _type)))) (keyword (str *ns*) (str _type))))
(defn- coffitype->typename [_type]
(cond
(and (vector? _type) (= ::array (first _type))) (get {::byte 'bytes
::short 'shorts
::int 'ints
::long 'longs
::char 'chars
::float 'floats
::double 'doubles}
(second _type) 'objects)
:default (get {::byte 'byte
::short 'short
::int 'int
::long 'long
::char 'char
::float 'float
::double 'double
::c-string 'String}
_type (keyword (str *ns*) (str _type)))))
(defn coffitype->array-fn [_type] (defn coffitype->array-fn [_type]
(get (get
{:coffi.mem/byte `byte-array {:coffi.mem/byte `byte-array
@ -1630,7 +1650,8 @@
(let [outer-code `(let [arr# (~(coffitype->array-fn (second _type)) ~(second (rest _type)))] arr# ) (let [outer-code `(let [arr# (~(coffitype->array-fn (second _type)) ~(second (rest _type)))] arr# )
gen-arr (nth outer-code 2)] gen-arr (nth outer-code 2)]
[(concat (butlast outer-code) [(concat (butlast outer-code)
[`aset gen-arr] (list
(concat [`aset gen-arr]
(reduce (reduce
concat concat
(map (map
@ -1642,7 +1663,7 @@
(if (vector? deserialize-instructions) (if (vector? deserialize-instructions)
(list index (first deserialize-instructions)) (list index (first deserialize-instructions))
(list index deserialize-instructions)))) (list index deserialize-instructions))))
(range (second (rest _type))))) (range (second (rest _type)))))))
[gen-arr])])) [gen-arr])]))
(defn typelist [typename fields] (defn typelist [typename fields]
@ -1695,27 +1716,25 @@
)))) ))))
(defmacro defstruct (defmacro defstruct
"Defines a struct type. all members need a type hint. "Defines a struct type. all members need to be supplied in pairs of `coffi-type member-name`.
This creates needed serialization and deserialization implementations for the This creates needed serialization and deserialization implementations for the new type."
aliased type."
{:style/indent [:defn]} {:style/indent [:defn]}
[typename members] [typename members]
(cond (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 `type member-name` (not via metadata on the symbols)")) (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]`"))
:else :else
(let [coffi-typename (keyword (str *ns*) (str typename)) (let [coffi-typename (keyword (str *ns*) (str typename))
typed-symbols (->> typed-symbols (->>
members members
(partition 2 2) (partition 2 2)
(map (fn [[hint sym]] (with-meta sym {:tag hint}))) (map (fn [[_type sym]] (with-meta sym {:tag (coffitype->typename _type)})))
(vec)) (vec))
struct-layout (with-c-layout [::struct struct-layout (with-c-layout [::struct
(->> (->>
members members
(partition 2 2) (partition 2 2)
(map vec) (map vec)
(map #(update % 0 typename->coffi-typename))
(map #(update % 1 keyword)) (map #(update % 1 keyword))
(map reverse) (map reverse)
(map vec))])] (map vec))])]