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

Use a once-only impl rather than with-typehints

Browse source 
Signed-off-by: Kristin Rutenkolk <kristin.rutenkolk@hhu.de>
This commit is contained in:
Joshua Suskalo 2025-01-01 16:51:22 -05:00 committed by Kristin Rutenkolk
parent 51dfbc39ed
commit d763b39b51
1 changed files with 95 additions and 141 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -284,16 +284,23 @@
"The alignment in bytes of a c-sized pointer." "The alignment in bytes of a c-sized pointer."
(.byteAlignment pointer-layout)) (.byteAlignment pointer-layout))
(defmacro with-typehints [bindings form] (def ^:private primitive-tag?
(let [bindmap (->> bindings '#{byte bytes short shorts int ints long longs
(partition 3) float floats double doubles
(map (fn [[sym src hint]] [sym (with-meta (gensym (str (name sym))) {:src-expr src :tag (symbol (str (name hint)))})])) bool bools char chars})
(into (hash-map)))
letbinds (->> bindmap (defmacro once-only
(map (fn [[_ newsym]] [(with-meta newsym {}) (:src-expr (meta newsym))])) {:style/indent [:defn]
(reduce concat) :private true}
(vec))] [[& names] & body]
`(let ~letbinds ~(clojure.walk/postwalk (fn [x] (get bindmap x x)) form)))) (let [gensyms (repeatedly (count names) gensym)]
`(let [~@(interleave gensyms (repeat (count names) `(gensym)))]
`(let [~~@(mapcat #(-> (if (primitive-tag? (:tag (meta %2)))
[%1 ``(~'~(:tag (meta %2)) ~~%2)]
[`(with-meta ~%1 {:tag '~(:tag (meta %2))}) %2]))
gensyms names)]
~(let [~@(mapcat #(-> [(with-meta %1 {}) %2]) names gensyms)]
~@body)))))
(defn read-byte (defn read-byte
"Reads a [[byte]] from the `segment`, at an optional `offset`." "Reads a [[byte]] from the `segment`, at an optional `offset`."
@ -473,14 +480,11 @@
{:inline {:inline
(fn write-byte-inline (fn write-byte-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^byte value]
value ~value byte] `(.set ~segment ^ValueLayout$OfByte byte-layout 0 ~value)))
(.set segment ^ValueLayout$OfByte byte-layout 0 value)))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^byte value]
offset ~offset long `(.set ~segment ^ValueLayout$OfByte byte-layout ~offset ~value))))}
value ~value byte]
(.set segment ^ValueLayout$OfByte byte-layout offset value))))}
([^MemorySegment segment value] ([^MemorySegment segment value]
(.set segment ^ValueLayout$OfByte byte-layout 0 ^byte value)) (.set segment ^ValueLayout$OfByte byte-layout 0 ^byte value))
([^MemorySegment segment ^long offset value] ([^MemorySegment segment ^long offset value]
@ -493,20 +497,15 @@
{:inline {:inline
(fn write-short-inline (fn write-short-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^short value]
value ~value short] `(.set ~segment ^ValueLayout$OfShort short-layout 0 ~value)))
(.set segment ^ValueLayout$OfShort short-layout 0 value)))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^short value]
offset ~offset long `(.set ~segment ^ValueLayout$OfShort short-layout ~offset ~value)))
value ~value short]
(.set segment ^ValueLayout$OfShort short-layout offset value)))
([segment offset byte-order value] ([segment offset byte-order value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset
offset ~offset long ^java.nio.ByteOrder byte-order ^short value]
byte-order ~byte-order java.nio.ByteOrder `(.set ~segment (.withOrder ^ValueLayout$OfShort short-layout ~byte-order) ~offset ~value))))}
value ~value short]
(.set segment (.withOrder ^ValueLayout$OfShort short-layout byte-order) offset value))))}
([^MemorySegment segment value] ([^MemorySegment segment value]
(.set segment ^ValueLayout$OfShort short-layout 0 ^short value)) (.set segment ^ValueLayout$OfShort short-layout 0 ^short value))
([^MemorySegment segment ^long offset value] ([^MemorySegment segment ^long offset value]
@ -521,20 +520,15 @@
{:inline {:inline
(fn write-int-inline (fn write-int-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^int value]
value ~value int] `(.set ~segment ^ValueLayout$OfInt int-layout 0 ~value)))
(.set segment ^ValueLayout$OfInt int-layout 0 value)))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^int value]
offset ~offset long `(.set ~segment ^ValueLayout$OfInt int-layout ~offset ~value)))
value ~value int]
(.set segment ^ValueLayout$OfInt int-layout offset value)))
([segment offset byte-order value] ([segment offset byte-order value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset
offset ~offset long ^java.nio.ByteOrder byte-order ^int value]
byte-order ~byte-order java.nio.ByteOrder `(.set ~segment (.withOrder ^ValueLayout$OfInt int-layout ~byte-order) ~offset ~value))))}
value ~value int]
(.set segment (.withOrder ^ValueLayout$OfInt int-layout byte-order) offset value))))}
([^MemorySegment segment value] ([^MemorySegment segment value]
(.set segment ^ValueLayout$OfInt int-layout 0 ^int value)) (.set segment ^ValueLayout$OfInt int-layout 0 ^int value))
([^MemorySegment segment ^long offset value] ([^MemorySegment segment ^long offset value]
@ -549,20 +543,15 @@
{:inline {:inline
(fn write-long-inline (fn write-long-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long value]
value ~value long] `(.set ~segment ^ValueLayout$OfLong long-layout 0 ~value)))
(.set segment ^ValueLayout$OfLong long-layout 0 value)))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^long value]
offset ~offset long `(.set ~segment ^ValueLayout$OfLong long-layout ~offset ~value)))
value ~value long]
(.set segment ^ValueLayout$OfLong long-layout offset value)))
([segment offset byte-order value] ([segment offset byte-order value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset
offset ~offset long ^java.nio.ByteOrder byte-order ^long value]
byte-order ~byte-order java.nio.ByteOrder `(.set ~segment (.withOrder ^ValueLayout$OfLong long-layout ~byte-order) ~offset ~value))))}
value ~value long]
(.set segment (.withOrder ^ValueLayout$OfLong long-layout byte-order) offset value))))}
(^long [^MemorySegment segment ^long value] (^long [^MemorySegment segment ^long value]
(.set segment ^ValueLayout$OfLong long-layout 0 value)) (.set segment ^ValueLayout$OfLong long-layout 0 value))
(^long [^MemorySegment segment ^long offset ^long value] (^long [^MemorySegment segment ^long offset ^long value]
@ -575,14 +564,11 @@
{:inline {:inline
(fn write-char-inline (fn write-char-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^char value]
value ~value char] `(.set ~segment ^ValueLayout$OfByte byte-layout 0 (unchecked-byte (unchecked-int ~value)))))
(.set segment ^ValueLayout$OfByte byte-layout 0 (unchecked-byte (unchecked-int value)))))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^char value]
offset ~offset long `(.set ~segment ^ValueLayout$OfByte byte-layout ~offset (unchecked-byte (unchecked-int ~value))))))}
value ~value char]
(.set segment ^ValueLayout$OfByte byte-layout offset (unchecked-byte (unchecked-int value))))))}
([^MemorySegment segment value] ([^MemorySegment segment value]
(.set (.set
segment segment
@ -601,20 +587,15 @@
{:inline {:inline
(fn write-float-inline (fn write-float-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^float value]
value ~value float] `(.set ~segment ^ValueLayout$OfFloat float-layout 0 ~value)))
(.set segment ^ValueLayout$OfFloat float-layout 0 value)))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^float value]
offset ~offset long `(.set ~segment ^ValueLayout$OfFloat float-layout ~offset ~value)))
value ~value float]
(.set segment ^ValueLayout$OfFloat float-layout offset value)))
([segment offset byte-order value] ([segment offset byte-order value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset
offset ~offset long ^java.nio.ByteOrder byte-order ^float value]
byte-order ~byte-order java.nio.ByteOrder `(.set ~segment (.withOrder ^ValueLayout$OfFloat float-layout ~byte-order) ~offset ~value))))}
value ~value float]
(.set segment (.withOrder ^ValueLayout$OfFloat float-layout byte-order) offset value))))}
([^MemorySegment segment value] ([^MemorySegment segment value]
(.set segment ^ValueLayout$OfFloat float-layout 0 ^float value)) (.set segment ^ValueLayout$OfFloat float-layout 0 ^float value))
([^MemorySegment segment ^long offset value] ([^MemorySegment segment ^long offset value]
@ -629,20 +610,15 @@
{:inline {:inline
(fn write-double-inline (fn write-double-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^double value]
value ~value double] `(.set ~segment ^ValueLayout$OfDouble double-layout 0 ~value)))
(.set segment ^ValueLayout$OfDouble double-layout 0 value)))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^double value]
offset ~offset long `(.set ~segment ^ValueLayout$OfDouble double-layout ~offset ~value)))
value ~value double]
(.set segment ^ValueLayout$OfDouble double-layout offset value)))
([segment offset byte-order value] ([segment offset byte-order value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset
offset ~offset long ^java.nio.ByteOrder byte-order ^double value]
byte-order ~byte-order java.nio.ByteOrder `(.set ~segment (.withOrder ^ValueLayout$OfDouble double-layout ~byte-order) ~offset ~value))))}
value ~value double]
(.set segment (.withOrder ^ValueLayout$OfDouble double-layout byte-order) offset value))))}
(^double [^MemorySegment segment ^double value] (^double [^MemorySegment segment ^double value]
(.set segment ^ValueLayout$OfDouble double-layout 0 value)) (.set segment ^ValueLayout$OfDouble double-layout 0 value))
(^double [^MemorySegment segment ^long offset ^double value] (^double [^MemorySegment segment ^long offset ^double value]
@ -655,14 +631,13 @@
{:inline {:inline
(fn write-address-inline (fn write-address-inline
([segment value] ([segment value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment
value ~value java.lang.foreign.MemorySegment] ^java.lang.foreign.MemorySegment value]
(.set segment ^AddressLayout pointer-layout 0 value))) `(.set ~segment ^AddressLayout pointer-layout 0 ~value)))
([segment offset value] ([segment offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset
offset ~offset long ^java.lang.foreign.MemorySegment value]
value ~value java.lang.foreign.MemorySegment] `(.set ~segment ^AddressLayout pointer-layout ~offset ~value))))}
(.set segment ^AddressLayout pointer-layout offset value))))}
([^MemorySegment segment ^MemorySegment value] ([^MemorySegment segment ^MemorySegment value]
(.set segment ^AddressLayout pointer-layout 0 value)) (.set segment ^AddressLayout pointer-layout 0 value))
([^MemorySegment segment ^long offset ^MemorySegment value] ([^MemorySegment segment ^long offset ^MemorySegment value]
@ -673,14 +648,11 @@
{:inline {:inline
(fn write-bytes-inline (fn write-bytes-inline
([segment n value] ([segment n value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^bytes value]
value ~value bytes] `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfByte byte-layout 0 ~n)))
(MemorySegment/copy value 0 segment ^ValueLayout$OfByte byte-layout 0 ~n)))
([segment n offset value] ([segment n offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^bytes value]
offset ~offset long `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfByte byte-layout ~offset ~n))))}
value ~value bytes]
(MemorySegment/copy value 0 segment ^ValueLayout$OfByte byte-layout offset ~n))))}
([^MemorySegment segment n ^bytes value] ([^MemorySegment segment n ^bytes value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfByte byte-layout 0 ^int n)) (MemorySegment/copy value 0 segment ^ValueLayout$OfByte byte-layout 0 ^int n))
([^MemorySegment segment n offset ^bytes value] ([^MemorySegment segment n offset ^bytes value]
@ -693,14 +665,11 @@
{:inline {:inline
(fn write-shorts-inline (fn write-shorts-inline
([segment n value] ([segment n value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^shorts value]
value ~value shorts] `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfShort short-layout 0 ~n)))
(MemorySegment/copy value 0 segment ^ValueLayout$OfShort short-layout 0 ~n)))
([segment n offset value] ([segment n offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^shorts value]
offset ~offset long `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfShort short-layout ~offset ~n))))}
value ~value shorts]
(MemorySegment/copy value 0 segment ^ValueLayout$OfShort short-layout offset ~n))))}
([^MemorySegment segment n ^shorts value] ([^MemorySegment segment n ^shorts value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfShort short-layout 0 ^int n)) (MemorySegment/copy value 0 segment ^ValueLayout$OfShort short-layout 0 ^int n))
([^MemorySegment segment n ^long offset ^shorts value] ([^MemorySegment segment n ^long offset ^shorts value]
@ -713,14 +682,11 @@
{:inline {:inline
(fn write-ints-inline (fn write-ints-inline
([segment n value] ([segment n value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^ints value]
value ~value ints] `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfInt int-layout 0 ~n)))
(MemorySegment/copy value 0 segment ^ValueLayout$OfInt int-layout 0 ~n)))
([segment n offset value] ([segment n offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^ints value]
offset ~offset long `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfInt int-layout ~offset ~n))))}
value ~value ints]
(MemorySegment/copy value 0 segment ^ValueLayout$OfInt int-layout offset ~n))))}
([^MemorySegment segment n ^ints value] ([^MemorySegment segment n ^ints value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfInt int-layout 0 ^int n)) (MemorySegment/copy value 0 segment ^ValueLayout$OfInt int-layout 0 ^int n))
([^MemorySegment segment n ^long offset ^ints value] ([^MemorySegment segment n ^long offset ^ints value]
@ -733,14 +699,11 @@
{:inline {:inline
(fn write-longs-inline (fn write-longs-inline
([segment n value] ([segment n value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^longs value]
value ~value longs] `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfLong long-layout 0 ~n)))
(MemorySegment/copy value 0 segment ^ValueLayout$OfLong long-layout 0 ~n)))
([segment n offset value] ([segment n offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^longs value]
offset ~offset long `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfLong long-layout ~offset ~n))))}
value ~value longs]
(MemorySegment/copy value 0 segment ^ValueLayout$OfLong long-layout offset ~n))))}
([^MemorySegment segment n ^longs value] ([^MemorySegment segment n ^longs value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfLong long-layout 0 ^int n)) (MemorySegment/copy value 0 segment ^ValueLayout$OfLong long-layout 0 ^int n))
([^MemorySegment segment n ^long offset ^longs value] ([^MemorySegment segment n ^long offset ^longs value]
@ -753,14 +716,11 @@
{:inline {:inline
(fn write-chars-inline (fn write-chars-inline
([segment n value] ([segment n value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^chars value]
value ~value chars] `(MemorySegment/copy (bytes (byte-array (map unchecked-int ~value))) 0 ~segment ^ValueLayout$OfChar char-layout 0 ~n)))
(MemorySegment/copy (bytes (byte-array (map unchecked-int value))) 0 segment ^ValueLayout$OfChar char-layout 0 ~n)))
([segment n offset value] ([segment n offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^chars value]
offset ~offset long `(MemorySegment/copy (bytes (byte-array (map unchecked-int ~value))) 0 ~segment ^ValueLayout$OfChar char-layout ~offset ~n))))}
value ~value chars]
(MemorySegment/copy (bytes (byte-array (map unchecked-int value))) 0 segment ^ValueLayout$OfChar char-layout offset ~n))))}
([^MemorySegment segment n ^chars value] ([^MemorySegment segment n ^chars value]
(MemorySegment/copy (bytes (byte-array (map unchecked-int value))) 0 segment ^ValueLayout$OfChar char-layout 0 ^int n)) (MemorySegment/copy (bytes (byte-array (map unchecked-int value))) 0 segment ^ValueLayout$OfChar char-layout 0 ^int n))
([^MemorySegment segment n ^long offset ^chars value] ([^MemorySegment segment n ^long offset ^chars value]
@ -773,14 +733,11 @@
{:inline {:inline
(fn write-floats-inline (fn write-floats-inline
([segment n value] ([segment n value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^floats value]
value ~value floats] `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfFloat float-layout 0 ~n)))
(MemorySegment/copy value 0 segment ^ValueLayout$OfFloat float-layout 0 ~n)))
([segment n offset value] ([segment n offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^floats value]
offset ~offset long `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfFloat float-layout ~offset ~n))))}
value ~value floats]
(MemorySegment/copy value 0 segment ^ValueLayout$OfFloat float-layout offset ~n))))}
([^MemorySegment segment n ^floats value] ([^MemorySegment segment n ^floats value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfFloat float-layout 0 ^int n)) (MemorySegment/copy value 0 segment ^ValueLayout$OfFloat float-layout 0 ^int n))
([^MemorySegment segment n ^long offset ^floats value] ([^MemorySegment segment n ^long offset ^floats value]
@ -793,14 +750,11 @@
{:inline {:inline
(fn write-doubles-inline (fn write-doubles-inline
([segment n value] ([segment n value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^doubles value]
value ~value doubles] `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfDouble double-layout 0 ~n)))
(MemorySegment/copy value 0 segment ^ValueLayout$OfDouble double-layout 0 ~n)))
([segment n offset value] ([segment n offset value]
`(with-typehints [segment ~segment java.lang.foreign.MemorySegment (once-only [^java.lang.foreign.MemorySegment segment ^long offset ^doubles value]
offset ~offset long `(MemorySegment/copy ~value 0 ~segment ^ValueLayout$OfDouble double-layout ~offset ~n))))}
value ~value doubles]
(MemorySegment/copy value 0 segment ^ValueLayout$OfDouble double-layout offset ~n))))}
([^MemorySegment segment n ^doubles value] ([^MemorySegment segment n ^doubles value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfDouble double-layout 0 ^int n)) (MemorySegment/copy value 0 segment ^ValueLayout$OfDouble double-layout 0 ^int n))
([^MemorySegment segment n ^long offset ^doubles value] ([^MemorySegment segment n ^long offset ^doubles value]
@ -1326,7 +1280,7 @@
(defmethod serialize-into ::byte (defmethod serialize-into ::byte
[obj _type segment _arena] [obj _type segment _arena]
(write-byte segment (byte obj))) (write-byte segment obj))
(defmethod serialize-into ::short (defmethod serialize-into ::short
[obj type segment _arena] [obj type segment _arena]