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

add serialization generation

Browse source
This commit is contained in:
Kristin Rutenkolk 2024-10-11 17:48:58 +02:00
parent c5d18e9e50
commit 37b74fc638
1 changed files with 19 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1645,10 +1645,13 @@
(range (second (rest _type)))))
[gen-arr])]))
(defn register-new-struct-deserialization [typename [_struct fields]]
(let [typelist (->>
(defn typelist [typename fields]
(->>
(partition 2 2 (interleave (reductions + 0 (map (comp size-of second) fields)) fields))
(filter (fn [[_ [_ field-type]]] (not (and (vector? field-type) (= ::padding (first field-type)))))))]
(filter (fn [[_ [_ field-type]]] (not (and (vector? field-type) (= ::padding (first field-type))))))))
(defn register-new-struct-deserialization [typename [_struct fields]]
(let [typelist (typelist typename fields)]
(defmethod generate-deserialize typename [_type global-offset]
(->> typelist
(map-indexed
@ -1658,7 +1661,6 @@
(cons (symbol (str (name typename) ".")))
))))
(defmulti generate-serialize (fn [& xs] (if (vector? (first xs)) (first (first xs)) (first xs))))
(defmethod generate-serialize :coffi.mem/byte [_type source-form offset] `(write-byte ~'segment ~offset ~source-form))
@ -1680,6 +1682,16 @@
(+ 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))]
(defmethod generate-serialize typename [_type source-form global-offset]
(->> typelist
(map-indexed
(fn [index [offset [_ field-type]]]
(generate-serialize field-type (list (symbol (str "." (name (nth fieldnames index)))) source-form) (+ global-offset offset))))
(cons `do)))))
(defmacro defstruct
"Defines a struct type. all members need a type hint.
@ -1706,11 +1718,14 @@
(map reverse)
(map vec))])]
(register-new-struct-deserialization coffi-typename struct-layout)
(register-new-struct-serialization coffi-typename struct-layout)
`(do
(defrecord ~typename ~typed-symbols)
(defmethod c-layout ~coffi-typename [~'_] ~struct-layout)
(defmethod deserialize-from ~coffi-typename ~['segment '_type]
~(generate-deserialize coffi-typename 0))
(defmethod serialize-into ~coffi-typename ~[(with-meta 'source-obj {:tag typename}) '_type 'segment '_]
~(generate-serialize coffi-typename (with-meta 'source-obj {:tag typename}) 0))
)
)
)