{-# LANGUAGE Strict #-}

-- | The most primitive ("core") aspects of the AST.  Split out of
-- "Futhark.IR.Syntax" in order for
-- "Futhark.IR.Rep" to use these definitions.  This
-- module is re-exported from "Futhark.IR.Syntax" and
-- there should be no reason to include it explicitly.
module Futhark.IR.Syntax.Core
  ( module Language.Futhark.Core,
    module Language.Futhark.Primitive,

    -- * Types
    Commutativity (..),
    Uniqueness (..),
    NoUniqueness (..),
    ShapeBase (..),
    Shape,
    stripDims,
    Ext (..),
    ExtSize,
    ExtShape,
    Rank (..),
    ArrayShape (..),
    Space (..),
    SpaceId,
    TypeBase (..),
    Type,
    ExtType,
    DeclType,
    DeclExtType,
    Diet (..),
    ErrorMsg (..),
    ErrorMsgPart (..),
    errorMsgArgTypes,

    -- * Entry point information
    ValueType (..),
    OpaqueType (..),
    OpaqueTypes (..),
    Signedness (..),
    EntryPointType (..),

    -- * Attributes
    Attr (..),
    Attrs (..),
    oneAttr,
    inAttrs,
    withoutAttrs,
    mapAttrs,

    -- * Values
    PrimValue (..),

    -- * Abstract syntax tree
    Ident (..),
    Certs (..),
    SubExp (..),
    Param (..),
    DimIndex (..),
    Slice (..),
    dimFix,
    sliceIndices,
    sliceDims,
    unitSlice,
    fixSlice,
    sliceSlice,
    PatElem (..),

    -- * Flat (LMAD) slices
    FlatSlice (..),
    FlatDimIndex (..),
    flatSliceDims,
    flatSliceStrides,
  )
where

import Control.Category
import Control.Monad.State
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Set qualified as S
import Data.String
import Data.Text qualified as T
import Data.Traversable (fmapDefault, foldMapDefault)
import Language.Futhark.Core
import Language.Futhark.Primitive
import Prelude hiding (id, (.))

-- | Whether some operator is commutative or not.  The 'Monoid'
-- instance returns the least commutative of its arguments.
data Commutativity
  = Noncommutative
  | Commutative
  deriving (Commutativity -> Commutativity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commutativity -> Commutativity -> Bool
$c/= :: Commutativity -> Commutativity -> Bool
== :: Commutativity -> Commutativity -> Bool
$c== :: Commutativity -> Commutativity -> Bool
Eq, Eq Commutativity
Commutativity -> Commutativity -> Bool
Commutativity -> Commutativity -> Ordering
Commutativity -> Commutativity -> Commutativity
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 :: Commutativity -> Commutativity -> Commutativity
$cmin :: Commutativity -> Commutativity -> Commutativity
max :: Commutativity -> Commutativity -> Commutativity
$cmax :: Commutativity -> Commutativity -> Commutativity
>= :: Commutativity -> Commutativity -> Bool
$c>= :: Commutativity -> Commutativity -> Bool
> :: Commutativity -> Commutativity -> Bool
$c> :: Commutativity -> Commutativity -> Bool
<= :: Commutativity -> Commutativity -> Bool
$c<= :: Commutativity -> Commutativity -> Bool
< :: Commutativity -> Commutativity -> Bool
$c< :: Commutativity -> Commutativity -> Bool
compare :: Commutativity -> Commutativity -> Ordering
$ccompare :: Commutativity -> Commutativity -> Ordering
Ord, Int -> Commutativity -> ShowS
[Commutativity] -> ShowS
Commutativity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Commutativity] -> ShowS
$cshowList :: [Commutativity] -> ShowS
show :: Commutativity -> String
$cshow :: Commutativity -> String
showsPrec :: Int -> Commutativity -> ShowS
$cshowsPrec :: Int -> Commutativity -> ShowS
Show)

instance Semigroup Commutativity where
  <> :: Commutativity -> Commutativity -> Commutativity
(<>) = forall a. Ord a => a -> a -> a
min

instance Monoid Commutativity where
  mempty :: Commutativity
mempty = Commutativity
Commutative

-- | The size of an array type as a list of its dimension sizes, with
-- the type of sizes being parametric.
newtype ShapeBase d = Shape {forall d. ShapeBase d -> [d]
shapeDims :: [d]}
  deriving (ShapeBase d -> ShapeBase d -> Bool
forall d. Eq d => ShapeBase d -> ShapeBase d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeBase d -> ShapeBase d -> Bool
$c/= :: forall d. Eq d => ShapeBase d -> ShapeBase d -> Bool
== :: ShapeBase d -> ShapeBase d -> Bool
$c== :: forall d. Eq d => ShapeBase d -> ShapeBase d -> Bool
Eq, ShapeBase d -> ShapeBase d -> Bool
ShapeBase d -> ShapeBase d -> Ordering
ShapeBase d -> ShapeBase d -> ShapeBase d
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
forall {d}. Ord d => Eq (ShapeBase d)
forall d. Ord d => ShapeBase d -> ShapeBase d -> Bool
forall d. Ord d => ShapeBase d -> ShapeBase d -> Ordering
forall d. Ord d => ShapeBase d -> ShapeBase d -> ShapeBase d
min :: ShapeBase d -> ShapeBase d -> ShapeBase d
$cmin :: forall d. Ord d => ShapeBase d -> ShapeBase d -> ShapeBase d
max :: ShapeBase d -> ShapeBase d -> ShapeBase d
$cmax :: forall d. Ord d => ShapeBase d -> ShapeBase d -> ShapeBase d
>= :: ShapeBase d -> ShapeBase d -> Bool
$c>= :: forall d. Ord d => ShapeBase d -> ShapeBase d -> Bool
> :: ShapeBase d -> ShapeBase d -> Bool
$c> :: forall d. Ord d => ShapeBase d -> ShapeBase d -> Bool
<= :: ShapeBase d -> ShapeBase d -> Bool
$c<= :: forall d. Ord d => ShapeBase d -> ShapeBase d -> Bool
< :: ShapeBase d -> ShapeBase d -> Bool
$c< :: forall d. Ord d => ShapeBase d -> ShapeBase d -> Bool
compare :: ShapeBase d -> ShapeBase d -> Ordering
$ccompare :: forall d. Ord d => ShapeBase d -> ShapeBase d -> Ordering
Ord, Int -> ShapeBase d -> ShowS
forall d. Show d => Int -> ShapeBase d -> ShowS
forall d. Show d => [ShapeBase d] -> ShowS
forall d. Show d => ShapeBase d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapeBase d] -> ShowS
$cshowList :: forall d. Show d => [ShapeBase d] -> ShowS
show :: ShapeBase d -> String
$cshow :: forall d. Show d => ShapeBase d -> String
showsPrec :: Int -> ShapeBase d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> ShapeBase d -> ShowS
Show)

instance Functor ShapeBase where
  fmap :: forall a b. (a -> b) -> ShapeBase a -> ShapeBase b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable ShapeBase where
  foldMap :: forall m a. Monoid m => (a -> m) -> ShapeBase a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable ShapeBase where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ShapeBase a -> f (ShapeBase b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall d. [d] -> ShapeBase d
Shape forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall d. ShapeBase d -> [d]
shapeDims

instance Semigroup (ShapeBase d) where
  Shape [d]
l1 <> :: ShapeBase d -> ShapeBase d -> ShapeBase d
<> Shape [d]
l2 = forall d. [d] -> ShapeBase d
Shape forall a b. (a -> b) -> a -> b
$ [d]
l1 forall a. Monoid a => a -> a -> a
`mappend` [d]
l2

instance Monoid (ShapeBase d) where
  mempty :: ShapeBase d
mempty = forall d. [d] -> ShapeBase d
Shape forall a. Monoid a => a
mempty

-- | @stripDims n shape@ strips the outer @n@ dimensions from
-- @shape@.
stripDims :: Int -> ShapeBase d -> ShapeBase d
stripDims :: forall d. Int -> ShapeBase d -> ShapeBase d
stripDims Int
n (Shape [d]
dims) = forall d. [d] -> ShapeBase d
Shape forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
n [d]
dims

-- | The size of an array as a list of subexpressions.  If a variable,
-- that variable must be in scope where this array is used.
type Shape = ShapeBase SubExp

-- | Something that may be existential.
data Ext a
  = Ext Int
  | Free a
  deriving (Ext a -> Ext a -> Bool
forall a. Eq a => Ext a -> Ext a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ext a -> Ext a -> Bool
$c/= :: forall a. Eq a => Ext a -> Ext a -> Bool
== :: Ext a -> Ext a -> Bool
$c== :: forall a. Eq a => Ext a -> Ext a -> Bool
Eq, Ext a -> Ext a -> Bool
Ext a -> Ext a -> Ordering
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
forall {a}. Ord a => Eq (Ext a)
forall a. Ord a => Ext a -> Ext a -> Bool
forall a. Ord a => Ext a -> Ext a -> Ordering
forall a. Ord a => Ext a -> Ext a -> Ext a
min :: Ext a -> Ext a -> Ext a
$cmin :: forall a. Ord a => Ext a -> Ext a -> Ext a
max :: Ext a -> Ext a -> Ext a
$cmax :: forall a. Ord a => Ext a -> Ext a -> Ext a
>= :: Ext a -> Ext a -> Bool
$c>= :: forall a. Ord a => Ext a -> Ext a -> Bool
> :: Ext a -> Ext a -> Bool
$c> :: forall a. Ord a => Ext a -> Ext a -> Bool
<= :: Ext a -> Ext a -> Bool
$c<= :: forall a. Ord a => Ext a -> Ext a -> Bool
< :: Ext a -> Ext a -> Bool
$c< :: forall a. Ord a => Ext a -> Ext a -> Bool
compare :: Ext a -> Ext a -> Ordering
$ccompare :: forall a. Ord a => Ext a -> Ext a -> Ordering
Ord, Int -> Ext a -> ShowS
forall a. Show a => Int -> Ext a -> ShowS
forall a. Show a => [Ext a] -> ShowS
forall a. Show a => Ext a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ext a] -> ShowS
$cshowList :: forall a. Show a => [Ext a] -> ShowS
show :: Ext a -> String
$cshow :: forall a. Show a => Ext a -> String
showsPrec :: Int -> Ext a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Ext a -> ShowS
Show)

instance Functor Ext where
  fmap :: forall a b. (a -> b) -> Ext a -> Ext b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable Ext where
  foldMap :: forall m a. Monoid m => (a -> m) -> Ext a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable Ext where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ext a -> f (Ext b)
traverse a -> f b
_ (Ext Int
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> Ext a
Ext Int
i
  traverse a -> f b
f (Free a
v) = forall a. a -> Ext a
Free forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v

-- | The size of this dimension.
type ExtSize = Ext SubExp

-- | Like t'Shape' but some of its elements may be bound in a local
-- environment instead.  These are denoted with integral indices.
type ExtShape = ShapeBase ExtSize

-- | The size of an array type as merely the number of dimensions,
-- with no further information.
newtype Rank = Rank Int
  deriving (Int -> Rank -> ShowS
[Rank] -> ShowS
Rank -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rank] -> ShowS
$cshowList :: [Rank] -> ShowS
show :: Rank -> String
$cshow :: Rank -> String
showsPrec :: Int -> Rank -> ShowS
$cshowsPrec :: Int -> Rank -> ShowS
Show, Rank -> Rank -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rank -> Rank -> Bool
$c/= :: Rank -> Rank -> Bool
== :: Rank -> Rank -> Bool
$c== :: Rank -> Rank -> Bool
Eq, Eq Rank
Rank -> Rank -> Bool
Rank -> Rank -> Ordering
Rank -> Rank -> Rank
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 :: Rank -> Rank -> Rank
$cmin :: Rank -> Rank -> Rank
max :: Rank -> Rank -> Rank
$cmax :: Rank -> Rank -> Rank
>= :: Rank -> Rank -> Bool
$c>= :: Rank -> Rank -> Bool
> :: Rank -> Rank -> Bool
$c> :: Rank -> Rank -> Bool
<= :: Rank -> Rank -> Bool
$c<= :: Rank -> Rank -> Bool
< :: Rank -> Rank -> Bool
$c< :: Rank -> Rank -> Bool
compare :: Rank -> Rank -> Ordering
$ccompare :: Rank -> Rank -> Ordering
Ord)

-- | A class encompassing types containing array shape information.
class (Monoid a, Eq a, Ord a) => ArrayShape a where
  -- | Return the rank of an array with the given size.
  shapeRank :: a -> Int

  -- | Check whether one shape if a subset of another shape.
  subShapeOf :: a -> a -> Bool

instance ArrayShape (ShapeBase SubExp) where
  shapeRank :: ShapeBase SubExp -> Int
shapeRank (Shape [SubExp]
l) = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SubExp]
l
  subShapeOf :: ShapeBase SubExp -> ShapeBase SubExp -> Bool
subShapeOf = forall a. Eq a => a -> a -> Bool
(==)

instance ArrayShape (ShapeBase ExtSize) where
  shapeRank :: ShapeBase ExtSize -> Int
shapeRank (Shape [ExtSize]
l) = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExtSize]
l
  subShapeOf :: ShapeBase ExtSize -> ShapeBase ExtSize -> Bool
subShapeOf (Shape [ExtSize]
ds1) (Shape [ExtSize]
ds2) =
    -- Must agree on Free dimensions, and ds1 may not be existential
    -- where ds2 is Free.  Existentials must also be congruent.
    forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExtSize]
ds1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExtSize]
ds2
      Bool -> Bool -> Bool
&& forall s a. State s a -> s -> a
evalState (forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall {f :: * -> *} {a}.
(Eq a, MonadState (Map Int Int) f) =>
Ext a -> Ext a -> f Bool
subDimOf [ExtSize]
ds1 [ExtSize]
ds2) forall k a. Map k a
M.empty
    where
      subDimOf :: Ext a -> Ext a -> f Bool
subDimOf (Free a
se1) (Free a
se2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a
se1 forall a. Eq a => a -> a -> Bool
== a
se2
      subDimOf (Ext Int
_) (Free a
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      subDimOf (Free a
_) (Ext Int
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      subDimOf (Ext Int
x) (Ext Int
y) = do
        Map Int Int
extmap <- forall s (m :: * -> *). MonadState s m => m s
get
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
y Map Int Int
extmap of
          Just Int
ywas
            | Int
ywas forall a. Eq a => a -> a -> Bool
== Int
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            | Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          Maybe Int
Nothing -> do
            forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
y Int
x Map Int Int
extmap
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

instance Semigroup Rank where
  Rank Int
x <> :: Rank -> Rank -> Rank
<> Rank Int
y = Int -> Rank
Rank forall a b. (a -> b) -> a -> b
$ Int
x forall a. Num a => a -> a -> a
+ Int
y

instance Monoid Rank where
  mempty :: Rank
mempty = Int -> Rank
Rank Int
0

instance ArrayShape Rank where
  shapeRank :: Rank -> Int
shapeRank (Rank Int
x) = Int
x
  subShapeOf :: Rank -> Rank -> Bool
subShapeOf = forall a. Eq a => a -> a -> Bool
(==)

-- | The memory space of a block.  If 'DefaultSpace', this is the "default"
-- space, whatever that is.  The exact meaning of the 'SpaceId'
-- depends on the backend used.  In GPU kernels, for example, this is
-- used to distinguish between constant, global and shared memory
-- spaces.  In GPU-enabled host code, it is used to distinguish
-- between host memory ('DefaultSpace') and GPU space.
data Space
  = DefaultSpace
  | Space SpaceId
  | -- | A special kind of memory that is a statically sized
    -- array of some primitive type.  Used for private memory
    -- on GPUs.
    ScalarSpace [SubExp] PrimType
  deriving (Int -> Space -> ShowS
[Space] -> ShowS
Space -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Space] -> ShowS
$cshowList :: [Space] -> ShowS
show :: Space -> String
$cshow :: Space -> String
showsPrec :: Int -> Space -> ShowS
$cshowsPrec :: Int -> Space -> ShowS
Show, Space -> Space -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Space -> Space -> Bool
$c/= :: Space -> Space -> Bool
== :: Space -> Space -> Bool
$c== :: Space -> Space -> Bool
Eq, Eq Space
Space -> Space -> Bool
Space -> Space -> Ordering
Space -> Space -> Space
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 :: Space -> Space -> Space
$cmin :: Space -> Space -> Space
max :: Space -> Space -> Space
$cmax :: Space -> Space -> Space
>= :: Space -> Space -> Bool
$c>= :: Space -> Space -> Bool
> :: Space -> Space -> Bool
$c> :: Space -> Space -> Bool
<= :: Space -> Space -> Bool
$c<= :: Space -> Space -> Bool
< :: Space -> Space -> Bool
$c< :: Space -> Space -> Bool
compare :: Space -> Space -> Ordering
$ccompare :: Space -> Space -> Ordering
Ord)

-- | A string representing a specific non-default memory space.
type SpaceId = String

-- | A fancier name for @()@ - encodes no uniqueness information.
data NoUniqueness = NoUniqueness
  deriving (NoUniqueness -> NoUniqueness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoUniqueness -> NoUniqueness -> Bool
$c/= :: NoUniqueness -> NoUniqueness -> Bool
== :: NoUniqueness -> NoUniqueness -> Bool
$c== :: NoUniqueness -> NoUniqueness -> Bool
Eq, Eq NoUniqueness
NoUniqueness -> NoUniqueness -> Bool
NoUniqueness -> NoUniqueness -> Ordering
NoUniqueness -> NoUniqueness -> NoUniqueness
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 :: NoUniqueness -> NoUniqueness -> NoUniqueness
$cmin :: NoUniqueness -> NoUniqueness -> NoUniqueness
max :: NoUniqueness -> NoUniqueness -> NoUniqueness
$cmax :: NoUniqueness -> NoUniqueness -> NoUniqueness
>= :: NoUniqueness -> NoUniqueness -> Bool
$c>= :: NoUniqueness -> NoUniqueness -> Bool
> :: NoUniqueness -> NoUniqueness -> Bool
$c> :: NoUniqueness -> NoUniqueness -> Bool
<= :: NoUniqueness -> NoUniqueness -> Bool
$c<= :: NoUniqueness -> NoUniqueness -> Bool
< :: NoUniqueness -> NoUniqueness -> Bool
$c< :: NoUniqueness -> NoUniqueness -> Bool
compare :: NoUniqueness -> NoUniqueness -> Ordering
$ccompare :: NoUniqueness -> NoUniqueness -> Ordering
Ord, Int -> NoUniqueness -> ShowS
[NoUniqueness] -> ShowS
NoUniqueness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoUniqueness] -> ShowS
$cshowList :: [NoUniqueness] -> ShowS
show :: NoUniqueness -> String
$cshow :: NoUniqueness -> String
showsPrec :: Int -> NoUniqueness -> ShowS
$cshowsPrec :: Int -> NoUniqueness -> ShowS
Show)

instance Semigroup NoUniqueness where
  NoUniqueness
NoUniqueness <> :: NoUniqueness -> NoUniqueness -> NoUniqueness
<> NoUniqueness
NoUniqueness = NoUniqueness
NoUniqueness

instance Monoid NoUniqueness where
  mempty :: NoUniqueness
mempty = NoUniqueness
NoUniqueness

-- | The type of a value.  When comparing types for equality with
-- '==', shapes must match.
data TypeBase shape u
  = Prim PrimType
  | -- | Token, index space, element type, and uniqueness.
    Acc VName Shape [Type] u
  | Array PrimType shape u
  | Mem Space
  deriving (Int -> TypeBase shape u -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall shape u.
(Show u, Show shape) =>
Int -> TypeBase shape u -> ShowS
forall shape u. (Show u, Show shape) => [TypeBase shape u] -> ShowS
forall shape u. (Show u, Show shape) => TypeBase shape u -> String
showList :: [TypeBase shape u] -> ShowS
$cshowList :: forall shape u. (Show u, Show shape) => [TypeBase shape u] -> ShowS
show :: TypeBase shape u -> String
$cshow :: forall shape u. (Show u, Show shape) => TypeBase shape u -> String
showsPrec :: Int -> TypeBase shape u -> ShowS
$cshowsPrec :: forall shape u.
(Show u, Show shape) =>
Int -> TypeBase shape u -> ShowS
Show, TypeBase shape u -> TypeBase shape u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall shape u.
(Eq u, Eq shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
/= :: TypeBase shape u -> TypeBase shape u -> Bool
$c/= :: forall shape u.
(Eq u, Eq shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
== :: TypeBase shape u -> TypeBase shape u -> Bool
$c== :: forall shape u.
(Eq u, Eq shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
Eq, TypeBase shape u -> TypeBase shape u -> Ordering
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
forall {shape} {u}. (Ord u, Ord shape) => Eq (TypeBase shape u)
forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> Ordering
forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> TypeBase shape u
min :: TypeBase shape u -> TypeBase shape u -> TypeBase shape u
$cmin :: forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> TypeBase shape u
max :: TypeBase shape u -> TypeBase shape u -> TypeBase shape u
$cmax :: forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> TypeBase shape u
>= :: TypeBase shape u -> TypeBase shape u -> Bool
$c>= :: forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
> :: TypeBase shape u -> TypeBase shape u -> Bool
$c> :: forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
<= :: TypeBase shape u -> TypeBase shape u -> Bool
$c<= :: forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
< :: TypeBase shape u -> TypeBase shape u -> Bool
$c< :: forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> Bool
compare :: TypeBase shape u -> TypeBase shape u -> Ordering
$ccompare :: forall shape u.
(Ord u, Ord shape) =>
TypeBase shape u -> TypeBase shape u -> Ordering
Ord)

instance Bitraversable TypeBase where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
bitraverse a -> f c
f b -> f d
g (Array PrimType
t a
shape b
u) = forall shape u. PrimType -> shape -> u -> TypeBase shape u
Array PrimType
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
shape forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
u
  bitraverse a -> f c
_ b -> f d
_ (Prim PrimType
pt) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall shape u. PrimType -> TypeBase shape u
Prim PrimType
pt
  bitraverse a -> f c
_ b -> f d
g (Acc VName
arrs ShapeBase SubExp
ispace [Type]
ts b
u) = forall shape u.
VName -> ShapeBase SubExp -> [Type] -> u -> TypeBase shape u
Acc VName
arrs ShapeBase SubExp
ispace [Type]
ts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
u
  bitraverse a -> f c
_ b -> f d
_ (Mem Space
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall shape u. Space -> TypeBase shape u
Mem Space
s

instance Bifunctor TypeBase where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> TypeBase a c -> TypeBase b d
bimap = forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault

instance Bifoldable TypeBase where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> TypeBase a b -> m
bifoldMap = forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault

-- | A type with shape information, used for describing the type of
-- variables.
type Type = TypeBase Shape NoUniqueness

-- | A type with existentially quantified shapes - used as part of
-- function (and function-like) return types.  Generally only makes
-- sense when used in a list.
type ExtType = TypeBase ExtShape NoUniqueness

-- | A type with shape and uniqueness information, used declaring
-- return- and parameters types.
type DeclType = TypeBase Shape Uniqueness

-- | An 'ExtType' with uniqueness information, used for function
-- return types.
type DeclExtType = TypeBase ExtShape Uniqueness

-- | Information about which parts of a value/type are consumed.  For
-- example, we might say that a function taking three arguments of
-- types @([int], *[int], [int])@ has diet @[Observe, Consume,
-- Observe]@.
data Diet
  = -- | Consumes this value.
    Consume
  | -- | Only observes value in this position, does
    -- not consume.  A result may alias this.
    Observe
  | -- | As 'Observe', but the result will not
    -- alias, because the parameter does not carry
    -- aliases.
    ObservePrim
  deriving (Diet -> Diet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diet -> Diet -> Bool
$c/= :: Diet -> Diet -> Bool
== :: Diet -> Diet -> Bool
$c== :: Diet -> Diet -> Bool
Eq, Eq Diet
Diet -> Diet -> Bool
Diet -> Diet -> Ordering
Diet -> Diet -> Diet
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 :: Diet -> Diet -> Diet
$cmin :: Diet -> Diet -> Diet
max :: Diet -> Diet -> Diet
$cmax :: Diet -> Diet -> Diet
>= :: Diet -> Diet -> Bool
$c>= :: Diet -> Diet -> Bool
> :: Diet -> Diet -> Bool
$c> :: Diet -> Diet -> Bool
<= :: Diet -> Diet -> Bool
$c<= :: Diet -> Diet -> Bool
< :: Diet -> Diet -> Bool
$c< :: Diet -> Diet -> Bool
compare :: Diet -> Diet -> Ordering
$ccompare :: Diet -> Diet -> Ordering
Ord, Int -> Diet -> ShowS
[Diet] -> ShowS
Diet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diet] -> ShowS
$cshowList :: [Diet] -> ShowS
show :: Diet -> String
$cshow :: Diet -> String
showsPrec :: Int -> Diet -> ShowS
$cshowsPrec :: Int -> Diet -> ShowS
Show)

-- | An identifier consists of its name and the type of the value
-- bound to the identifier.
data Ident = Ident
  { Ident -> VName
identName :: VName,
    Ident -> Type
identType :: Type
  }
  deriving (Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show)

instance Eq Ident where
  Ident
x == :: Ident -> Ident -> Bool
== Ident
y = Ident -> VName
identName Ident
x forall a. Eq a => a -> a -> Bool
== Ident -> VName
identName Ident
y

instance Ord Ident where
  Ident
x compare :: Ident -> Ident -> Ordering
`compare` Ident
y = Ident -> VName
identName Ident
x forall a. Ord a => a -> a -> Ordering
`compare` Ident -> VName
identName Ident
y

-- | A list of names used for certificates in some expressions.
newtype Certs = Certs {Certs -> [VName]
unCerts :: [VName]}
  deriving (Certs -> Certs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Certs -> Certs -> Bool
$c/= :: Certs -> Certs -> Bool
== :: Certs -> Certs -> Bool
$c== :: Certs -> Certs -> Bool
Eq, Eq Certs
Certs -> Certs -> Bool
Certs -> Certs -> Ordering
Certs -> Certs -> Certs
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 :: Certs -> Certs -> Certs
$cmin :: Certs -> Certs -> Certs
max :: Certs -> Certs -> Certs
$cmax :: Certs -> Certs -> Certs
>= :: Certs -> Certs -> Bool
$c>= :: Certs -> Certs -> Bool
> :: Certs -> Certs -> Bool
$c> :: Certs -> Certs -> Bool
<= :: Certs -> Certs -> Bool
$c<= :: Certs -> Certs -> Bool
< :: Certs -> Certs -> Bool
$c< :: Certs -> Certs -> Bool
compare :: Certs -> Certs -> Ordering
$ccompare :: Certs -> Certs -> Ordering
Ord, Int -> Certs -> ShowS
[Certs] -> ShowS
Certs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Certs] -> ShowS
$cshowList :: [Certs] -> ShowS
show :: Certs -> String
$cshow :: Certs -> String
showsPrec :: Int -> Certs -> ShowS
$cshowsPrec :: Int -> Certs -> ShowS
Show)

instance Semigroup Certs where
  Certs [VName]
x <> :: Certs -> Certs -> Certs
<> Certs [VName]
y = [VName] -> Certs
Certs ([VName]
x forall a. Semigroup a => a -> a -> a
<> [VName]
y)

instance Monoid Certs where
  mempty :: Certs
mempty = [VName] -> Certs
Certs forall a. Monoid a => a
mempty

-- | A subexpression is either a scalar constant or a variable.  One
-- important property is that evaluation of a subexpression is
-- guaranteed to complete in constant time.
data SubExp
  = Constant PrimValue
  | Var VName
  deriving (Int -> SubExp -> ShowS
[SubExp] -> ShowS
SubExp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubExp] -> ShowS
$cshowList :: [SubExp] -> ShowS
show :: SubExp -> String
$cshow :: SubExp -> String
showsPrec :: Int -> SubExp -> ShowS
$cshowsPrec :: Int -> SubExp -> ShowS
Show, SubExp -> SubExp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubExp -> SubExp -> Bool
$c/= :: SubExp -> SubExp -> Bool
== :: SubExp -> SubExp -> Bool
$c== :: SubExp -> SubExp -> Bool
Eq, Eq SubExp
SubExp -> SubExp -> Bool
SubExp -> SubExp -> Ordering
SubExp -> SubExp -> SubExp
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 :: SubExp -> SubExp -> SubExp
$cmin :: SubExp -> SubExp -> SubExp
max :: SubExp -> SubExp -> SubExp
$cmax :: SubExp -> SubExp -> SubExp
>= :: SubExp -> SubExp -> Bool
$c>= :: SubExp -> SubExp -> Bool
> :: SubExp -> SubExp -> Bool
$c> :: SubExp -> SubExp -> Bool
<= :: SubExp -> SubExp -> Bool
$c<= :: SubExp -> SubExp -> Bool
< :: SubExp -> SubExp -> Bool
$c< :: SubExp -> SubExp -> Bool
compare :: SubExp -> SubExp -> Ordering
$ccompare :: SubExp -> SubExp -> Ordering
Ord)

-- | A function or lambda parameter.
data Param dec = Param
  { -- | Attributes of the parameter.  When constructing a parameter,
    -- feel free to just pass 'mempty'.
    forall dec. Param dec -> Attrs
paramAttrs :: Attrs,
    -- | Name of the parameter.
    forall dec. Param dec -> VName
paramName :: VName,
    -- | Function parameter decoration.
    forall dec. Param dec -> dec
paramDec :: dec
  }
  deriving (Param dec -> Param dec -> Bool
Param dec -> Param dec -> Ordering
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
forall {dec}. Ord dec => Eq (Param dec)
forall dec. Ord dec => Param dec -> Param dec -> Bool
forall dec. Ord dec => Param dec -> Param dec -> Ordering
forall dec. Ord dec => Param dec -> Param dec -> Param dec
min :: Param dec -> Param dec -> Param dec
$cmin :: forall dec. Ord dec => Param dec -> Param dec -> Param dec
max :: Param dec -> Param dec -> Param dec
$cmax :: forall dec. Ord dec => Param dec -> Param dec -> Param dec
>= :: Param dec -> Param dec -> Bool
$c>= :: forall dec. Ord dec => Param dec -> Param dec -> Bool
> :: Param dec -> Param dec -> Bool
$c> :: forall dec. Ord dec => Param dec -> Param dec -> Bool
<= :: Param dec -> Param dec -> Bool
$c<= :: forall dec. Ord dec => Param dec -> Param dec -> Bool
< :: Param dec -> Param dec -> Bool
$c< :: forall dec. Ord dec => Param dec -> Param dec -> Bool
compare :: Param dec -> Param dec -> Ordering
$ccompare :: forall dec. Ord dec => Param dec -> Param dec -> Ordering
Ord, Int -> Param dec -> ShowS
forall dec. Show dec => Int -> Param dec -> ShowS
forall dec. Show dec => [Param dec] -> ShowS
forall dec. Show dec => Param dec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Param dec] -> ShowS
$cshowList :: forall dec. Show dec => [Param dec] -> ShowS
show :: Param dec -> String
$cshow :: forall dec. Show dec => Param dec -> String
showsPrec :: Int -> Param dec -> ShowS
$cshowsPrec :: forall dec. Show dec => Int -> Param dec -> ShowS
Show, Param dec -> Param dec -> Bool
forall dec. Eq dec => Param dec -> Param dec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Param dec -> Param dec -> Bool
$c/= :: forall dec. Eq dec => Param dec -> Param dec -> Bool
== :: Param dec -> Param dec -> Bool
$c== :: forall dec. Eq dec => Param dec -> Param dec -> Bool
Eq)

instance Foldable Param where
  foldMap :: forall m a. Monoid m => (a -> m) -> Param a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Functor Param where
  fmap :: forall a b. (a -> b) -> Param a -> Param b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Traversable Param where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Param a -> f (Param b)
traverse a -> f b
f (Param Attrs
attr VName
name a
dec) = forall dec. Attrs -> VName -> dec -> Param dec
Param Attrs
attr VName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
dec

-- | How to index a single dimension of an array.
data DimIndex d
  = -- | Fix index in this dimension.
    DimFix d
  | -- | @DimSlice start_offset num_elems stride@.
    DimSlice d d d
  deriving (DimIndex d -> DimIndex d -> Bool
forall d. Eq d => DimIndex d -> DimIndex d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DimIndex d -> DimIndex d -> Bool
$c/= :: forall d. Eq d => DimIndex d -> DimIndex d -> Bool
== :: DimIndex d -> DimIndex d -> Bool
$c== :: forall d. Eq d => DimIndex d -> DimIndex d -> Bool
Eq, DimIndex d -> DimIndex d -> Bool
DimIndex d -> DimIndex d -> Ordering
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
forall {d}. Ord d => Eq (DimIndex d)
forall d. Ord d => DimIndex d -> DimIndex d -> Bool
forall d. Ord d => DimIndex d -> DimIndex d -> Ordering
forall d. Ord d => DimIndex d -> DimIndex d -> DimIndex d
min :: DimIndex d -> DimIndex d -> DimIndex d
$cmin :: forall d. Ord d => DimIndex d -> DimIndex d -> DimIndex d
max :: DimIndex d -> DimIndex d -> DimIndex d
$cmax :: forall d. Ord d => DimIndex d -> DimIndex d -> DimIndex d
>= :: DimIndex d -> DimIndex d -> Bool
$c>= :: forall d. Ord d => DimIndex d -> DimIndex d -> Bool
> :: DimIndex d -> DimIndex d -> Bool
$c> :: forall d. Ord d => DimIndex d -> DimIndex d -> Bool
<= :: DimIndex d -> DimIndex d -> Bool
$c<= :: forall d. Ord d => DimIndex d -> DimIndex d -> Bool
< :: DimIndex d -> DimIndex d -> Bool
$c< :: forall d. Ord d => DimIndex d -> DimIndex d -> Bool
compare :: DimIndex d -> DimIndex d -> Ordering
$ccompare :: forall d. Ord d => DimIndex d -> DimIndex d -> Ordering
Ord, Int -> DimIndex d -> ShowS
forall d. Show d => Int -> DimIndex d -> ShowS
forall d. Show d => [DimIndex d] -> ShowS
forall d. Show d => DimIndex d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DimIndex d] -> ShowS
$cshowList :: forall d. Show d => [DimIndex d] -> ShowS
show :: DimIndex d -> String
$cshow :: forall d. Show d => DimIndex d -> String
showsPrec :: Int -> DimIndex d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> DimIndex d -> ShowS
Show)

instance Functor DimIndex where
  fmap :: forall a b. (a -> b) -> DimIndex a -> DimIndex b
fmap a -> b
f (DimFix a
i) = forall d. d -> DimIndex d
DimFix forall a b. (a -> b) -> a -> b
$ a -> b
f a
i
  fmap a -> b
f (DimSlice a
i a
j a
s) = forall d. d -> d -> d -> DimIndex d
DimSlice (a -> b
f a
i) (a -> b
f a
j) (a -> b
f a
s)

instance Foldable DimIndex where
  foldMap :: forall m a. Monoid m => (a -> m) -> DimIndex a -> m
foldMap a -> m
f (DimFix a
d) = a -> m
f a
d
  foldMap a -> m
f (DimSlice a
i a
j a
s) = a -> m
f a
i forall a. Semigroup a => a -> a -> a
<> a -> m
f a
j forall a. Semigroup a => a -> a -> a
<> a -> m
f a
s

instance Traversable DimIndex where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DimIndex a -> f (DimIndex b)
traverse a -> f b
f (DimFix a
d) = forall d. d -> DimIndex d
DimFix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
d
  traverse a -> f b
f (DimSlice a
i a
j a
s) = forall d. d -> d -> d -> DimIndex d
DimSlice forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
j forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
s

-- | A list of 'DimIndex's, indicating how an array should be sliced.
-- Whenever a function accepts a 'Slice', that slice should be total,
-- i.e, cover all dimensions of the array.  Deviators should be
-- indicated by taking a list of 'DimIndex'es instead.
newtype Slice d = Slice {forall d. Slice d -> [DimIndex d]
unSlice :: [DimIndex d]}
  deriving (Slice d -> Slice d -> Bool
forall d. Eq d => Slice d -> Slice d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slice d -> Slice d -> Bool
$c/= :: forall d. Eq d => Slice d -> Slice d -> Bool
== :: Slice d -> Slice d -> Bool
$c== :: forall d. Eq d => Slice d -> Slice d -> Bool
Eq, Slice d -> Slice d -> Bool
Slice d -> Slice d -> Ordering
Slice d -> Slice d -> Slice d
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
forall {d}. Ord d => Eq (Slice d)
forall d. Ord d => Slice d -> Slice d -> Bool
forall d. Ord d => Slice d -> Slice d -> Ordering
forall d. Ord d => Slice d -> Slice d -> Slice d
min :: Slice d -> Slice d -> Slice d
$cmin :: forall d. Ord d => Slice d -> Slice d -> Slice d
max :: Slice d -> Slice d -> Slice d
$cmax :: forall d. Ord d => Slice d -> Slice d -> Slice d
>= :: Slice d -> Slice d -> Bool
$c>= :: forall d. Ord d => Slice d -> Slice d -> Bool
> :: Slice d -> Slice d -> Bool
$c> :: forall d. Ord d => Slice d -> Slice d -> Bool
<= :: Slice d -> Slice d -> Bool
$c<= :: forall d. Ord d => Slice d -> Slice d -> Bool
< :: Slice d -> Slice d -> Bool
$c< :: forall d. Ord d => Slice d -> Slice d -> Bool
compare :: Slice d -> Slice d -> Ordering
$ccompare :: forall d. Ord d => Slice d -> Slice d -> Ordering
Ord, Int -> Slice d -> ShowS
forall d. Show d => Int -> Slice d -> ShowS
forall d. Show d => [Slice d] -> ShowS
forall d. Show d => Slice d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slice d] -> ShowS
$cshowList :: forall d. Show d => [Slice d] -> ShowS
show :: Slice d -> String
$cshow :: forall d. Show d => Slice d -> String
showsPrec :: Int -> Slice d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Slice d -> ShowS
Show)

instance Traversable Slice where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Slice a -> f (Slice b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall d. [DimIndex d] -> Slice d
Slice forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall d. Slice d -> [DimIndex d]
unSlice

instance Functor Slice where
  fmap :: forall a b. (a -> b) -> Slice a -> Slice b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable Slice where
  foldMap :: forall m a. Monoid m => (a -> m) -> Slice a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

-- | If the argument is a 'DimFix', return its component.
dimFix :: DimIndex d -> Maybe d
dimFix :: forall d. DimIndex d -> Maybe d
dimFix (DimFix d
d) = forall a. a -> Maybe a
Just d
d
dimFix DimIndex d
_ = forall a. Maybe a
Nothing

-- | If the slice is all 'DimFix's, return the components.
sliceIndices :: Slice d -> Maybe [d]
sliceIndices :: forall d. Slice d -> Maybe [d]
sliceIndices = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall d. DimIndex d -> Maybe d
dimFix forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall d. Slice d -> [DimIndex d]
unSlice

-- | The dimensions of the array produced by this slice.
sliceDims :: Slice d -> [d]
sliceDims :: forall a. Slice a -> [a]
sliceDims = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall d. DimIndex d -> Maybe d
dimSlice forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall d. Slice d -> [DimIndex d]
unSlice
  where
    dimSlice :: DimIndex a -> Maybe a
dimSlice (DimSlice a
_ a
d a
_) = forall a. a -> Maybe a
Just a
d
    dimSlice DimFix {} = forall a. Maybe a
Nothing

-- | A slice with a stride of one.
unitSlice :: Num d => d -> d -> DimIndex d
unitSlice :: forall d. Num d => d -> d -> DimIndex d
unitSlice d
offset d
n = forall d. d -> d -> d -> DimIndex d
DimSlice d
offset d
n d
1

-- | Fix the 'DimSlice's of a slice.  The number of indexes must equal
-- the length of 'sliceDims' for the slice.
fixSlice :: Num d => Slice d -> [d] -> [d]
fixSlice :: forall d. Num d => Slice d -> [d] -> [d]
fixSlice = forall {a}. Num a => [DimIndex a] -> [a] -> [a]
fixSlice' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall d. Slice d -> [DimIndex d]
unSlice
  where
    fixSlice' :: [DimIndex a] -> [a] -> [a]
fixSlice' (DimFix a
j : [DimIndex a]
mis') [a]
is' =
      a
j forall a. a -> [a] -> [a]
: [DimIndex a] -> [a] -> [a]
fixSlice' [DimIndex a]
mis' [a]
is'
    fixSlice' (DimSlice a
orig_k a
_ a
orig_s : [DimIndex a]
mis') (a
i : [a]
is') =
      (a
orig_k forall a. Num a => a -> a -> a
+ a
i forall a. Num a => a -> a -> a
* a
orig_s) forall a. a -> [a] -> [a]
: [DimIndex a] -> [a] -> [a]
fixSlice' [DimIndex a]
mis' [a]
is'
    fixSlice' [DimIndex a]
_ [a]
_ = []

-- | Further slice the 'DimSlice's of a slice.  The number of slices
-- must equal the length of 'sliceDims' for the slice.
sliceSlice :: Num d => Slice d -> Slice d -> Slice d
sliceSlice :: forall d. Num d => Slice d -> Slice d -> Slice d
sliceSlice (Slice [DimIndex d]
jslice) (Slice [DimIndex d]
islice) = forall d. [DimIndex d] -> Slice d
Slice forall a b. (a -> b) -> a -> b
$ forall {d}. Num d => [DimIndex d] -> [DimIndex d] -> [DimIndex d]
sliceSlice' [DimIndex d]
jslice [DimIndex d]
islice
  where
    sliceSlice' :: [DimIndex d] -> [DimIndex d] -> [DimIndex d]
sliceSlice' (DimFix d
j : [DimIndex d]
js') [DimIndex d]
is' =
      forall d. d -> DimIndex d
DimFix d
j forall a. a -> [a] -> [a]
: [DimIndex d] -> [DimIndex d] -> [DimIndex d]
sliceSlice' [DimIndex d]
js' [DimIndex d]
is'
    sliceSlice' (DimSlice d
j d
_ d
s : [DimIndex d]
js') (DimFix d
i : [DimIndex d]
is') =
      forall d. d -> DimIndex d
DimFix (d
j forall a. Num a => a -> a -> a
+ (d
i forall a. Num a => a -> a -> a
* d
s)) forall a. a -> [a] -> [a]
: [DimIndex d] -> [DimIndex d] -> [DimIndex d]
sliceSlice' [DimIndex d]
js' [DimIndex d]
is'
    sliceSlice' (DimSlice d
j d
_ d
s0 : [DimIndex d]
js') (DimSlice d
i d
n d
s1 : [DimIndex d]
is') =
      forall d. d -> d -> d -> DimIndex d
DimSlice (d
j forall a. Num a => a -> a -> a
+ (d
s0 forall a. Num a => a -> a -> a
* d
i)) d
n (d
s0 forall a. Num a => a -> a -> a
* d
s1) forall a. a -> [a] -> [a]
: [DimIndex d] -> [DimIndex d] -> [DimIndex d]
sliceSlice' [DimIndex d]
js' [DimIndex d]
is'
    sliceSlice' [DimIndex d]
_ [DimIndex d]
_ = []

-- | A dimension in a 'FlatSlice'.
data FlatDimIndex d
  = FlatDimIndex
      d
      -- ^ Number of elements in dimension
      d
      -- ^ Stride of dimension
  deriving (FlatDimIndex d -> FlatDimIndex d -> Bool
forall d. Eq d => FlatDimIndex d -> FlatDimIndex d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlatDimIndex d -> FlatDimIndex d -> Bool
$c/= :: forall d. Eq d => FlatDimIndex d -> FlatDimIndex d -> Bool
== :: FlatDimIndex d -> FlatDimIndex d -> Bool
$c== :: forall d. Eq d => FlatDimIndex d -> FlatDimIndex d -> Bool
Eq, FlatDimIndex d -> FlatDimIndex d -> Bool
FlatDimIndex d -> FlatDimIndex d -> Ordering
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
forall {d}. Ord d => Eq (FlatDimIndex d)
forall d. Ord d => FlatDimIndex d -> FlatDimIndex d -> Bool
forall d. Ord d => FlatDimIndex d -> FlatDimIndex d -> Ordering
forall d.
Ord d =>
FlatDimIndex d -> FlatDimIndex d -> FlatDimIndex d
min :: FlatDimIndex d -> FlatDimIndex d -> FlatDimIndex d
$cmin :: forall d.
Ord d =>
FlatDimIndex d -> FlatDimIndex d -> FlatDimIndex d
max :: FlatDimIndex d -> FlatDimIndex d -> FlatDimIndex d
$cmax :: forall d.
Ord d =>
FlatDimIndex d -> FlatDimIndex d -> FlatDimIndex d
>= :: FlatDimIndex d -> FlatDimIndex d -> Bool
$c>= :: forall d. Ord d => FlatDimIndex d -> FlatDimIndex d -> Bool
> :: FlatDimIndex d -> FlatDimIndex d -> Bool
$c> :: forall d. Ord d => FlatDimIndex d -> FlatDimIndex d -> Bool
<= :: FlatDimIndex d -> FlatDimIndex d -> Bool
$c<= :: forall d. Ord d => FlatDimIndex d -> FlatDimIndex d -> Bool
< :: FlatDimIndex d -> FlatDimIndex d -> Bool
$c< :: forall d. Ord d => FlatDimIndex d -> FlatDimIndex d -> Bool
compare :: FlatDimIndex d -> FlatDimIndex d -> Ordering
$ccompare :: forall d. Ord d => FlatDimIndex d -> FlatDimIndex d -> Ordering
Ord, Int -> FlatDimIndex d -> ShowS
forall d. Show d => Int -> FlatDimIndex d -> ShowS
forall d. Show d => [FlatDimIndex d] -> ShowS
forall d. Show d => FlatDimIndex d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlatDimIndex d] -> ShowS
$cshowList :: forall d. Show d => [FlatDimIndex d] -> ShowS
show :: FlatDimIndex d -> String
$cshow :: forall d. Show d => FlatDimIndex d -> String
showsPrec :: Int -> FlatDimIndex d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> FlatDimIndex d -> ShowS
Show)

instance Traversable FlatDimIndex where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlatDimIndex a -> f (FlatDimIndex b)
traverse a -> f b
f (FlatDimIndex a
n a
s) = forall d. d -> d -> FlatDimIndex d
FlatDimIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
n forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
s

instance Functor FlatDimIndex where
  fmap :: forall a b. (a -> b) -> FlatDimIndex a -> FlatDimIndex b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable FlatDimIndex where
  foldMap :: forall m a. Monoid m => (a -> m) -> FlatDimIndex a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

-- | A flat slice is a way of viewing a one-dimensional array as a
-- multi-dimensional array, using a more compressed mechanism than
-- reshaping and using 'Slice'.  The initial @d@ is an offset, and the
-- list then specifies the shape of the resulting array.
data FlatSlice d = FlatSlice d [FlatDimIndex d]
  deriving (FlatSlice d -> FlatSlice d -> Bool
forall d. Eq d => FlatSlice d -> FlatSlice d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlatSlice d -> FlatSlice d -> Bool
$c/= :: forall d. Eq d => FlatSlice d -> FlatSlice d -> Bool
== :: FlatSlice d -> FlatSlice d -> Bool
$c== :: forall d. Eq d => FlatSlice d -> FlatSlice d -> Bool
Eq, FlatSlice d -> FlatSlice d -> Bool
FlatSlice d -> FlatSlice d -> Ordering
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
forall {d}. Ord d => Eq (FlatSlice d)
forall d. Ord d => FlatSlice d -> FlatSlice d -> Bool
forall d. Ord d => FlatSlice d -> FlatSlice d -> Ordering
forall d. Ord d => FlatSlice d -> FlatSlice d -> FlatSlice d
min :: FlatSlice d -> FlatSlice d -> FlatSlice d
$cmin :: forall d. Ord d => FlatSlice d -> FlatSlice d -> FlatSlice d
max :: FlatSlice d -> FlatSlice d -> FlatSlice d
$cmax :: forall d. Ord d => FlatSlice d -> FlatSlice d -> FlatSlice d
>= :: FlatSlice d -> FlatSlice d -> Bool
$c>= :: forall d. Ord d => FlatSlice d -> FlatSlice d -> Bool
> :: FlatSlice d -> FlatSlice d -> Bool
$c> :: forall d. Ord d => FlatSlice d -> FlatSlice d -> Bool
<= :: FlatSlice d -> FlatSlice d -> Bool
$c<= :: forall d. Ord d => FlatSlice d -> FlatSlice d -> Bool
< :: FlatSlice d -> FlatSlice d -> Bool
$c< :: forall d. Ord d => FlatSlice d -> FlatSlice d -> Bool
compare :: FlatSlice d -> FlatSlice d -> Ordering
$ccompare :: forall d. Ord d => FlatSlice d -> FlatSlice d -> Ordering
Ord, Int -> FlatSlice d -> ShowS
forall d. Show d => Int -> FlatSlice d -> ShowS
forall d. Show d => [FlatSlice d] -> ShowS
forall d. Show d => FlatSlice d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlatSlice d] -> ShowS
$cshowList :: forall d. Show d => [FlatSlice d] -> ShowS
show :: FlatSlice d -> String
$cshow :: forall d. Show d => FlatSlice d -> String
showsPrec :: Int -> FlatSlice d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> FlatSlice d -> ShowS
Show)

instance Traversable FlatSlice where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlatSlice a -> f (FlatSlice b)
traverse a -> f b
f (FlatSlice a
offset [FlatDimIndex a]
is) =
    forall d. d -> [FlatDimIndex d] -> FlatSlice d
FlatSlice forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
offset forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) [FlatDimIndex a]
is

instance Functor FlatSlice where
  fmap :: forall a b. (a -> b) -> FlatSlice a -> FlatSlice b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable FlatSlice where
  foldMap :: forall m a. Monoid m => (a -> m) -> FlatSlice a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

-- | The dimensions (shape) of the view produced by a flat slice.
flatSliceDims :: FlatSlice d -> [d]
flatSliceDims :: forall a. FlatSlice a -> [a]
flatSliceDims (FlatSlice d
_ [FlatDimIndex d]
ds) = forall a b. (a -> b) -> [a] -> [b]
map forall {d}. FlatDimIndex d -> d
dimSlice [FlatDimIndex d]
ds
  where
    dimSlice :: FlatDimIndex d -> d
dimSlice (FlatDimIndex d
n d
_) = d
n

-- | The strides of each dimension produced by a flat slice.
flatSliceStrides :: FlatSlice d -> [d]
flatSliceStrides :: forall a. FlatSlice a -> [a]
flatSliceStrides (FlatSlice d
_ [FlatDimIndex d]
ds) = forall a b. (a -> b) -> [a] -> [b]
map forall {d}. FlatDimIndex d -> d
dimStride [FlatDimIndex d]
ds
  where
    dimStride :: FlatDimIndex d -> d
dimStride (FlatDimIndex d
_ d
s) = d
s

-- | An element of a pattern - consisting of a name and an addditional
-- parametric decoration.  This decoration is what is expected to
-- contain the type of the resulting variable.
data PatElem dec = PatElem
  { -- | The name being bound.
    forall dec. PatElem dec -> VName
patElemName :: VName,
    -- | Pat element decoration.
    forall dec. PatElem dec -> dec
patElemDec :: dec
  }
  deriving (PatElem dec -> PatElem dec -> Bool
PatElem dec -> PatElem dec -> Ordering
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
forall {dec}. Ord dec => Eq (PatElem dec)
forall dec. Ord dec => PatElem dec -> PatElem dec -> Bool
forall dec. Ord dec => PatElem dec -> PatElem dec -> Ordering
forall dec. Ord dec => PatElem dec -> PatElem dec -> PatElem dec
min :: PatElem dec -> PatElem dec -> PatElem dec
$cmin :: forall dec. Ord dec => PatElem dec -> PatElem dec -> PatElem dec
max :: PatElem dec -> PatElem dec -> PatElem dec
$cmax :: forall dec. Ord dec => PatElem dec -> PatElem dec -> PatElem dec
>= :: PatElem dec -> PatElem dec -> Bool
$c>= :: forall dec. Ord dec => PatElem dec -> PatElem dec -> Bool
> :: PatElem dec -> PatElem dec -> Bool
$c> :: forall dec. Ord dec => PatElem dec -> PatElem dec -> Bool
<= :: PatElem dec -> PatElem dec -> Bool
$c<= :: forall dec. Ord dec => PatElem dec -> PatElem dec -> Bool
< :: PatElem dec -> PatElem dec -> Bool
$c< :: forall dec. Ord dec => PatElem dec -> PatElem dec -> Bool
compare :: PatElem dec -> PatElem dec -> Ordering
$ccompare :: forall dec. Ord dec => PatElem dec -> PatElem dec -> Ordering
Ord, Int -> PatElem dec -> ShowS
forall dec. Show dec => Int -> PatElem dec -> ShowS
forall dec. Show dec => [PatElem dec] -> ShowS
forall dec. Show dec => PatElem dec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatElem dec] -> ShowS
$cshowList :: forall dec. Show dec => [PatElem dec] -> ShowS
show :: PatElem dec -> String
$cshow :: forall dec. Show dec => PatElem dec -> String
showsPrec :: Int -> PatElem dec -> ShowS
$cshowsPrec :: forall dec. Show dec => Int -> PatElem dec -> ShowS
Show, PatElem dec -> PatElem dec -> Bool
forall dec. Eq dec => PatElem dec -> PatElem dec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatElem dec -> PatElem dec -> Bool
$c/= :: forall dec. Eq dec => PatElem dec -> PatElem dec -> Bool
== :: PatElem dec -> PatElem dec -> Bool
$c== :: forall dec. Eq dec => PatElem dec -> PatElem dec -> Bool
Eq)

instance Functor PatElem where
  fmap :: forall a b. (a -> b) -> PatElem a -> PatElem b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable PatElem where
  foldMap :: forall m a. Monoid m => (a -> m) -> PatElem a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable PatElem where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatElem a -> f (PatElem b)
traverse a -> f b
f (PatElem VName
name a
dec) =
    forall dec. VName -> dec -> PatElem dec
PatElem VName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
dec

-- | An error message is a list of error parts, which are concatenated
-- to form the final message.
newtype ErrorMsg a = ErrorMsg [ErrorMsgPart a]
  deriving (ErrorMsg a -> ErrorMsg a -> Bool
forall a. Eq a => ErrorMsg a -> ErrorMsg a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorMsg a -> ErrorMsg a -> Bool
$c/= :: forall a. Eq a => ErrorMsg a -> ErrorMsg a -> Bool
== :: ErrorMsg a -> ErrorMsg a -> Bool
$c== :: forall a. Eq a => ErrorMsg a -> ErrorMsg a -> Bool
Eq, ErrorMsg a -> ErrorMsg a -> Bool
ErrorMsg a -> ErrorMsg a -> Ordering
ErrorMsg a -> ErrorMsg a -> ErrorMsg a
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
forall {a}. Ord a => Eq (ErrorMsg a)
forall a. Ord a => ErrorMsg a -> ErrorMsg a -> Bool
forall a. Ord a => ErrorMsg a -> ErrorMsg a -> Ordering
forall a. Ord a => ErrorMsg a -> ErrorMsg a -> ErrorMsg a
min :: ErrorMsg a -> ErrorMsg a -> ErrorMsg a
$cmin :: forall a. Ord a => ErrorMsg a -> ErrorMsg a -> ErrorMsg a
max :: ErrorMsg a -> ErrorMsg a -> ErrorMsg a
$cmax :: forall a. Ord a => ErrorMsg a -> ErrorMsg a -> ErrorMsg a
>= :: ErrorMsg a -> ErrorMsg a -> Bool
$c>= :: forall a. Ord a => ErrorMsg a -> ErrorMsg a -> Bool
> :: ErrorMsg a -> ErrorMsg a -> Bool
$c> :: forall a. Ord a => ErrorMsg a -> ErrorMsg a -> Bool
<= :: ErrorMsg a -> ErrorMsg a -> Bool
$c<= :: forall a. Ord a => ErrorMsg a -> ErrorMsg a -> Bool
< :: ErrorMsg a -> ErrorMsg a -> Bool
$c< :: forall a. Ord a => ErrorMsg a -> ErrorMsg a -> Bool
compare :: ErrorMsg a -> ErrorMsg a -> Ordering
$ccompare :: forall a. Ord a => ErrorMsg a -> ErrorMsg a -> Ordering
Ord, Int -> ErrorMsg a -> ShowS
forall a. Show a => Int -> ErrorMsg a -> ShowS
forall a. Show a => [ErrorMsg a] -> ShowS
forall a. Show a => ErrorMsg a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMsg a] -> ShowS
$cshowList :: forall a. Show a => [ErrorMsg a] -> ShowS
show :: ErrorMsg a -> String
$cshow :: forall a. Show a => ErrorMsg a -> String
showsPrec :: Int -> ErrorMsg a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ErrorMsg a -> ShowS
Show)

instance IsString (ErrorMsg a) where
  fromString :: String -> ErrorMsg a
fromString = forall a. [ErrorMsgPart a] -> ErrorMsg a
ErrorMsg forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString

-- | A part of an error message.
data ErrorMsgPart a
  = -- | A literal string.
    ErrorString T.Text
  | -- | A run-time value.
    ErrorVal PrimType a
  deriving (ErrorMsgPart a -> ErrorMsgPart a -> Bool
forall a. Eq a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorMsgPart a -> ErrorMsgPart a -> Bool
$c/= :: forall a. Eq a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
== :: ErrorMsgPart a -> ErrorMsgPart a -> Bool
$c== :: forall a. Eq a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
Eq, ErrorMsgPart a -> ErrorMsgPart a -> Bool
ErrorMsgPart a -> ErrorMsgPart a -> Ordering
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
forall {a}. Ord a => Eq (ErrorMsgPart a)
forall a. Ord a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
forall a. Ord a => ErrorMsgPart a -> ErrorMsgPart a -> Ordering
forall a.
Ord a =>
ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart a
min :: ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart a
$cmin :: forall a.
Ord a =>
ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart a
max :: ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart a
$cmax :: forall a.
Ord a =>
ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart a
>= :: ErrorMsgPart a -> ErrorMsgPart a -> Bool
$c>= :: forall a. Ord a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
> :: ErrorMsgPart a -> ErrorMsgPart a -> Bool
$c> :: forall a. Ord a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
<= :: ErrorMsgPart a -> ErrorMsgPart a -> Bool
$c<= :: forall a. Ord a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
< :: ErrorMsgPart a -> ErrorMsgPart a -> Bool
$c< :: forall a. Ord a => ErrorMsgPart a -> ErrorMsgPart a -> Bool
compare :: ErrorMsgPart a -> ErrorMsgPart a -> Ordering
$ccompare :: forall a. Ord a => ErrorMsgPart a -> ErrorMsgPart a -> Ordering
Ord, Int -> ErrorMsgPart a -> ShowS
forall a. Show a => Int -> ErrorMsgPart a -> ShowS
forall a. Show a => [ErrorMsgPart a] -> ShowS
forall a. Show a => ErrorMsgPart a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMsgPart a] -> ShowS
$cshowList :: forall a. Show a => [ErrorMsgPart a] -> ShowS
show :: ErrorMsgPart a -> String
$cshow :: forall a. Show a => ErrorMsgPart a -> String
showsPrec :: Int -> ErrorMsgPart a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ErrorMsgPart a -> ShowS
Show)

instance IsString (ErrorMsgPart a) where
  fromString :: String -> ErrorMsgPart a
fromString = forall a. Text -> ErrorMsgPart a
ErrorString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
T.pack

instance Functor ErrorMsg where
  fmap :: forall a b. (a -> b) -> ErrorMsg a -> ErrorMsg b
fmap a -> b
f (ErrorMsg [ErrorMsgPart a]
parts) = forall a. [ErrorMsgPart a] -> ErrorMsg a
ErrorMsg forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [ErrorMsgPart a]
parts

instance Foldable ErrorMsg where
  foldMap :: forall m a. Monoid m => (a -> m) -> ErrorMsg a -> m
foldMap a -> m
f (ErrorMsg [ErrorMsgPart a]
parts) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [ErrorMsgPart a]
parts

instance Traversable ErrorMsg where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrorMsg a -> f (ErrorMsg b)
traverse a -> f b
f (ErrorMsg [ErrorMsgPart a]
parts) = forall a. [ErrorMsgPart a] -> ErrorMsg a
ErrorMsg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) [ErrorMsgPart a]
parts

instance Functor ErrorMsgPart where
  fmap :: forall a b. (a -> b) -> ErrorMsgPart a -> ErrorMsgPart b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable ErrorMsgPart where
  foldMap :: forall m a. Monoid m => (a -> m) -> ErrorMsgPart a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable ErrorMsgPart where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrorMsgPart a -> f (ErrorMsgPart b)
traverse a -> f b
_ (ErrorString Text
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> ErrorMsgPart a
ErrorString Text
s
  traverse a -> f b
f (ErrorVal PrimType
t a
a) = forall a. PrimType -> a -> ErrorMsgPart a
ErrorVal PrimType
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

-- | How many non-constant parts does the error message have, and what
-- is their type?
errorMsgArgTypes :: ErrorMsg a -> [PrimType]
errorMsgArgTypes :: forall a. ErrorMsg a -> [PrimType]
errorMsgArgTypes (ErrorMsg [ErrorMsgPart a]
parts) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. ErrorMsgPart a -> Maybe PrimType
onPart [ErrorMsgPart a]
parts
  where
    onPart :: ErrorMsgPart a -> Maybe PrimType
onPart ErrorString {} = forall a. Maybe a
Nothing
    onPart (ErrorVal PrimType
t a
_) = forall a. a -> Maybe a
Just PrimType
t

-- | A single attribute.
data Attr
  = AttrName Name
  | AttrInt Integer
  | AttrComp Name [Attr]
  deriving (Eq Attr
Attr -> Attr -> Bool
Attr -> Attr -> Ordering
Attr -> Attr -> Attr
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 :: Attr -> Attr -> Attr
$cmin :: Attr -> Attr -> Attr
max :: Attr -> Attr -> Attr
$cmax :: Attr -> Attr -> Attr
>= :: Attr -> Attr -> Bool
$c>= :: Attr -> Attr -> Bool
> :: Attr -> Attr -> Bool
$c> :: Attr -> Attr -> Bool
<= :: Attr -> Attr -> Bool
$c<= :: Attr -> Attr -> Bool
< :: Attr -> Attr -> Bool
$c< :: Attr -> Attr -> Bool
compare :: Attr -> Attr -> Ordering
$ccompare :: Attr -> Attr -> Ordering
Ord, Int -> Attr -> ShowS
[Attr] -> ShowS
Attr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attr] -> ShowS
$cshowList :: [Attr] -> ShowS
show :: Attr -> String
$cshow :: Attr -> String
showsPrec :: Int -> Attr -> ShowS
$cshowsPrec :: Int -> Attr -> ShowS
Show, Attr -> Attr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attr -> Attr -> Bool
$c/= :: Attr -> Attr -> Bool
== :: Attr -> Attr -> Bool
$c== :: Attr -> Attr -> Bool
Eq)

instance IsString Attr where
  fromString :: String -> Attr
fromString = Name -> Attr
AttrName forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString

-- | Every statement is associated with a set of attributes, which can
-- have various effects throughout the compiler.
newtype Attrs = Attrs {Attrs -> Set Attr
unAttrs :: S.Set Attr}
  deriving (Eq Attrs
Attrs -> Attrs -> Bool
Attrs -> Attrs -> Ordering
Attrs -> Attrs -> Attrs
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 :: Attrs -> Attrs -> Attrs
$cmin :: Attrs -> Attrs -> Attrs
max :: Attrs -> Attrs -> Attrs
$cmax :: Attrs -> Attrs -> Attrs
>= :: Attrs -> Attrs -> Bool
$c>= :: Attrs -> Attrs -> Bool
> :: Attrs -> Attrs -> Bool
$c> :: Attrs -> Attrs -> Bool
<= :: Attrs -> Attrs -> Bool
$c<= :: Attrs -> Attrs -> Bool
< :: Attrs -> Attrs -> Bool
$c< :: Attrs -> Attrs -> Bool
compare :: Attrs -> Attrs -> Ordering
$ccompare :: Attrs -> Attrs -> Ordering
Ord, Int -> Attrs -> ShowS
[Attrs] -> ShowS
Attrs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attrs] -> ShowS
$cshowList :: [Attrs] -> ShowS
show :: Attrs -> String
$cshow :: Attrs -> String
showsPrec :: Int -> Attrs -> ShowS
$cshowsPrec :: Int -> Attrs -> ShowS
Show, Attrs -> Attrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attrs -> Attrs -> Bool
$c/= :: Attrs -> Attrs -> Bool
== :: Attrs -> Attrs -> Bool
$c== :: Attrs -> Attrs -> Bool
Eq, Semigroup Attrs
Attrs
[Attrs] -> Attrs
Attrs -> Attrs -> Attrs
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Attrs] -> Attrs
$cmconcat :: [Attrs] -> Attrs
mappend :: Attrs -> Attrs -> Attrs
$cmappend :: Attrs -> Attrs -> Attrs
mempty :: Attrs
$cmempty :: Attrs
Monoid, NonEmpty Attrs -> Attrs
Attrs -> Attrs -> Attrs
forall b. Integral b => b -> Attrs -> Attrs
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Attrs -> Attrs
$cstimes :: forall b. Integral b => b -> Attrs -> Attrs
sconcat :: NonEmpty Attrs -> Attrs
$csconcat :: NonEmpty Attrs -> Attrs
<> :: Attrs -> Attrs -> Attrs
$c<> :: Attrs -> Attrs -> Attrs
Semigroup)

-- | Construct 'Attrs' from a single 'Attr'.
oneAttr :: Attr -> Attrs
oneAttr :: Attr -> Attrs
oneAttr = Set Attr -> Attrs
Attrs forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Set a
S.singleton

-- | Is the given attribute to be found in the attribute set?
inAttrs :: Attr -> Attrs -> Bool
inAttrs :: Attr -> Attrs -> Bool
inAttrs Attr
attr (Attrs Set Attr
attrs) = Attr
attr forall a. Ord a => a -> Set a -> Bool
`S.member` Set Attr
attrs

-- | @x `withoutAttrs` y@ gives @x@ except for any attributes also in @y@.
withoutAttrs :: Attrs -> Attrs -> Attrs
withoutAttrs :: Attrs -> Attrs -> Attrs
withoutAttrs (Attrs Set Attr
x) (Attrs Set Attr
y) = Set Attr -> Attrs
Attrs forall a b. (a -> b) -> a -> b
$ Set Attr
x forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Attr
y

-- | Map a function over an attribute set.
mapAttrs :: (Attr -> a) -> Attrs -> [a]
mapAttrs :: forall a. (Attr -> a) -> Attrs -> [a]
mapAttrs Attr -> a
f (Attrs Set Attr
attrs) = forall a b. (a -> b) -> [a] -> [b]
map Attr -> a
f forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set Attr
attrs

-- | Since the core language does not care for signedness, but the
-- source language does, entry point input/output information has
-- metadata for integer types (and arrays containing these) that
-- indicate whether they are really unsigned integers.  This doesn't
-- matter for non-integer types.
data Signedness
  = Unsigned
  | Signed
  deriving (Signedness -> Signedness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signedness -> Signedness -> Bool
$c/= :: Signedness -> Signedness -> Bool
== :: Signedness -> Signedness -> Bool
$c== :: Signedness -> Signedness -> Bool
Eq, Eq Signedness
Signedness -> Signedness -> Bool
Signedness -> Signedness -> Ordering
Signedness -> Signedness -> Signedness
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 :: Signedness -> Signedness -> Signedness
$cmin :: Signedness -> Signedness -> Signedness
max :: Signedness -> Signedness -> Signedness
$cmax :: Signedness -> Signedness -> Signedness
>= :: Signedness -> Signedness -> Bool
$c>= :: Signedness -> Signedness -> Bool
> :: Signedness -> Signedness -> Bool
$c> :: Signedness -> Signedness -> Bool
<= :: Signedness -> Signedness -> Bool
$c<= :: Signedness -> Signedness -> Bool
< :: Signedness -> Signedness -> Bool
$c< :: Signedness -> Signedness -> Bool
compare :: Signedness -> Signedness -> Ordering
$ccompare :: Signedness -> Signedness -> Ordering
Ord, Int -> Signedness -> ShowS
[Signedness] -> ShowS
Signedness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signedness] -> ShowS
$cshowList :: [Signedness] -> ShowS
show :: Signedness -> String
$cshow :: Signedness -> String
showsPrec :: Int -> Signedness -> ShowS
$cshowsPrec :: Int -> Signedness -> ShowS
Show)

-- | An actual non-opaque type that can be passed to and from Futhark
-- programs, or serve as the contents of opaque types.  Scalars are
-- represented with zero rank.
data ValueType
  = ValueType Signedness Rank 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)

-- | Every entry point argument and return value has an annotation
-- indicating how it maps to the original source program type.
data EntryPointType
  = -- | An opaque type of this name.
    TypeOpaque String
  | -- | A transparent type, which is scalar if the rank is zero.
    TypeTransparent ValueType
  deriving (EntryPointType -> EntryPointType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntryPointType -> EntryPointType -> Bool
$c/= :: EntryPointType -> EntryPointType -> Bool
== :: EntryPointType -> EntryPointType -> Bool
$c== :: EntryPointType -> EntryPointType -> Bool
Eq, Int -> EntryPointType -> ShowS
[EntryPointType] -> ShowS
EntryPointType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryPointType] -> ShowS
$cshowList :: [EntryPointType] -> ShowS
show :: EntryPointType -> String
$cshow :: EntryPointType -> String
showsPrec :: Int -> EntryPointType -> ShowS
$cshowsPrec :: Int -> EntryPointType -> ShowS
Show, Eq EntryPointType
EntryPointType -> EntryPointType -> Bool
EntryPointType -> EntryPointType -> Ordering
EntryPointType -> EntryPointType -> EntryPointType
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 :: EntryPointType -> EntryPointType -> EntryPointType
$cmin :: EntryPointType -> EntryPointType -> EntryPointType
max :: EntryPointType -> EntryPointType -> EntryPointType
$cmax :: EntryPointType -> EntryPointType -> EntryPointType
>= :: EntryPointType -> EntryPointType -> Bool
$c>= :: EntryPointType -> EntryPointType -> Bool
> :: EntryPointType -> EntryPointType -> Bool
$c> :: EntryPointType -> EntryPointType -> Bool
<= :: EntryPointType -> EntryPointType -> Bool
$c<= :: EntryPointType -> EntryPointType -> Bool
< :: EntryPointType -> EntryPointType -> Bool
$c< :: EntryPointType -> EntryPointType -> Bool
compare :: EntryPointType -> EntryPointType -> Ordering
$ccompare :: EntryPointType -> EntryPointType -> Ordering
Ord)

-- | The representation of an opaque type.
data OpaqueType
  = OpaqueType [ValueType]
  | -- | Note that the field ordering here denote the actual
    -- representation - make sure it is preserved.
    OpaqueRecord [(Name, EntryPointType)]
  deriving (OpaqueType -> OpaqueType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpaqueType -> OpaqueType -> Bool
$c/= :: OpaqueType -> OpaqueType -> Bool
== :: OpaqueType -> OpaqueType -> Bool
$c== :: OpaqueType -> OpaqueType -> Bool
Eq, Eq OpaqueType
OpaqueType -> OpaqueType -> Bool
OpaqueType -> OpaqueType -> Ordering
OpaqueType -> OpaqueType -> OpaqueType
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 :: OpaqueType -> OpaqueType -> OpaqueType
$cmin :: OpaqueType -> OpaqueType -> OpaqueType
max :: OpaqueType -> OpaqueType -> OpaqueType
$cmax :: OpaqueType -> OpaqueType -> OpaqueType
>= :: OpaqueType -> OpaqueType -> Bool
$c>= :: OpaqueType -> OpaqueType -> Bool
> :: OpaqueType -> OpaqueType -> Bool
$c> :: OpaqueType -> OpaqueType -> Bool
<= :: OpaqueType -> OpaqueType -> Bool
$c<= :: OpaqueType -> OpaqueType -> Bool
< :: OpaqueType -> OpaqueType -> Bool
$c< :: OpaqueType -> OpaqueType -> Bool
compare :: OpaqueType -> OpaqueType -> Ordering
$ccompare :: OpaqueType -> OpaqueType -> Ordering
Ord, Int -> OpaqueType -> ShowS
[OpaqueType] -> ShowS
OpaqueType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpaqueType] -> ShowS
$cshowList :: [OpaqueType] -> ShowS
show :: OpaqueType -> String
$cshow :: OpaqueType -> String
showsPrec :: Int -> OpaqueType -> ShowS
$cshowsPrec :: Int -> OpaqueType -> ShowS
Show)

-- | Names of opaque types and their representation.
newtype OpaqueTypes = OpaqueTypes [(String, OpaqueType)]
  deriving (OpaqueTypes -> OpaqueTypes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpaqueTypes -> OpaqueTypes -> Bool
$c/= :: OpaqueTypes -> OpaqueTypes -> Bool
== :: OpaqueTypes -> OpaqueTypes -> Bool
$c== :: OpaqueTypes -> OpaqueTypes -> Bool
Eq, Eq OpaqueTypes
OpaqueTypes -> OpaqueTypes -> Bool
OpaqueTypes -> OpaqueTypes -> Ordering
OpaqueTypes -> OpaqueTypes -> OpaqueTypes
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 :: OpaqueTypes -> OpaqueTypes -> OpaqueTypes
$cmin :: OpaqueTypes -> OpaqueTypes -> OpaqueTypes
max :: OpaqueTypes -> OpaqueTypes -> OpaqueTypes
$cmax :: OpaqueTypes -> OpaqueTypes -> OpaqueTypes
>= :: OpaqueTypes -> OpaqueTypes -> Bool
$c>= :: OpaqueTypes -> OpaqueTypes -> Bool
> :: OpaqueTypes -> OpaqueTypes -> Bool
$c> :: OpaqueTypes -> OpaqueTypes -> Bool
<= :: OpaqueTypes -> OpaqueTypes -> Bool
$c<= :: OpaqueTypes -> OpaqueTypes -> Bool
< :: OpaqueTypes -> OpaqueTypes -> Bool
$c< :: OpaqueTypes -> OpaqueTypes -> Bool
compare :: OpaqueTypes -> OpaqueTypes -> Ordering
$ccompare :: OpaqueTypes -> OpaqueTypes -> Ordering
Ord, Int -> OpaqueTypes -> ShowS
[OpaqueTypes] -> ShowS
OpaqueTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpaqueTypes] -> ShowS
$cshowList :: [OpaqueTypes] -> ShowS
show :: OpaqueTypes -> String
$cshow :: OpaqueTypes -> String
showsPrec :: Int -> OpaqueTypes -> ShowS
$cshowsPrec :: Int -> OpaqueTypes -> ShowS
Show)

instance Monoid OpaqueTypes where
  mempty :: OpaqueTypes
mempty = [(String, OpaqueType)] -> OpaqueTypes
OpaqueTypes forall a. Monoid a => a
mempty

instance Semigroup OpaqueTypes where
  OpaqueTypes [(String, OpaqueType)]
x <> :: OpaqueTypes -> OpaqueTypes -> OpaqueTypes
<> OpaqueTypes [(String, OpaqueType)]
y =
    [(String, OpaqueType)] -> OpaqueTypes
OpaqueTypes forall a b. (a -> b) -> a -> b
$ [(String, OpaqueType)]
x forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, OpaqueType)]
x) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> a
fst) [(String, OpaqueType)]
y