mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-26 13:51:50 +03:00
05ab70b196
Note that we do not need an unsafe variant of these conversions since they are simple projections to and from the Uint types.
268 lines
10 KiB
Plaintext
268 lines
10 KiB
Plaintext
(system-include "carp_binary.h")
|
|
(load "StdInt.carp")
|
|
|
|
;; 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)))))))))))
|
|
)
|
|
|
|
(defmodule Binary
|
|
(doc Order
|
|
"The type of byte orders.
|
|
|
|
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)
|
|
|
|
(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))
|
|
(register int16-to-byte (λ [(Ref Uint16)] Byte))
|
|
(register int32-to-byte (λ [(Ref Uint32)] Byte))
|
|
(register int64-to-byte (λ [(Ref Uint64)] Byte))
|
|
(register system-endianness-internal (λ [] Int))
|
|
|
|
(doc system-endianness
|
|
"Returns the endianness of the host system.")
|
|
(sig system-endianness (λ [] Order))
|
|
(defn system-endianness []
|
|
(if (= (system-endianness-internal) 1)
|
|
(Order.LittleEndian)
|
|
(Order.BigEndian)))
|
|
|
|
(doc bytes->int16-unsafe
|
|
"Interprets the first two bytes in a byte sequence as an Uint16 value.
|
|
**This operation is unsafe.**")
|
|
(sig bytes->int16-unsafe (Fn [Order (Ref (Array Byte) a)] Uint16))
|
|
(defn bytes->int16-unsafe [order bs]
|
|
(match order
|
|
(Order.LittleEndian)
|
|
(to-int16 @(Array.unsafe-nth bs 0) @(Array.unsafe-nth bs 1))
|
|
(Order.BigEndian)
|
|
(to-int16 @(Array.unsafe-nth bs 1) @(Array.unsafe-nth bs 0))))
|
|
|
|
(doc bytes->int16
|
|
"Interprets the first two bytes in a byte sequence as an Uint16 value.
|
|
|
|
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))))
|
|
|
|
(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])))
|
|
|
|
(doc bytes->int32-unsafe
|
|
"Interprets the first four bytes in a byte sequence as an Uint32 value.
|
|
**This operation is unsafe.**")
|
|
(sig bytes->int32-unsafe (Fn [Order (Ref (Array Byte))] Uint32))
|
|
(defn bytes->int32-unsafe [order bs]
|
|
(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)
|
|
(to-int32 @(Array.unsafe-nth bs 3) @(Array.unsafe-nth bs 2)
|
|
@(Array.unsafe-nth bs 1) @(Array.unsafe-nth bs 0))))
|
|
|
|
(doc bytes->int32
|
|
"Interprets the first four bytes in a byte sequence as an Uint32 value.
|
|
|
|
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))))
|
|
|
|
(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]))))
|
|
|
|
(doc bytes->int64-unsafe
|
|
"Interprets the first eight bytes in a byte sequence as an Uint64 value.
|
|
**This operation is unsafe.**")
|
|
(sig bytes->int64-unsafe (Fn [Order (Ref (Array Byte) a)] Uint64))
|
|
(defn bytes->int64-unsafe [order bs]
|
|
(match order
|
|
(Order.LittleEndian)
|
|
(to-int64 @(Array.unsafe-nth bs 0) @(Array.unsafe-nth bs 1)
|
|
@(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))
|
|
(Order.BigEndian)
|
|
(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))))
|
|
|
|
(doc bytes->int64
|
|
"Interprets the first eight bytes in a byte sequence as an Uint64 value.
|
|
|
|
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))))
|
|
(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]))))
|
|
|
|
(doc bytes->int16-seq-unsafe
|
|
"Interprets a sequence of bytes as a sequence of Uint16 values.
|
|
**This operation is unsafe.**")
|
|
(sig bytes->int16-seq-unsafe (Fn [Order (Ref (Array Byte) a)] (Array Uint16)))
|
|
(defn bytes->int16-seq-unsafe [order bs]
|
|
(let [partitions (Array.partition bs 2)
|
|
f (fn [b] (bytes->int16-unsafe order b))]
|
|
(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 bytes->int32-seq-unsafe
|
|
"Interprets a sequence of bytes as a sequence of Uint32 values.
|
|
**This operation is unsafe.**")
|
|
(sig bytes->int32-seq-unsafe (Fn [Order (Ref (Array Byte) a)] (Array Uint32)))
|
|
(defn bytes->int32-seq-unsafe [order bs]
|
|
(let [partitions (Array.partition bs 4)
|
|
f (fn [b] (bytes->int32-unsafe order b))]
|
|
(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 bytes->int64-seq-unsafe
|
|
"Interprets a sequence of bytes as a sequence of Uint64 values.
|
|
**This operation is unsafe.**")
|
|
(sig bytes->int64-seq-unsafe (Fn [Order (Ref (Array Byte) a)] (Array Uint64)))
|
|
(defn bytes->int64-seq-unsafe [order bs]
|
|
(let [partitions (Array.partition bs 8)
|
|
f (fn [b] (bytes->int64-unsafe order b))]
|
|
(Array.copy-map &f &partitions)))
|
|
|
|
(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)))
|
|
)
|