2020-02-16 23:15:54 +03:00
|
|
|
(system-include "carp_binary.h")
|
2020-02-18 00:04:09 +03:00
|
|
|
(load "StdInt.carp")
|
2020-02-16 23:15:54 +03:00
|
|
|
|
2020-02-18 19:41:29 +03:00
|
|
|
;; Helper functions for making working with Maybe easier
|
|
|
|
;; TODO: Replace all of these with a single type-generic
|
|
|
|
;; zip-n macro.
|
|
|
|
(defmodule Maybe
|
|
|
|
(defn zip [f a b]
|
|
|
|
(match a
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just x)
|
|
|
|
(match b
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just y) (Just (~f x y)))))
|
|
|
|
|
|
|
|
(defn zip4 [f a b c d]
|
|
|
|
(match a
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just x)
|
|
|
|
(match b
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just y)
|
|
|
|
(match c
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just z)
|
|
|
|
(match d
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just x2) (Just (~f x y z x2)))))))
|
|
|
|
|
|
|
|
(defn zip8 [f a b c d e a1 b1 c1]
|
|
|
|
(match a
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just x)
|
|
|
|
(match b
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just y)
|
|
|
|
(match c
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just z)
|
|
|
|
(match d
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just x2)
|
|
|
|
(match e
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just y2)
|
|
|
|
(match a1
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just z2)
|
|
|
|
(match b1
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just x3)
|
|
|
|
(match c1
|
|
|
|
(Maybe.Nothing) (Maybe.Nothing)
|
|
|
|
(Just y3) (Just (~f x y z x2 y2 z2 x3 y3)))))))))))
|
|
|
|
)
|
|
|
|
|
2020-02-16 23:15:54 +03:00
|
|
|
(defmodule Binary
|
2020-02-18 03:03:52 +03:00
|
|
|
(doc Order
|
|
|
|
"The type of byte orders.
|
2020-02-16 23:15:54 +03:00
|
|
|
|
|
|
|
LittleEndian designates the little endian ordering, and indicates the least
|
|
|
|
significant byte appears first in a given byte sequence.
|
|
|
|
|
|
|
|
BigEndian designates the big endian ordering, and indicates the most
|
|
|
|
significant byte occurs first in a given byte sequence.")
|
|
|
|
(deftype Order LittleEndian BigEndian)
|
|
|
|
|
2020-02-18 00:04:09 +03:00
|
|
|
(register to-int16 (λ [Byte Byte] Uint16))
|
|
|
|
(register to-int32 (λ [Byte Byte Byte Byte] Uint32))
|
|
|
|
(register to-int64 (λ [Byte Byte Byte Byte Byte Byte Byte Byte] Uint64))
|
2020-02-18 21:35:35 +03:00
|
|
|
(register int16-to-byte (λ [(Ref Uint16)] Byte))
|
|
|
|
(register int32-to-byte (λ [(Ref Uint32)] Byte))
|
|
|
|
(register int64-to-byte (λ [(Ref Uint64)] Byte))
|
2020-02-17 23:38:55 +03:00
|
|
|
(register system-endianness-internal (λ [] Int))
|
|
|
|
|
2020-02-18 03:03:52 +03:00
|
|
|
(doc system-endianness
|
2020-02-18 00:04:09 +03:00
|
|
|
"Returns the endianness of the host system.")
|
2020-02-17 23:38:55 +03:00
|
|
|
(sig system-endianness (λ [] Order))
|
2020-02-18 03:03:52 +03:00
|
|
|
(defn system-endianness []
|
2020-02-17 23:38:55 +03:00
|
|
|
(if (= (system-endianness-internal) 1)
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(Order.BigEndian)))
|
2020-02-16 23:15:54 +03:00
|
|
|
|
2020-02-18 21:56:52 +03:00
|
|
|
(doc unsafe-bytes->int16
|
2020-02-18 19:50:24 +03:00
|
|
|
"Interprets the first two bytes in a byte sequence as an Uint16 value.
|
2020-02-16 23:15:54 +03:00
|
|
|
**This operation is unsafe.**")
|
2020-02-18 21:56:52 +03:00
|
|
|
(sig unsafe-bytes->int16 (Fn [Order (Ref (Array Byte) a)] Uint16))
|
|
|
|
(defn unsafe-bytes->int16 [order bs]
|
2020-02-18 03:03:52 +03:00
|
|
|
(match order
|
2020-02-18 00:04:09 +03:00
|
|
|
(Order.LittleEndian)
|
|
|
|
(to-int16 @(Array.unsafe-nth bs 0) @(Array.unsafe-nth bs 1))
|
|
|
|
(Order.BigEndian)
|
2020-02-16 23:15:54 +03:00
|
|
|
(to-int16 @(Array.unsafe-nth bs 1) @(Array.unsafe-nth bs 0))))
|
|
|
|
|
2020-02-18 19:41:29 +03:00
|
|
|
(doc bytes->int16
|
2020-02-18 19:50:24 +03:00
|
|
|
"Interprets the first two bytes in a byte sequence as an Uint16 value.
|
2020-02-18 19:41:29 +03:00
|
|
|
|
|
|
|
If the first two bytes are inaccessible, or the given array contains less
|
|
|
|
than two bytes, returns Maybe.Nothing.")
|
|
|
|
(sig bytes->int16 (Fn [Order (Ref (Array Byte) a)] (Maybe Uint16)))
|
|
|
|
(defn bytes->int16 [order bytes]
|
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(Maybe.zip &to-int16 (Array.nth bytes 0) (Array.nth bytes 1))
|
|
|
|
(Order.BigEndian)
|
|
|
|
(Maybe.zip &to-int16 (Array.nth bytes 1) (Array.nth bytes 0))))
|
|
|
|
|
2020-02-18 21:35:35 +03:00
|
|
|
(doc int16->bytes
|
|
|
|
"Converts a Uint16 to a sequence of bytes representing the value using the provided `order`")
|
|
|
|
(sig int16->bytes (Fn [Order Uint16] (Array Byte)))
|
|
|
|
(defn int16->bytes [order i]
|
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(Array.copy-map &int16-to-byte &[i (Uint16.bit-shift-right i (Uint16.from-long 8l))])
|
|
|
|
(Order.BigEndian)
|
|
|
|
(Array.copy-map &int16-to-byte &[(Uint16.bit-shift-right i (Uint16.from-long 8l)) i])))
|
|
|
|
|
2020-02-18 21:56:52 +03:00
|
|
|
(doc unsafe-bytes->int16-seq
|
2020-02-18 21:50:07 +03:00
|
|
|
"Interprets a sequence of bytes as a sequence of Uint16 values.
|
|
|
|
**This operation is unsafe.**")
|
2020-02-18 21:56:52 +03:00
|
|
|
(sig unsafe-bytes->int16-seq (Fn [Order (Ref (Array Byte) a)] (Array Uint16)))
|
|
|
|
(defn unsafe-bytes->int16-seq [order bs]
|
2020-02-18 21:50:07 +03:00
|
|
|
(let [partitions (Array.partition bs 2)
|
2020-02-18 21:56:52 +03:00
|
|
|
f (fn [b] (unsafe-bytes->int16 order b))]
|
2020-02-18 21:50:07 +03:00
|
|
|
(Array.copy-map &f &partitions)))
|
|
|
|
|
|
|
|
(doc bytes->int16-seq
|
|
|
|
"Interprets a sequence of bytes as a sequence of Uint16 values.
|
|
|
|
|
|
|
|
If a segment of bytes cannot be interpreted as an Uint16, returns Maybe.Nothing.")
|
|
|
|
(sig bytes->int16-seq (Fn [Order (Ref (Array Byte) a)] (Array (Maybe Uint16))))
|
|
|
|
(defn bytes->int16-seq [order bs]
|
|
|
|
(let [partitions (Array.partition bs 2)
|
|
|
|
f (fn [b] (bytes->int16 order b))]
|
|
|
|
(Array.copy-map &f &partitions)))
|
|
|
|
|
|
|
|
(doc int16-seq->bytes
|
|
|
|
"Converts an array of Uint16 values into byte sequences.")
|
|
|
|
(sig int16-seq->bytes (Fn [Order (Ref (Array Uint16) a)] (Array (Array Byte))))
|
|
|
|
(defn int16-seq->bytes [order is]
|
|
|
|
(let [f (fn [i] (int16->bytes order @i))]
|
|
|
|
(Array.copy-map &f is)))
|
|
|
|
|
2020-02-18 21:56:52 +03:00
|
|
|
(doc unsafe-bytes->int32
|
2020-02-18 19:50:24 +03:00
|
|
|
"Interprets the first four bytes in a byte sequence as an Uint32 value.
|
2020-02-16 23:15:54 +03:00
|
|
|
**This operation is unsafe.**")
|
2020-02-18 21:56:52 +03:00
|
|
|
(sig unsafe-bytes->int32 (Fn [Order (Ref (Array Byte))] Uint32))
|
|
|
|
(defn unsafe-bytes->int32 [order bs]
|
2020-02-18 03:03:52 +03:00
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(to-int32 @(Array.unsafe-nth bs 0) @(Array.unsafe-nth bs 1)
|
|
|
|
@(Array.unsafe-nth bs 2) @(Array.unsafe-nth bs 3))
|
|
|
|
(Order.BigEndian)
|
2020-02-16 23:15:54 +03:00
|
|
|
(to-int32 @(Array.unsafe-nth bs 3) @(Array.unsafe-nth bs 2)
|
|
|
|
@(Array.unsafe-nth bs 1) @(Array.unsafe-nth bs 0))))
|
|
|
|
|
2020-02-18 19:41:29 +03:00
|
|
|
(doc bytes->int32
|
2020-02-18 19:50:24 +03:00
|
|
|
"Interprets the first four bytes in a byte sequence as an Uint32 value.
|
2020-02-18 19:41:29 +03:00
|
|
|
|
|
|
|
If the first four bytes are inaccessible, or the given array contains less
|
|
|
|
than four bytes, returns Maybe.Nothing.")
|
|
|
|
(sig bytes->int32 (Fn [Order (Ref (Array Byte))] (Maybe Uint32)))
|
|
|
|
(defn bytes->int32 [order bs]
|
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(Maybe.zip4 &to-int32 (Array.nth bs 0) (Array.nth bs 1)
|
|
|
|
(Array.nth bs 2) (Array.nth bs 3))
|
|
|
|
(Order.BigEndian)
|
|
|
|
(Maybe.zip4 &to-int32 (Array.nth bs 3) (Array.nth bs 2)
|
|
|
|
(Array.nth bs 1) (Array.nth bs 0))))
|
|
|
|
|
2020-02-18 21:35:35 +03:00
|
|
|
(doc int32->bytes
|
|
|
|
"Converts a Uint32 to a sequence of bytes representing the value using the provided `order`")
|
|
|
|
(sig int32->bytes (Fn [Order Uint32] (Array Byte)))
|
|
|
|
(defn int32->bytes [order i]
|
|
|
|
(let [shift (fn [lng] (Uint32.bit-shift-right i (Uint32.from-long lng)))]
|
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(Array.copy-map &int32-to-byte
|
|
|
|
&[i (shift 8l) (shift 16l) (shift 24l)])
|
|
|
|
(Order.BigEndian)
|
|
|
|
(Array.copy-map &int32-to-byte
|
|
|
|
&[(shift 24l) (shift 16l) (shift 8l) i]))))
|
|
|
|
|
2020-02-18 21:56:52 +03:00
|
|
|
(doc unsafe-bytes->int32-seq
|
2020-02-18 21:50:07 +03:00
|
|
|
"Interprets a sequence of bytes as a sequence of Uint32 values.
|
|
|
|
**This operation is unsafe.**")
|
2020-02-18 21:56:52 +03:00
|
|
|
(sig unsafe-bytes->int32-seq (Fn [Order (Ref (Array Byte) a)] (Array Uint32)))
|
|
|
|
(defn unsafe-bytes->int32-seq [order bs]
|
2020-02-18 21:50:07 +03:00
|
|
|
(let [partitions (Array.partition bs 4)
|
2020-02-18 21:56:52 +03:00
|
|
|
f (fn [b] (unsafe-bytes->int32 order b))]
|
2020-02-18 21:50:07 +03:00
|
|
|
(Array.copy-map &f &partitions)))
|
|
|
|
|
|
|
|
(doc bytes->int32-seq
|
|
|
|
"Interprets a sequence of bytes as a sequence of Uint32 values.
|
|
|
|
|
|
|
|
If a segment of bytes cannot be interpreted as an Uint32, returns Maybe.Nothing.")
|
|
|
|
(sig bytes->int32-seq (Fn [Order (Ref (Array Byte) a)] (Array (Maybe Uint32))))
|
|
|
|
(defn bytes->int32-seq [order bs]
|
|
|
|
(let [partitions (Array.partition bs 4)
|
|
|
|
f (fn [b] (bytes->int32 order b))]
|
|
|
|
(Array.copy-map &f &partitions)))
|
|
|
|
|
|
|
|
(doc int32-seq->bytes
|
|
|
|
"Converts an array of Uint32 values into byte sequences.")
|
|
|
|
(sig int32-seq->bytes (Fn [Order (Ref (Array Uint32) a)] (Array (Array Byte))))
|
|
|
|
(defn int32-seq->bytes [order is]
|
|
|
|
(let [f (fn [i] (int32->bytes order @i))]
|
|
|
|
(Array.copy-map &f is)))
|
|
|
|
|
2020-02-18 21:56:52 +03:00
|
|
|
(doc unsafe-bytes->int64
|
2020-02-18 19:50:24 +03:00
|
|
|
"Interprets the first eight bytes in a byte sequence as an Uint64 value.
|
2020-02-16 23:15:54 +03:00
|
|
|
**This operation is unsafe.**")
|
2020-02-18 21:56:52 +03:00
|
|
|
(sig unsafe-bytes->int64 (Fn [Order (Ref (Array Byte) a)] Uint64))
|
|
|
|
(defn unsafe-bytes->int64 [order bs]
|
2020-02-18 03:03:52 +03:00
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(to-int64 @(Array.unsafe-nth bs 0) @(Array.unsafe-nth bs 1)
|
2020-02-16 23:15:54 +03:00
|
|
|
@(Array.unsafe-nth bs 2) @(Array.unsafe-nth bs 3)
|
|
|
|
@(Array.unsafe-nth bs 4) @(Array.unsafe-nth bs 5)
|
|
|
|
@(Array.unsafe-nth bs 6) @(Array.unsafe-nth bs 7))
|
2020-02-18 03:03:52 +03:00
|
|
|
(Order.BigEndian)
|
2020-02-16 23:15:54 +03:00
|
|
|
(to-int64 @(Array.unsafe-nth bs 7) @(Array.unsafe-nth bs 6)
|
|
|
|
@(Array.unsafe-nth bs 5) @(Array.unsafe-nth bs 4)
|
|
|
|
@(Array.unsafe-nth bs 3) @(Array.unsafe-nth bs 2)
|
|
|
|
@(Array.unsafe-nth bs 1) @(Array.unsafe-nth bs 0))))
|
2020-02-18 03:03:52 +03:00
|
|
|
|
2020-02-18 19:41:29 +03:00
|
|
|
(doc bytes->int64
|
2020-02-18 19:50:24 +03:00
|
|
|
"Interprets the first eight bytes in a byte sequence as an Uint64 value.
|
2020-02-18 19:41:29 +03:00
|
|
|
|
|
|
|
If the first eight bytes are inaccessible, or the given array contains less
|
|
|
|
than eight bytes, returns Maybe.Nothing.")
|
|
|
|
(sig bytes->int64 (Fn [Order (Ref (Array Byte) a)] (Maybe Uint64)))
|
|
|
|
(defn bytes->int64 [order bs]
|
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(Maybe.zip8 &to-int64 (Array.nth bs 0) (Array.nth bs 1)
|
|
|
|
(Array.nth bs 2) (Array.nth bs 3)
|
|
|
|
(Array.nth bs 4) (Array.nth bs 5)
|
|
|
|
(Array.nth bs 6) (Array.nth bs 7))
|
|
|
|
(Order.BigEndian)
|
|
|
|
(Maybe.zip8 &to-int64 (Array.nth bs 7) (Array.nth bs 6)
|
|
|
|
(Array.nth bs 5) (Array.nth bs 4)
|
|
|
|
(Array.nth bs 3) (Array.nth bs 2)
|
|
|
|
(Array.nth bs 1) (Array.nth bs 0))))
|
2020-02-18 21:35:35 +03:00
|
|
|
(doc int64->bytes
|
|
|
|
"Converts a Uint64 to a sequence of bytes representing the value using the provided `order`")
|
|
|
|
(sig int64->bytes (Fn [Order Uint64] (Array Byte)))
|
|
|
|
(defn int64->bytes [order i]
|
|
|
|
(let [shift (fn [lng] (Uint64.bit-shift-right i (Uint64.from-long lng)))]
|
|
|
|
(match order
|
|
|
|
(Order.LittleEndian)
|
|
|
|
(Array.copy-map &int64-to-byte
|
|
|
|
&[i (shift 8l) (shift 16l)
|
|
|
|
(shift 24l) (shift 32l)
|
|
|
|
(shift 40l) (shift 48l) (shift 56l)])
|
|
|
|
(Order.BigEndian)
|
|
|
|
(Array.copy-map &int64-to-byte
|
|
|
|
&[(shift 56l) (shift 48l)
|
|
|
|
(shift 40l) (shift 32l)
|
|
|
|
(shift 24l) (shift 16l) (shift 8l) i]))))
|
2020-02-18 19:41:29 +03:00
|
|
|
|
2020-02-18 21:56:52 +03:00
|
|
|
(doc unsafe-bytes->int64-seq
|
2020-02-18 19:50:24 +03:00
|
|
|
"Interprets a sequence of bytes as a sequence of Uint64 values.
|
2020-02-16 23:15:54 +03:00
|
|
|
**This operation is unsafe.**")
|
2020-02-18 21:56:52 +03:00
|
|
|
(sig unsafe-bytes->int64-seq (Fn [Order (Ref (Array Byte) a)] (Array Uint64)))
|
|
|
|
(defn unsafe-bytes->int64-seq [order bs]
|
2020-02-16 23:57:38 +03:00
|
|
|
(let [partitions (Array.partition bs 8)
|
2020-02-18 21:56:52 +03:00
|
|
|
f (fn [b] (unsafe-bytes->int64 order b))]
|
2020-02-16 23:15:54 +03:00
|
|
|
(Array.copy-map &f &partitions)))
|
2020-02-18 03:03:52 +03:00
|
|
|
|
2020-02-18 19:41:29 +03:00
|
|
|
(doc bytes->int64-seq
|
|
|
|
"Interprets a sequence of bytes as a sequence of Uint64 values.
|
|
|
|
|
|
|
|
If a segment of bytes cannot be interpreted as an Uint64, returns Maybe.Nothing.")
|
|
|
|
(sig bytes->int64-seq (Fn [Order (Ref (Array Byte) a)] (Array (Maybe Uint64))))
|
|
|
|
(defn bytes->int64-seq [order bs]
|
|
|
|
(let [partitions (Array.partition bs 8)
|
|
|
|
f (fn [b] (bytes->int64 order b))]
|
|
|
|
(Array.copy-map &f &partitions)))
|
2020-02-18 21:45:18 +03:00
|
|
|
|
|
|
|
(doc int64-seq->bytes
|
|
|
|
"Converts an array of Uint64 values into byte sequences.")
|
|
|
|
(sig int64-seq->bytes (Fn [Order (Ref (Array Uint64) a)] (Array (Array Byte))))
|
|
|
|
(defn int64-seq->bytes [order is]
|
|
|
|
(let [f (fn [i] (int64->bytes order @i))]
|
|
|
|
(Array.copy-map &f is)))
|
2020-02-16 23:15:54 +03:00
|
|
|
)
|