-- | The value representation used in the interpreter.
--
-- Kept simple and free of unnecessary operational details (in
-- particular, no references to the interpreter monad).
module Language.Futhark.Interpreter.Values
  ( -- * Shapes
    Shape (..),
    ValueShape,
    typeShape,
    structTypeShape,

    -- * Values
    Value (..),
    valueShape,
    prettyValue,
    valueText,
    fromTuple,
    arrayLength,
    isEmptyArray,
    prettyEmptyArray,
    toArray,
    toArray',
    toTuple,

    -- * Conversion
    fromDataValue,
  )
where

import Data.Array
import Data.List (genericLength)
import Data.Map qualified as M
import Data.Maybe
import Data.Monoid hiding (Sum)
import Data.Text qualified as T
import Data.Vector.Storable qualified as SVec
import Futhark.Data qualified as V
import Futhark.Util (chunk)
import Futhark.Util.Pretty
import Language.Futhark hiding (Shape, matchDims)
import Language.Futhark.Primitive qualified as P
import Prelude hiding (break, mod)

prettyRecord :: (a -> Doc ann) -> M.Map Name a -> Doc ann
prettyRecord :: forall a ann. (a -> Doc ann) -> Map Name a -> Doc ann
prettyRecord a -> Doc ann
p Map Name a
m
  | Just [a]
vs <- forall a. Map Name a -> Maybe [a]
areTupleFields Map Name a
m =
      forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ann
p [a]
vs
  | Bool
otherwise =
      forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Pretty a => (a, a) -> Doc ann
field forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Name a
m
  where
    field :: (a, a) -> Doc ann
field (a
k, a
v) = forall a ann. Pretty a => a -> Doc ann
pretty a
k forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
p a
v

-- | A shape is a tree to accomodate the case of records.  It is
-- parameterised over the representation of dimensions.
data Shape d
  = ShapeDim d (Shape d)
  | ShapeLeaf
  | ShapeRecord (M.Map Name (Shape d))
  | ShapeSum (M.Map Name [Shape d])
  deriving (Shape d -> Shape d -> Bool
forall d. Eq d => Shape d -> Shape d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape d -> Shape d -> Bool
$c/= :: forall d. Eq d => Shape d -> Shape d -> Bool
== :: Shape d -> Shape d -> Bool
$c== :: forall d. Eq d => Shape d -> Shape d -> Bool
Eq, Int -> Shape d -> ShowS
forall d. Show d => Int -> Shape d -> ShowS
forall d. Show d => [Shape d] -> ShowS
forall d. Show d => Shape d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape d] -> ShowS
$cshowList :: forall d. Show d => [Shape d] -> ShowS
show :: Shape d -> String
$cshow :: forall d. Show d => Shape d -> String
showsPrec :: Int -> Shape d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Shape d -> ShowS
Show, forall a b. a -> Shape b -> Shape a
forall a b. (a -> b) -> Shape a -> Shape b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Shape b -> Shape a
$c<$ :: forall a b. a -> Shape b -> Shape a
fmap :: forall a b. (a -> b) -> Shape a -> Shape b
$cfmap :: forall a b. (a -> b) -> Shape a -> Shape b
Functor, forall a. Eq a => a -> Shape a -> Bool
forall a. Num a => Shape a -> a
forall a. Ord a => Shape a -> a
forall m. Monoid m => Shape m -> m
forall a. Shape a -> Bool
forall a. Shape a -> Int
forall a. Shape a -> [a]
forall a. (a -> a -> a) -> Shape a -> a
forall m a. Monoid m => (a -> m) -> Shape a -> m
forall b a. (b -> a -> b) -> b -> Shape a -> b
forall a b. (a -> b -> b) -> b -> Shape a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Shape a -> a
$cproduct :: forall a. Num a => Shape a -> a
sum :: forall a. Num a => Shape a -> a
$csum :: forall a. Num a => Shape a -> a
minimum :: forall a. Ord a => Shape a -> a
$cminimum :: forall a. Ord a => Shape a -> a
maximum :: forall a. Ord a => Shape a -> a
$cmaximum :: forall a. Ord a => Shape a -> a
elem :: forall a. Eq a => a -> Shape a -> Bool
$celem :: forall a. Eq a => a -> Shape a -> Bool
length :: forall a. Shape a -> Int
$clength :: forall a. Shape a -> Int
null :: forall a. Shape a -> Bool
$cnull :: forall a. Shape a -> Bool
toList :: forall a. Shape a -> [a]
$ctoList :: forall a. Shape a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Shape a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Shape a -> a
foldr1 :: forall a. (a -> a -> a) -> Shape a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Shape a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Shape a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Shape a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Shape a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Shape a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Shape a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Shape a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Shape a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Shape a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Shape a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Shape a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Shape a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Shape a -> m
fold :: forall m. Monoid m => Shape m -> m
$cfold :: forall m. Monoid m => Shape m -> m
Foldable, Functor Shape
Foldable Shape
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Shape (m a) -> m (Shape a)
forall (f :: * -> *) a. Applicative f => Shape (f a) -> f (Shape a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Shape a -> m (Shape b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Shape a -> f (Shape b)
sequence :: forall (m :: * -> *) a. Monad m => Shape (m a) -> m (Shape a)
$csequence :: forall (m :: * -> *) a. Monad m => Shape (m a) -> m (Shape a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Shape a -> m (Shape b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Shape a -> m (Shape b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Shape (f a) -> f (Shape a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Shape (f a) -> f (Shape a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Shape a -> f (Shape b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Shape a -> f (Shape b)
Traversable)

-- | The shape of an array.
type ValueShape = Shape Int64

instance Pretty d => Pretty (Shape d) where
  pretty :: forall ann. Shape d -> Doc ann
pretty Shape d
ShapeLeaf = forall a. Monoid a => a
mempty
  pretty (ShapeDim d
d Shape d
s) = forall ann. Doc ann -> Doc ann
brackets (forall a ann. Pretty a => a -> Doc ann
pretty d
d) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Shape d
s
  pretty (ShapeRecord Map Name (Shape d)
m) = forall a ann. (a -> Doc ann) -> Map Name a -> Doc ann
prettyRecord forall a ann. Pretty a => a -> Doc ann
pretty Map Name (Shape d)
m
  pretty (ShapeSum Map Name [Shape d]
cs) =
    forall a. Monoid a => [a] -> a
mconcat (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
" | " forall {ann}. [Doc ann]
cs')
    where
      ppConstr :: (a, [a]) -> Doc ann
ppConstr (a
name, [a]
fs) = forall ann. [Doc ann] -> Doc ann
sep forall a b. (a -> b) -> a -> b
$ (Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
name) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [a]
fs
      cs' :: [Doc ann]
cs' = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, [a]) -> Doc ann
ppConstr forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Name [Shape d]
cs

emptyShape :: ValueShape -> Bool
emptyShape :: ValueShape -> Bool
emptyShape (ShapeDim Int64
d ValueShape
s) = Int64
d forall a. Eq a => a -> a -> Bool
== Int64
0 Bool -> Bool -> Bool
|| ValueShape -> Bool
emptyShape ValueShape
s
emptyShape ValueShape
_ = Bool
False

typeShape :: TypeBase d () -> Shape d
typeShape :: forall d. TypeBase d () -> Shape d
typeShape (Array ()
_ Uniqueness
_ Shape d
shape ScalarTypeBase d ()
et) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall d. d -> Shape d -> Shape d
ShapeDim (forall d. TypeBase d () -> Shape d
typeShape (forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar ScalarTypeBase d ()
et)) forall a b. (a -> b) -> a -> b
$ forall dim. Shape dim -> [dim]
shapeDims Shape d
shape
typeShape (Scalar (Record Map Name (TypeBase d ())
fs)) =
  forall d. Map Name (Shape d) -> Shape d
ShapeRecord forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall d. TypeBase d () -> Shape d
typeShape Map Name (TypeBase d ())
fs
typeShape (Scalar (Sum Map Name [TypeBase d ()]
cs)) =
  forall d. Map Name [Shape d] -> Shape d
ShapeSum forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> b) -> [a] -> [b]
map forall d. TypeBase d () -> Shape d
typeShape) Map Name [TypeBase d ()]
cs
typeShape TypeBase d ()
_ =
  forall d. Shape d
ShapeLeaf

structTypeShape :: StructType -> Shape (Maybe Int64)
structTypeShape :: StructType -> Shape (Maybe Int64)
structTypeShape = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Num a => Size -> Maybe a
dim forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. TypeBase d () -> Shape d
typeShape
  where
    dim :: Size -> Maybe a
dim (ConstSize Int64
d) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d
    dim Size
_ = forall a. Maybe a
Nothing

-- | A fully evaluated Futhark value.
data Value m
  = ValuePrim !PrimValue
  | ValueArray ValueShape !(Array Int (Value m))
  | -- Stores the full shape.
    ValueRecord (M.Map Name (Value m))
  | ValueFun (Value m -> m (Value m))
  | -- Stores the full shape.
    ValueSum ValueShape Name [Value m]
  | -- The update function and the array.
    ValueAcc (Value m -> Value m -> m (Value m)) !(Array Int (Value m))

instance Show (Value m) where
  show :: Value m -> String
show (ValuePrim PrimValue
v) = String
"ValuePrim " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show PrimValue
v forall a. Semigroup a => a -> a -> a
<> String
""
  show (ValueArray ValueShape
shape Array Int (Value m)
vs) = [String] -> String
unwords [String
"ValueArray", forall a. Show a => a -> String
show ValueShape
shape, forall a. Show a => a -> String
show Array Int (Value m)
vs]
  show (ValueRecord Map Name (Value m)
fs) = String
"ValueRecord " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Map Name (Value m)
fs
  show (ValueSum ValueShape
shape Name
c [Value m]
vs) = [String] -> String
unwords [String
"ValueSum", forall a. Show a => a -> String
show ValueShape
shape, forall a. Show a => a -> String
show Name
c, forall a. Show a => a -> String
show [Value m]
vs]
  show ValueFun {} = String
"ValueFun _"
  show ValueAcc {} = String
"ValueAcc _"

instance Eq (Value m) where
  ValuePrim (SignedValue IntValue
x) == :: Value m -> Value m -> Bool
== ValuePrim (SignedValue IntValue
y) =
    PrimValue -> PrimValue -> Bool
P.doCmpEq (IntValue -> PrimValue
P.IntValue IntValue
x) (IntValue -> PrimValue
P.IntValue IntValue
y)
  ValuePrim (UnsignedValue IntValue
x) == ValuePrim (UnsignedValue IntValue
y) =
    PrimValue -> PrimValue -> Bool
P.doCmpEq (IntValue -> PrimValue
P.IntValue IntValue
x) (IntValue -> PrimValue
P.IntValue IntValue
y)
  ValuePrim (FloatValue FloatValue
x) == ValuePrim (FloatValue FloatValue
y) =
    PrimValue -> PrimValue -> Bool
P.doCmpEq (FloatValue -> PrimValue
P.FloatValue FloatValue
x) (FloatValue -> PrimValue
P.FloatValue FloatValue
y)
  ValuePrim (BoolValue Bool
x) == ValuePrim (BoolValue Bool
y) =
    PrimValue -> PrimValue -> Bool
P.doCmpEq (Bool -> PrimValue
P.BoolValue Bool
x) (Bool -> PrimValue
P.BoolValue Bool
y)
  ValueArray ValueShape
_ Array Int (Value m)
x == ValueArray ValueShape
_ Array Int (Value m)
y = Array Int (Value m)
x forall a. Eq a => a -> a -> Bool
== Array Int (Value m)
y
  ValueRecord Map Name (Value m)
x == ValueRecord Map Name (Value m)
y = Map Name (Value m)
x forall a. Eq a => a -> a -> Bool
== Map Name (Value m)
y
  ValueSum ValueShape
_ Name
n1 [Value m]
vs1 == ValueSum ValueShape
_ Name
n2 [Value m]
vs2 = Name
n1 forall a. Eq a => a -> a -> Bool
== Name
n2 Bool -> Bool -> Bool
&& [Value m]
vs1 forall a. Eq a => a -> a -> Bool
== [Value m]
vs2
  ValueAcc Value m -> Value m -> m (Value m)
_ Array Int (Value m)
x == ValueAcc Value m -> Value m -> m (Value m)
_ Array Int (Value m)
y = Array Int (Value m)
x forall a. Eq a => a -> a -> Bool
== Array Int (Value m)
y
  Value m
_ == Value m
_ = Bool
False

prettyValueWith :: (PrimValue -> Doc a) -> Value m -> Doc a
prettyValueWith :: forall a (m :: * -> *). (PrimValue -> Doc a) -> Value m -> Doc a
prettyValueWith PrimValue -> Doc a
pprPrim = forall {m :: * -> *}. Int -> Value m -> Doc a
pprPrec Int
0
  where
    pprPrec :: Int -> Value m -> Doc a
pprPrec Int
_ (ValuePrim PrimValue
v) = PrimValue -> Doc a
pprPrim PrimValue
v
    pprPrec Int
_ (ValueArray ValueShape
_ Array Int (Value m)
a) =
      let elements :: [Value m]
elements = forall i e. Array i e -> [e]
elems Array Int (Value m)
a -- [Value]
          separator :: [Doc ann] -> Doc ann
separator = case [Value m]
elements of
            ValueArray ValueShape
_ Array Int (Value m)
_ : [Value m]
_ -> forall ann. [Doc ann] -> Doc ann
vsep
            [Value m]
_ -> forall ann. [Doc ann] -> Doc ann
hsep
       in forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
separator forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Value m -> Doc a
pprElem [Value m]
elements
    pprPrec Int
_ (ValueRecord Map Name (Value m)
m) = forall a ann. (a -> Doc ann) -> Map Name a -> Doc ann
prettyRecord (Int -> Value m -> Doc a
pprPrec Int
0) Map Name (Value m)
m
    pprPrec Int
_ ValueFun {} = Doc a
"#<fun>"
    pprPrec Int
_ ValueAcc {} = Doc a
"#<acc>"
    pprPrec Int
p (ValueSum ValueShape
_ Name
n [Value m]
vs) =
      forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Ord a => a -> a -> Bool
> (Int
0 :: Int)) forall a b. (a -> b) -> a -> b
$ Doc a
"#" forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
sep (forall a ann. Pretty a => a -> Doc ann
pretty Name
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> Value m -> Doc a
pprPrec Int
1) [Value m]
vs)
    pprElem :: Value m -> Doc a
pprElem v :: Value m
v@ValueArray {} = Int -> Value m -> Doc a
pprPrec Int
0 Value m
v
    pprElem Value m
v = forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ Int -> Value m -> Doc a
pprPrec Int
0 Value m
v

-- | Prettyprint value.
prettyValue :: Value m -> Doc a
prettyValue :: forall (m :: * -> *) a. Value m -> Doc a
prettyValue = forall a (m :: * -> *). (PrimValue -> Doc a) -> Value m -> Doc a
prettyValueWith forall {ann}. PrimValue -> Doc ann
pprPrim
  where
    pprPrim :: PrimValue -> Doc ann
pprPrim (UnsignedValue (Int8Value Int8
v)) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v :: Word8)
    pprPrim (UnsignedValue (Int16Value Int16
v)) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v :: Word16)
    pprPrim (UnsignedValue (Int32Value Int32
v)) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v :: Word32)
    pprPrim (UnsignedValue (Int64Value Int64
v)) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v :: Word64)
    pprPrim (SignedValue (Int8Value Int8
v)) = forall a ann. Pretty a => a -> Doc ann
pretty Int8
v
    pprPrim (SignedValue (Int16Value Int16
v)) = forall a ann. Pretty a => a -> Doc ann
pretty Int16
v
    pprPrim (SignedValue (Int32Value Int32
v)) = forall a ann. Pretty a => a -> Doc ann
pretty Int32
v
    pprPrim (SignedValue (Int64Value Int64
v)) = forall a ann. Pretty a => a -> Doc ann
pretty Int64
v
    pprPrim (BoolValue Bool
True) = Doc ann
"true"
    pprPrim (BoolValue Bool
False) = Doc ann
"false"
    pprPrim (FloatValue (Float16Value Half
v)) = forall {a} {ann}. (RealFloat a, Show a) => Doc ann -> a -> Doc ann
pprFloat Doc ann
"f16." Half
v
    pprPrim (FloatValue (Float32Value Float
v)) = forall {a} {ann}. (RealFloat a, Show a) => Doc ann -> a -> Doc ann
pprFloat Doc ann
"f32." Float
v
    pprPrim (FloatValue (Float64Value Double
v)) = forall {a} {ann}. (RealFloat a, Show a) => Doc ann -> a -> Doc ann
pprFloat Doc ann
"f64." Double
v
    pprFloat :: Doc ann -> a -> Doc ann
pprFloat Doc ann
t a
v
      | forall a. RealFloat a => a -> Bool
isInfinite a
v, a
v forall a. Ord a => a -> a -> Bool
>= a
0 = Doc ann
t forall a. Semigroup a => a -> a -> a
<> Doc ann
"inf"
      | forall a. RealFloat a => a -> Bool
isInfinite a
v, a
v forall a. Ord a => a -> a -> Bool
< a
0 = Doc ann
"-" forall a. Semigroup a => a -> a -> a
<> Doc ann
t forall a. Semigroup a => a -> a -> a
<> Doc ann
"inf"
      | forall a. RealFloat a => a -> Bool
isNaN a
v = Doc ann
t forall a. Semigroup a => a -> a -> a
<> Doc ann
"nan"
      | Bool
otherwise = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
v

-- | The value in the textual format.
valueText :: Value m -> T.Text
valueText :: forall (m :: * -> *). Value m -> Text
valueText = forall a. Doc a -> Text
docText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (PrimValue -> Doc a) -> Value m -> Doc a
prettyValueWith forall a ann. Pretty a => a -> Doc ann
pretty

valueShape :: Value m -> ValueShape
valueShape :: forall (m :: * -> *). Value m -> ValueShape
valueShape (ValueArray ValueShape
shape Array Int (Value m)
_) = ValueShape
shape
valueShape (ValueRecord Map Name (Value m)
fs) = forall d. Map Name (Shape d) -> Shape d
ShapeRecord forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall (m :: * -> *). Value m -> ValueShape
valueShape Map Name (Value m)
fs
valueShape (ValueSum ValueShape
shape Name
_ [Value m]
_) = ValueShape
shape
valueShape Value m
_ = forall d. Shape d
ShapeLeaf

-- | Does the value correspond to an empty array?
isEmptyArray :: Value m -> Bool
isEmptyArray :: forall (m :: * -> *). Value m -> Bool
isEmptyArray = ValueShape -> Bool
emptyShape forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Value m -> ValueShape
valueShape

-- | String representation of an empty array with the provided element
-- type.  This is pretty ad-hoc - don't expect good results unless the
-- element type is a primitive.
prettyEmptyArray :: TypeBase () () -> Value m -> T.Text
prettyEmptyArray :: forall (m :: * -> *). TypeBase () () -> Value m -> Text
prettyEmptyArray TypeBase () ()
t Value m
v =
  Text
"empty(" forall a. Semigroup a => a -> a -> a
<> forall {a}. Pretty a => Shape a -> Text
dims (forall (m :: * -> *). Value m -> ValueShape
valueShape Value m
v) forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText TypeBase () ()
t' forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    t' :: TypeBase () ()
t' = forall dim as. Int -> TypeBase dim as -> TypeBase dim as
stripArray (forall dim as. TypeBase dim as -> Int
arrayRank TypeBase () ()
t) TypeBase () ()
t
    dims :: Shape a -> Text
dims (ShapeDim a
n Shape a
rowshape) =
      Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText a
n forall a. Semigroup a => a -> a -> a
<> Text
"]" forall a. Semigroup a => a -> a -> a
<> Shape a -> Text
dims Shape a
rowshape
    dims Shape a
_ = Text
""

toArray :: ValueShape -> [Value m] -> Value m
toArray :: forall (m :: * -> *). ValueShape -> [Value m] -> Value m
toArray ValueShape
shape [Value m]
vs = forall (m :: * -> *). ValueShape -> Array Int (Value m) -> Value m
ValueArray ValueShape
shape (forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value m]
vs forall a. Num a => a -> a -> a
- Int
1) [Value m]
vs)

toArray' :: ValueShape -> [Value m] -> Value m
toArray' :: forall (m :: * -> *). ValueShape -> [Value m] -> Value m
toArray' ValueShape
rowshape [Value m]
vs = forall (m :: * -> *). ValueShape -> Array Int (Value m) -> Value m
ValueArray ValueShape
shape (forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value m]
vs forall a. Num a => a -> a -> a
- Int
1) [Value m]
vs)
  where
    shape :: ValueShape
shape = forall d. d -> Shape d -> Shape d
ShapeDim (forall i a. Num i => [a] -> i
genericLength [Value m]
vs) ValueShape
rowshape

arrayLength :: Integral int => Array Int (Value m) -> int
arrayLength :: forall int (m :: * -> *).
Integral int =>
Array Int (Value m) -> int
arrayLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> (i, i)
bounds

toTuple :: [Value m] -> Value m
toTuple :: forall (m :: * -> *). [Value m] -> Value m
toTuple = forall (m :: * -> *). Map Name (Value m) -> Value m
ValueRecord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
tupleFieldNames

fromTuple :: Value m -> Maybe [Value m]
fromTuple :: forall (m :: * -> *). Value m -> Maybe [Value m]
fromTuple (ValueRecord Map Name (Value m)
m) = forall a. Map Name a -> Maybe [a]
areTupleFields Map Name (Value m)
m
fromTuple Value m
_ = forall a. Maybe a
Nothing

fromDataShape :: V.Vector Int -> ValueShape
fromDataShape :: Vector Int -> ValueShape
fromDataShape = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall d. d -> Shape d -> Shape d
ShapeDim forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall d. Shape d
ShapeLeaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Vector a -> [a]
SVec.toList

fromDataValueWith ::
  SVec.Storable a =>
  (a -> PrimValue) ->
  SVec.Vector Int ->
  SVec.Vector a ->
  Value m
fromDataValueWith :: forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith a -> PrimValue
f Vector Int
shape Vector a
vector
  | forall a. Storable a => Vector a -> Bool
SVec.null Vector Int
shape = forall (m :: * -> *). PrimValue -> Value m
ValuePrim forall a b. (a -> b) -> a -> b
$ a -> PrimValue
f forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Vector a -> a
SVec.head Vector a
vector
  | forall a. Storable a => Vector a -> Bool
SVec.null Vector a
vector =
      forall (m :: * -> *). ValueShape -> [Value m] -> Value m
toArray (Vector Int -> ValueShape
fromDataShape Vector Int
shape) forall a b. (a -> b) -> a -> b
$
        forall a. Int -> a -> [a]
replicate (forall a. Storable a => Vector a -> a
SVec.head Vector Int
shape) (forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith a -> PrimValue
f Vector Int
shape' Vector a
vector)
  | Bool
otherwise =
      forall (m :: * -> *). ValueShape -> [Value m] -> Value m
toArray (Vector Int -> ValueShape
fromDataShape Vector Int
shape)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith a -> PrimValue
f Vector Int
shape' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => [a] -> Vector a
SVec.fromList)
        forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [[a]]
chunk (forall a. (Storable a, Num a) => Vector a -> a
SVec.product Vector Int
shape') (forall a. Storable a => Vector a -> [a]
SVec.toList Vector a
vector)
  where
    shape' :: Vector Int
shape' = forall a. Storable a => Vector a -> Vector a
SVec.tail Vector Int
shape

-- | Convert a Futhark value in the externally observable data format
-- to an interpreter value.
fromDataValue :: V.Value -> Value m
fromDataValue :: forall (m :: * -> *). Value -> Value m
fromDataValue (V.I8Value Vector Int
shape Vector Int8
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
SignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value) Vector Int
shape Vector Int8
vector
fromDataValue (V.I16Value Vector Int
shape Vector Int16
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
SignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value) Vector Int
shape Vector Int16
vector
fromDataValue (V.I32Value Vector Int
shape Vector Int32
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
SignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value) Vector Int
shape Vector Int32
vector
fromDataValue (V.I64Value Vector Int
shape Vector Int64
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
SignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value) Vector Int
shape Vector Int64
vector
fromDataValue (V.U8Value Vector Int
shape Vector Word8
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
UnsignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Vector Int
shape Vector Word8
vector
fromDataValue (V.U16Value Vector Int
shape Vector Word16
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
UnsignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Vector Int
shape Vector Word16
vector
fromDataValue (V.U32Value Vector Int
shape Vector Word32
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
UnsignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Vector Int
shape Vector Word32
vector
fromDataValue (V.U64Value Vector Int
shape Vector Word64
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (IntValue -> PrimValue
UnsignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Vector Int
shape Vector Word64
vector
fromDataValue (V.F16Value Vector Int
shape Vector Half
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (FloatValue -> PrimValue
FloatValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> FloatValue
Float16Value) Vector Int
shape Vector Half
vector
fromDataValue (V.F32Value Vector Int
shape Vector Float
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (FloatValue -> PrimValue
FloatValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> FloatValue
Float32Value) Vector Int
shape Vector Float
vector
fromDataValue (V.F64Value Vector Int
shape Vector Double
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith (FloatValue -> PrimValue
FloatValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FloatValue
Float64Value) Vector Int
shape Vector Double
vector
fromDataValue (V.BoolValue Vector Int
shape Vector Bool
vector) =
  forall a (m :: * -> *).
Storable a =>
(a -> PrimValue) -> Vector Int -> Vector a -> Value m
fromDataValueWith Bool -> PrimValue
BoolValue Vector Int
shape Vector Bool
vector