{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}

-- | This module defines an efficient value representation of the
-- Futhark data format.
module Futhark.Data
  ( Value (..),
    Vector,
    valueText,

    -- * Types of values
    PrimType (..),
    primTypeText,
    primTypeBytes,
    ValueType (..),
    valueTypeTextNoDims,
    valueType,
    valueElemType,
    valueShape,
    valueTypeText,

    -- * Converting values
    GetValue (..),
    PutValue (..),
    PutValue1 (..),
    valueElems,
  )
where

import Control.Monad
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Char (chr, ord)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List (intersperse)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Vector.Storable as SVec
import Data.Vector.Storable.ByteString (byteStringToVector, vectorToByteString)
import Numeric.Half

-- | The value vector type.
type Vector = SVec.Vector

-- | An efficiently represented Futhark value, represented as a shape
-- vector and a value vector, which contains elements in row-major
-- order.  The size of the value vector must be equal to the product
-- of the shape vector.  This is not enforced by the representation,
-- but consuming functions may give unexpected results if this
-- invariant is broken.  Scalars are represented with an empty shape
-- vector.
--
-- Use 'valueText' to get a human-readable representation, and v'put'
-- to obtain binary a representation.
--
-- The 'Eq' instance is the naive one, meaning that no values
-- containing NaNs will be considered equal.  Use the functions from
-- "Futhark.Data.Compare" if this is not what you want.
data Value
  = I8Value (Vector Int) (Vector Int8)
  | I16Value (Vector Int) (Vector Int16)
  | I32Value (Vector Int) (Vector Int32)
  | I64Value (Vector Int) (Vector Int64)
  | U8Value (Vector Int) (Vector Word8)
  | U16Value (Vector Int) (Vector Word16)
  | U32Value (Vector Int) (Vector Word32)
  | U64Value (Vector Int) (Vector Word64)
  | F16Value (Vector Int) (Vector Half)
  | F32Value (Vector Int) (Vector Float)
  | F64Value (Vector Int) (Vector Double)
  | BoolValue (Vector Int) (Vector Bool)
  deriving (Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

binaryFormatVersion :: Word8
binaryFormatVersion :: Word8
binaryFormatVersion = Word8
2

instance Binary Value where
  put :: Value -> Put
put (I8Value Vector Int
shape Vector Int8
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
"  i8" Vector Int
shape Vector Int8
vs
  put (I16Value Vector Int
shape Vector Int16
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" i16" Vector Int
shape Vector Int16
vs
  put (I32Value Vector Int
shape Vector Int32
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" i32" Vector Int
shape Vector Int32
vs
  put (I64Value Vector Int
shape Vector Int64
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" i64" Vector Int
shape Vector Int64
vs
  put (U8Value Vector Int
shape Vector Word8
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
"  u8" Vector Int
shape Vector Word8
vs
  put (U16Value Vector Int
shape Vector Word16
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" u16" Vector Int
shape Vector Word16
vs
  put (U32Value Vector Int
shape Vector Word32
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" u32" Vector Int
shape Vector Word32
vs
  put (U64Value Vector Int
shape Vector Word64
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" u64" Vector Int
shape Vector Word64
vs
  put (F16Value Vector Int
shape Vector Half
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" f16" Vector Int
shape Vector Half
vs
  put (F32Value Vector Int
shape Vector Float
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" f32" Vector Int
shape Vector Float
vs
  put (F64Value Vector Int
shape Vector Double
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" f64" Vector Int
shape Vector Double
vs
  -- Bool must be treated specially because the Storable instance
  -- uses four bytes.
  put (BoolValue Vector Int
shape Vector Bool
vs) = forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
"bool" Vector Int
shape forall a b. (a -> b) -> a -> b
$ forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SVec.map Bool -> Int8
boolToInt8 Vector Bool
vs
    where
      boolToInt8 :: Bool -> Int8
boolToInt8 Bool
True = Int8
1 :: Int8
      boolToInt8 Bool
False = Int8
0

  get :: Get Value
get = do
    Int8
first <- Get Int8
getInt8
    Word8
version <- Get Word8
getWord8
    Int8
rank <- Get Int8
getInt8

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
first) forall a. Eq a => a -> a -> Bool
== Char
'b') forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Input does not begin with ASCII 'b'."
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
version forall a. Eq a => a -> a -> Bool
== Word8
binaryFormatVersion) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expecting binary format version 1; found version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
version
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int8
rank forall a. Ord a => a -> a -> Bool
>= Int8
0) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Rank must be non-negative, but is: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int8
rank

    ByteString
type_f <- Int64 -> Get ByteString
getLazyByteString Int64
4

    [Int]
shape <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
rank) forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
    let num_elems :: Int
num_elems = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
shape
        shape' :: Vector Int
shape' = forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
shape

    case ByteString -> String
LBS.unpack ByteString
type_f of
      String
"  i8" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int8 -> Value
I8Value Vector Int
shape') Int
num_elems Int
1
      String
" i16" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int16 -> Value
I16Value Vector Int
shape') Int
num_elems Int
2
      String
" i32" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int32 -> Value
I32Value Vector Int
shape') Int
num_elems Int
4
      String
" i64" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int64 -> Value
I64Value Vector Int
shape') Int
num_elems Int
8
      String
"  u8" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word8 -> Value
U8Value Vector Int
shape') Int
num_elems Int
1
      String
" u16" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word16 -> Value
U16Value Vector Int
shape') Int
num_elems Int
2
      String
" u32" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word32 -> Value
U32Value Vector Int
shape') Int
num_elems Int
4
      String
" u64" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word64 -> Value
U64Value Vector Int
shape') Int
num_elems Int
8
      String
" f16" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Half -> Value
F16Value Vector Int
shape') Int
num_elems Int
2
      String
" f32" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Float -> Value
F32Value Vector Int
shape') Int
num_elems Int
4
      String
" f64" -> forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Double -> Value
F64Value Vector Int
shape') Int
num_elems Int
8
      -- Bool must be treated specially because the Storable instance
      -- uses four bytes.
      String
"bool" -> Vector Int -> Vector Bool -> Value
BoolValue Vector Int
shape' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SVec.map Int8 -> Bool
int8ToBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => ByteString -> Vector a
byteStringToVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.copy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
num_elems
      String
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Cannot parse binary values of type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s
    where
      -- The copy is to ensure that the bytestring is properly
      -- aligned.
      get' :: (Vector a -> b) -> Int -> Int -> Get b
get' Vector a -> b
mk Int
num_elems Int
elem_size =
        Vector a -> b
mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => ByteString -> Vector a
byteStringToVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.copy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int
num_elems forall a. Num a => a -> a -> a
* Int
elem_size)

      int8ToBool :: Int8 -> Bool
      int8ToBool :: Int8 -> Bool
int8ToBool = (forall a. Eq a => a -> a -> Bool
/= Int8
0)

putBinaryValue ::
  SVec.Storable a =>
  String ->
  Vector Int ->
  Vector a ->
  Put
putBinaryValue :: forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
tstr Vector Int
shape Vector a
vs = do
  Int8 -> Put
putInt8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'b'
  Word8 -> Put
putWord8 Word8
binaryFormatVersion
  Word8 -> Put
putWord8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Vector a -> Int
SVec.length Vector Int
shape
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int8 -> Put
putInt8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
tstr
  ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Vector a -> ByteString
vectorToByteString Vector Int
shape
  ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Vector a -> ByteString
vectorToByteString Vector a
vs

arrayText :: (SVec.Storable a) => (a -> TB.Builder) -> [Int] -> SVec.Vector a -> TB.Builder
arrayText :: forall a.
Storable a =>
(a -> Builder) -> [Int] -> Vector a -> Builder
arrayText a -> Builder
p [] Vector a
vs =
  a -> Builder
p forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Vector a -> a
SVec.head Vector a
vs
arrayText a -> Builder
p (Int
d : [Int]
ds) Vector a
vs =
  Builder
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Builder
separator forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a.
Storable a =>
(a -> Builder) -> [Int] -> Vector a -> Builder
arrayText a -> Builder
p [Int]
ds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector a
slice) [Int
0 .. Int
d forall a. Num a => a -> a -> a
- Int
1]) forall a. Semigroup a => a -> a -> a
<> Builder
"]"
  where
    slice_size :: Int
slice_size = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
ds
    slice :: Int -> Vector a
slice Int
i = forall a. Storable a => Int -> Int -> Vector a -> Vector a
SVec.slice (Int
i forall a. Num a => a -> a -> a
* Int
slice_size) Int
slice_size Vector a
vs
    separator :: Builder
separator
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ds = Builder
", "
      | Bool
otherwise = Builder
",\n"

-- | Construct a textual representation of the value as a strict text.
valueText :: Value -> T.Text
valueText :: Value -> Text
valueText Value
v
  | forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (Value -> [Int]
valueShape Value
v) forall a. Eq a => a -> a -> Bool
== Int
0 =
      Text
"empty(" forall a. Semigroup a => a -> a -> a
<> Text
dims forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
primTypeText (Value -> PrimType
valueElemType Value
v) forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    dims :: Text
dims = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. (Semigroup a, IsString a) => a -> a
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Value -> [Int]
valueShape Value
v
    brackets :: a -> a
brackets a
s = a
"[" forall a. Semigroup a => a -> a -> a
<> a
s forall a. Semigroup a => a -> a -> a
<> a
"]"
valueText Value
v =
  case Value
v of
    I8Value Vector Int
shape Vector Int8
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int8
vs
    I16Value Vector Int
shape Vector Int16
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int16
vs
    I32Value Vector Int
shape Vector Int32
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int32
vs
    I64Value Vector Int
shape Vector Int64
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int64
vs
    U8Value Vector Int
shape Vector Word8
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word8
vs
    U16Value Vector Int
shape Vector Word16
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word16
vs
    U32Value Vector Int
shape Vector Word32
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word32
vs
    U64Value Vector Int
shape Vector Word64
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word64
vs
    F16Value Vector Int
shape Vector Half
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. (RealFloat a, Show a) => a -> Builder
pF16 Vector Int
shape Vector Half
vs
    F32Value Vector Int
shape Vector Float
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. (RealFloat a, Show a) => a -> Builder
pF32 Vector Int
shape Vector Float
vs
    F64Value Vector Int
shape Vector Double
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. (RealFloat a, Show a) => a -> Builder
pF64 Vector Int
shape Vector Double
vs
    BoolValue Vector Int
shape Vector Bool
vs -> forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f forall {a}. IsString a => Bool -> a
pBool Vector Int
shape Vector Bool
vs
  where
    suffix :: Text
suffix = PrimType -> Text
primTypeText forall a b. (a -> b) -> a -> b
$ Value -> PrimType
valueElemType Value
v
    pNum :: a -> Builder
pNum a
x = String -> Builder
TB.fromString (forall a. Show a => a -> String
show a
x) forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
suffix
    pF16 :: a -> Builder
pF16 a
x
      | forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x forall a. Ord a => a -> a -> Bool
>= a
0 = Builder
"f16.inf"
      | forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x forall a. Ord a => a -> a -> Bool
< a
0 = Builder
"-f16.inf"
      | forall a. RealFloat a => a -> Bool
isNaN a
x = Builder
"f16.nan"
      | Bool
otherwise = forall {a}. Show a => a -> Builder
pNum a
x
    pF32 :: a -> Builder
pF32 a
x
      | forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x forall a. Ord a => a -> a -> Bool
>= a
0 = Builder
"f32.inf"
      | forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x forall a. Ord a => a -> a -> Bool
< a
0 = Builder
"-f32.inf"
      | forall a. RealFloat a => a -> Bool
isNaN a
x = Builder
"f32.nan"
      | Bool
otherwise = forall {a}. Show a => a -> Builder
pNum a
x
    pF64 :: a -> Builder
pF64 a
x
      | forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x forall a. Ord a => a -> a -> Bool
>= a
0 = Builder
"f64.inf"
      | forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x forall a. Ord a => a -> a -> Bool
< a
0 = Builder
"-f64.inf"
      | forall a. RealFloat a => a -> Bool
isNaN a
x = Builder
"f64.nan"
      | Bool
otherwise = forall {a}. Show a => a -> Builder
pNum a
x

    pBool :: Bool -> a
pBool Bool
True = a
"true"
    pBool Bool
False = a
"false"

    f :: (a -> Builder) -> Vector Int -> Vector a -> Text
f a -> Builder
p Vector Int
shape Vector a
vs = Text -> Text
LT.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> Text
TB.toLazyText forall a b. (a -> b) -> a -> b
$ forall a.
Storable a =>
(a -> Builder) -> [Int] -> Vector a -> Builder
arrayText a -> Builder
p (forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape) Vector a
vs

-- | The scalar types supported by the value format.
data PrimType = I8 | I16 | I32 | I64 | U8 | U16 | U32 | U64 | F16 | F32 | F64 | Bool
  deriving (PrimType -> PrimType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimType -> PrimType -> Bool
$c/= :: PrimType -> PrimType -> Bool
== :: PrimType -> PrimType -> Bool
$c== :: PrimType -> PrimType -> Bool
Eq, Eq PrimType
PrimType -> PrimType -> Bool
PrimType -> PrimType -> Ordering
PrimType -> PrimType -> PrimType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrimType -> PrimType -> PrimType
$cmin :: PrimType -> PrimType -> PrimType
max :: PrimType -> PrimType -> PrimType
$cmax :: PrimType -> PrimType -> PrimType
>= :: PrimType -> PrimType -> Bool
$c>= :: PrimType -> PrimType -> Bool
> :: PrimType -> PrimType -> Bool
$c> :: PrimType -> PrimType -> Bool
<= :: PrimType -> PrimType -> Bool
$c<= :: PrimType -> PrimType -> Bool
< :: PrimType -> PrimType -> Bool
$c< :: PrimType -> PrimType -> Bool
compare :: PrimType -> PrimType -> Ordering
$ccompare :: PrimType -> PrimType -> Ordering
Ord, Int -> PrimType -> ShowS
[PrimType] -> ShowS
PrimType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimType] -> ShowS
$cshowList :: [PrimType] -> ShowS
show :: PrimType -> String
$cshow :: PrimType -> String
showsPrec :: Int -> PrimType -> ShowS
$cshowsPrec :: Int -> PrimType -> ShowS
Show, Int -> PrimType
PrimType -> Int
PrimType -> [PrimType]
PrimType -> PrimType
PrimType -> PrimType -> [PrimType]
PrimType -> PrimType -> PrimType -> [PrimType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PrimType -> PrimType -> PrimType -> [PrimType]
$cenumFromThenTo :: PrimType -> PrimType -> PrimType -> [PrimType]
enumFromTo :: PrimType -> PrimType -> [PrimType]
$cenumFromTo :: PrimType -> PrimType -> [PrimType]
enumFromThen :: PrimType -> PrimType -> [PrimType]
$cenumFromThen :: PrimType -> PrimType -> [PrimType]
enumFrom :: PrimType -> [PrimType]
$cenumFrom :: PrimType -> [PrimType]
fromEnum :: PrimType -> Int
$cfromEnum :: PrimType -> Int
toEnum :: Int -> PrimType
$ctoEnum :: Int -> PrimType
pred :: PrimType -> PrimType
$cpred :: PrimType -> PrimType
succ :: PrimType -> PrimType
$csucc :: PrimType -> PrimType
Enum, PrimType
forall a. a -> a -> Bounded a
maxBound :: PrimType
$cmaxBound :: PrimType
minBound :: PrimType
$cminBound :: PrimType
Bounded)

-- | Textual primitive type as a strict text.
primTypeText :: PrimType -> T.Text
primTypeText :: PrimType -> Text
primTypeText PrimType
I8 = Text
"i8"
primTypeText PrimType
I16 = Text
"i16"
primTypeText PrimType
I32 = Text
"i32"
primTypeText PrimType
I64 = Text
"i64"
primTypeText PrimType
U8 = Text
"u8"
primTypeText PrimType
U16 = Text
"u16"
primTypeText PrimType
U32 = Text
"u32"
primTypeText PrimType
U64 = Text
"u64"
primTypeText PrimType
F16 = Text
"f16"
primTypeText PrimType
F32 = Text
"f32"
primTypeText PrimType
F64 = Text
"f64"
primTypeText PrimType
Bool = Text
"bool"

-- | The number of bytes taken up by a single element of this type.
primTypeBytes :: PrimType -> Int
primTypeBytes :: PrimType -> Int
primTypeBytes PrimType
I8 = Int
1
primTypeBytes PrimType
I16 = Int
2
primTypeBytes PrimType
I32 = Int
4
primTypeBytes PrimType
I64 = Int
8
primTypeBytes PrimType
U8 = Int
1
primTypeBytes PrimType
U16 = Int
2
primTypeBytes PrimType
U32 = Int
4
primTypeBytes PrimType
U64 = Int
8
primTypeBytes PrimType
F16 = Int
2
primTypeBytes PrimType
F32 = Int
4
primTypeBytes PrimType
F64 = Int
8
primTypeBytes PrimType
Bool = Int
1

-- | The type of a simple Futhark value, comprising a shape and an
-- element type.
data ValueType = ValueType [Int] PrimType
  deriving (ValueType -> ValueType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueType -> ValueType -> Bool
$c/= :: ValueType -> ValueType -> Bool
== :: ValueType -> ValueType -> Bool
$c== :: ValueType -> ValueType -> Bool
Eq, Eq ValueType
ValueType -> ValueType -> Bool
ValueType -> ValueType -> Ordering
ValueType -> ValueType -> ValueType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ValueType -> ValueType -> ValueType
$cmin :: ValueType -> ValueType -> ValueType
max :: ValueType -> ValueType -> ValueType
$cmax :: ValueType -> ValueType -> ValueType
>= :: ValueType -> ValueType -> Bool
$c>= :: ValueType -> ValueType -> Bool
> :: ValueType -> ValueType -> Bool
$c> :: ValueType -> ValueType -> Bool
<= :: ValueType -> ValueType -> Bool
$c<= :: ValueType -> ValueType -> Bool
< :: ValueType -> ValueType -> Bool
$c< :: ValueType -> ValueType -> Bool
compare :: ValueType -> ValueType -> Ordering
$ccompare :: ValueType -> ValueType -> Ordering
Ord, Int -> ValueType -> ShowS
[ValueType] -> ShowS
ValueType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueType] -> ShowS
$cshowList :: [ValueType] -> ShowS
show :: ValueType -> String
$cshow :: ValueType -> String
showsPrec :: Int -> ValueType -> ShowS
$cshowsPrec :: Int -> ValueType -> ShowS
Show)

-- | Prettyprint a value type as a strict text.
valueTypeText :: ValueType -> T.Text
valueTypeText :: ValueType -> Text
valueTypeText (ValueType [Int]
ds PrimType
t) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> Text
pprDim [Int]
ds) forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
primTypeText PrimType
t
  where
    pprDim :: a -> Text
pprDim a
d = Text
"[" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show a
d) forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Prettyprint a value type with empty dimensions as a strict text.
-- This is needed for Futhark server programs, whose types are
-- un-sized.
valueTypeTextNoDims :: ValueType -> T.Text
valueTypeTextNoDims :: ValueType -> Text
valueTypeTextNoDims (ValueType [Int]
dims PrimType
t) =
  forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dims) Text
"[]") forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
primTypeText PrimType
t

-- | Get the type of a value.
valueType :: Value -> ValueType
valueType :: Value -> ValueType
valueType Value
v = [Int] -> PrimType -> ValueType
ValueType (Value -> [Int]
valueShape Value
v) forall a b. (a -> b) -> a -> b
$ Value -> PrimType
valueElemType Value
v

-- | Get the element type of a value.
valueElemType :: Value -> PrimType
valueElemType :: Value -> PrimType
valueElemType I8Value {} = PrimType
I8
valueElemType I16Value {} = PrimType
I16
valueElemType I32Value {} = PrimType
I32
valueElemType I64Value {} = PrimType
I64
valueElemType U8Value {} = PrimType
U8
valueElemType U16Value {} = PrimType
U16
valueElemType U32Value {} = PrimType
U32
valueElemType U64Value {} = PrimType
U64
valueElemType F16Value {} = PrimType
F16
valueElemType F32Value {} = PrimType
F32
valueElemType F64Value {} = PrimType
F64
valueElemType BoolValue {} = PrimType
Bool

-- | The shape of a value.  Empty list in case of a scalar.
valueShape :: Value -> [Int]
valueShape :: Value -> [Int]
valueShape (I8Value Vector Int
shape Vector Int8
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (I16Value Vector Int
shape Vector Int16
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (I32Value Vector Int
shape Vector Int32
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (I64Value Vector Int
shape Vector Int64
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U8Value Vector Int
shape Vector Word8
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U16Value Vector Int
shape Vector Word16
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U32Value Vector Int
shape Vector Word32
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U64Value Vector Int
shape Vector Word64
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (F16Value Vector Int
shape Vector Half
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (F32Value Vector Int
shape Vector Float
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (F64Value Vector Int
shape Vector Double
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (BoolValue Vector Int
shape Vector Bool
_) = forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape

-- Conversions

-- | Produce a list of the immediate elements of the value.  That is,
-- a 2D array will produce a list of 1D values.  A zero-dimensional
-- value will produce an empty list.  While lists are of course
-- inefficient, the actual values are just slices of the original
-- value, which makes them fairly space-efficient (but beware space
-- leaks).
valueElems :: Value -> [Value]
valueElems :: Value -> [Value]
valueElems Value
v
  | Int
n : [Int]
ns <- Value -> [Int]
valueShape Value
v =
      let k :: Int
k = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
ns
          slices :: (Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector a -> a
mk Vector a
vs =
            [ Vector Int -> Vector a -> a
mk (forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
ns) forall a b. (a -> b) -> a -> b
$
                forall a. Storable a => Int -> Int -> Vector a -> Vector a
SVec.slice (Int
k forall a. Num a => a -> a -> a
* Int
i) Int
k Vector a
vs
              | Int
i <- [Int
0 .. Int
n forall a. Num a => a -> a -> a
- Int
1]
            ]
       in case Value
v of
            I8Value Vector Int
_ Vector Int8
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int8 -> Value
I8Value Vector Int8
vs
            I16Value Vector Int
_ Vector Int16
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int16 -> Value
I16Value Vector Int16
vs
            I32Value Vector Int
_ Vector Int32
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int32 -> Value
I32Value Vector Int32
vs
            I64Value Vector Int
_ Vector Int64
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int64 -> Value
I64Value Vector Int64
vs
            U8Value Vector Int
_ Vector Word8
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word8 -> Value
U8Value Vector Word8
vs
            U16Value Vector Int
_ Vector Word16
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word16 -> Value
U16Value Vector Word16
vs
            U32Value Vector Int
_ Vector Word32
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word32 -> Value
U32Value Vector Word32
vs
            U64Value Vector Int
_ Vector Word64
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word64 -> Value
U64Value Vector Word64
vs
            F16Value Vector Int
_ Vector Half
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Half -> Value
F16Value Vector Half
vs
            F32Value Vector Int
_ Vector Float
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Float -> Value
F32Value Vector Float
vs
            F64Value Vector Int
_ Vector Double
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Double -> Value
F64Value Vector Double
vs
            BoolValue Vector Int
_ Vector Bool
vs -> forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Bool -> Value
BoolValue Vector Bool
vs
  | Bool
otherwise =
      []

-- | A class for Haskell values that can be retrieved from 'Value'.
-- This is a convenience facility - don't expect it to be fast.
class GetValue t where
  getValue :: Value -> Maybe t

instance GetValue t => GetValue [t] where
  getValue :: Value -> Maybe [t]
getValue Value
v
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Value -> [Int]
valueShape Value
v = forall a. Maybe a
Nothing
    | Bool
otherwise = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall t. GetValue t => Value -> Maybe t
getValue forall a b. (a -> b) -> a -> b
$ Value -> [Value]
valueElems Value
v

instance GetValue Bool where
  getValue :: Value -> Maybe Bool
getValue (BoolValue Vector Int
shape Vector Bool
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Bool
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Int8 where
  getValue :: Value -> Maybe Int8
getValue (I8Value Vector Int
shape Vector Int8
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Int8
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Int16 where
  getValue :: Value -> Maybe Int16
getValue (I16Value Vector Int
shape Vector Int16
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Int16
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Int32 where
  getValue :: Value -> Maybe Int32
getValue (I32Value Vector Int
shape Vector Int32
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Int32
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Int64 where
  getValue :: Value -> Maybe Int64
getValue (I64Value Vector Int
shape Vector Int64
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Int64
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Word8 where
  getValue :: Value -> Maybe Word8
getValue (U8Value Vector Int
shape Vector Word8
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Word8
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Word16 where
  getValue :: Value -> Maybe Word16
getValue (U16Value Vector Int
shape Vector Word16
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Word16
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Word32 where
  getValue :: Value -> Maybe Word32
getValue (U32Value Vector Int
shape Vector Word32
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Word32
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

instance GetValue Word64 where
  getValue :: Value -> Maybe Word64
getValue (U64Value Vector Int
shape Vector Word64
vs)
    | [] <- forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Word64
vs forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = forall a. Maybe a
Nothing

-- | A class for Haskell values that can be converted to 'Value'.
-- This is a convenience facility - don't expect it to be fast.
class PutValue t where
  -- | This may fail for cases such as irregular arrays.
  putValue :: t -> Maybe Value

instance PutValue Int8 where
  putValue :: Int8 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Int16 where
  putValue :: Int16 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Int32 where
  putValue :: Int32 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Int64 where
  putValue :: Int64 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word8 where
  putValue :: Word8 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word16 where
  putValue :: Word16 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word32 where
  putValue :: Word32 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word64 where
  putValue :: Word64 -> Maybe Value
putValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PutValue1 t => t -> Value
putValue1

instance PutValue [Value] where
  putValue :: [Value] -> Maybe Value
putValue [] = forall a. Maybe a
Nothing
  putValue (Value
x : [Value]
xs) = do
    let res_shape :: Vector Int
res_shape = forall a. Storable a => [a] -> Vector a
SVec.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (Value
x forall a. a -> [a] -> [a]
: [Value]
xs) forall a. a -> [a] -> [a]
: Value -> [Int]
valueShape Value
x
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== Value -> ValueType
valueType Value
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueType
valueType) [Value]
xs
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Value
x of
      I8Value {} -> Vector Int -> Vector Int8 -> Value
I8Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      I16Value {} -> Vector Int -> Vector Int16 -> Value
I16Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      I32Value {} -> Vector Int -> Vector Int32 -> Value
I32Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      I64Value {} -> Vector Int -> Vector Int64 -> Value
I64Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      U8Value {} -> Vector Int -> Vector Word8 -> Value
U8Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      U16Value {} -> Vector Int -> Vector Word16 -> Value
U16Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      U32Value {} -> Vector Int -> Vector Word32 -> Value
U32Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      U64Value {} -> Vector Int -> Vector Word64 -> Value
U64Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      F16Value {} -> Vector Int -> Vector Half -> Value
F16Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      F32Value {} -> Vector Int -> Vector Float -> Value
F32Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      F64Value {} -> Vector Int -> Vector Double -> Value
F64Value Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
      BoolValue {} -> Vector Int -> Vector Bool -> Value
BoolValue Vector Int
res_shape forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Storable b => Value -> Vector b
getVec (Value
x forall a. a -> [a] -> [a]
: [Value]
xs)
    where
      getVec :: Value -> Vector b
getVec (I8Value Vector Int
_ Vector Int8
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int8
vec
      getVec (I16Value Vector Int
_ Vector Int16
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int16
vec
      getVec (I32Value Vector Int
_ Vector Int32
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int32
vec
      getVec (I64Value Vector Int
_ Vector Int64
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int64
vec
      getVec (U8Value Vector Int
_ Vector Word8
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word8
vec
      getVec (U16Value Vector Int
_ Vector Word16
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word16
vec
      getVec (U32Value Vector Int
_ Vector Word32
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word32
vec
      getVec (U64Value Vector Int
_ Vector Word64
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word64
vec
      getVec (F16Value Vector Int
_ Vector Half
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Half
vec
      getVec (F32Value Vector Int
_ Vector Float
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Float
vec
      getVec (F64Value Vector Int
_ Vector Double
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Double
vec
      getVec (BoolValue Vector Int
_ Vector Bool
vec) = forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Bool
vec

instance PutValue T.Text where
  putValue :: Text -> Maybe Value
putValue = forall t. PutValue t => t -> Maybe Value
putValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance PutValue BS.ByteString where
  putValue :: ByteString -> Maybe Value
putValue ByteString
bs =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Vector Int -> Vector Word8 -> Value
U8Value Vector Int
size forall a b. (a -> b) -> a -> b
$ forall a. Storable a => ByteString -> Vector a
byteStringToVector ByteString
bs
    where
      size :: Vector Int
size = forall a. Storable a => [a] -> Vector a
SVec.fromList [forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)]

-- | Like 'PutValue', but only for scalars and a few other simple
-- things that cannot fail.
class PutValue1 t where
  putValue1 :: t -> Value

instance PutValue1 Int8 where
  putValue1 :: Int8 -> Value
putValue1 = Vector Int -> Vector Int8 -> Value
I8Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Int16 where
  putValue1 :: Int16 -> Value
putValue1 = Vector Int -> Vector Int16 -> Value
I16Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Int32 where
  putValue1 :: Int32 -> Value
putValue1 = Vector Int -> Vector Int32 -> Value
I32Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Int64 where
  putValue1 :: Int64 -> Value
putValue1 = Vector Int -> Vector Int64 -> Value
I64Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word8 where
  putValue1 :: Word8 -> Value
putValue1 = Vector Int -> Vector Word8 -> Value
U8Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word16 where
  putValue1 :: Word16 -> Value
putValue1 = Vector Int -> Vector Word16 -> Value
U16Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word32 where
  putValue1 :: Word32 -> Value
putValue1 = Vector Int -> Vector Word32 -> Value
U32Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word64 where
  putValue1 :: Word64 -> Value
putValue1 = Vector Int -> Vector Word64 -> Value
U64Value forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 T.Text where
  putValue1 :: Text -> Value
putValue1 = forall t. PutValue1 t => t -> Value
putValue1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance PutValue1 BS.ByteString where
  putValue1 :: ByteString -> Value
putValue1 ByteString
bs = Vector Int -> Vector Word8 -> Value
U8Value Vector Int
size forall a b. (a -> b) -> a -> b
$ forall a. Storable a => ByteString -> Vector a
byteStringToVector ByteString
bs
    where
      size :: Vector Int
size = forall a. Storable a => [a] -> Vector a
SVec.fromList [forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)]