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

-- | The most primitive ("core") aspects of the AST.  Split out of
-- "Futhark.IR.Syntax" in order for
-- "Futhark.IR.Decorations" 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 Futhark.IR.Primitive,

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

    -- * Values
    PrimValue (..),

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

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

-- | 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
(ShapeBase d -> ShapeBase d -> Bool)
-> (ShapeBase d -> ShapeBase d -> Bool) -> Eq (ShapeBase d)
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, Eq (ShapeBase d)
Eq (ShapeBase d)
-> (ShapeBase d -> ShapeBase d -> Ordering)
-> (ShapeBase d -> ShapeBase d -> Bool)
-> (ShapeBase d -> ShapeBase d -> Bool)
-> (ShapeBase d -> ShapeBase d -> Bool)
-> (ShapeBase d -> ShapeBase d -> Bool)
-> (ShapeBase d -> ShapeBase d -> ShapeBase d)
-> (ShapeBase d -> ShapeBase d -> ShapeBase d)
-> Ord (ShapeBase d)
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
[ShapeBase d] -> ShowS
ShapeBase d -> String
(Int -> ShapeBase d -> ShowS)
-> (ShapeBase d -> String)
-> ([ShapeBase d] -> ShowS)
-> Show (ShapeBase d)
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 = (a -> b) -> ShapeBase a -> ShapeBase b
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 = (a -> m) -> ShapeBase a -> m
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 = ([b] -> ShapeBase b) -> f [b] -> f (ShapeBase b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> ShapeBase b
forall d. [d] -> ShapeBase d
Shape (f [b] -> f (ShapeBase b))
-> (ShapeBase a -> f [b]) -> ShapeBase a -> f (ShapeBase b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f ([a] -> f [b]) -> (ShapeBase a -> [a]) -> ShapeBase a -> f [b]
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShapeBase a -> [a]
forall d. ShapeBase d -> [d]
shapeDims

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

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

-- | 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
(Ext a -> Ext a -> Bool) -> (Ext a -> Ext a -> Bool) -> Eq (Ext a)
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, Eq (Ext a)
Eq (Ext a)
-> (Ext a -> Ext a -> Ordering)
-> (Ext a -> Ext a -> Bool)
-> (Ext a -> Ext a -> Bool)
-> (Ext a -> Ext a -> Bool)
-> (Ext a -> Ext a -> Bool)
-> (Ext a -> Ext a -> Ext a)
-> (Ext a -> Ext a -> Ext a)
-> Ord (Ext a)
Ext a -> Ext a -> Bool
Ext a -> Ext a -> Ordering
Ext a -> Ext a -> Ext 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 (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
[Ext a] -> ShowS
Ext a -> String
(Int -> Ext a -> ShowS)
-> (Ext a -> String) -> ([Ext a] -> ShowS) -> Show (Ext a)
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 = (a -> b) -> Ext a -> Ext b
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 = (a -> m) -> Ext a -> m
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) = Ext b -> f (Ext b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ext b -> f (Ext b)) -> Ext b -> f (Ext b)
forall a b. (a -> b) -> a -> b
$ Int -> Ext b
forall a. Int -> Ext a
Ext Int
i
  traverse a -> f b
f (Free a
v) = b -> Ext b
forall a. a -> Ext a
Free (b -> Ext b) -> f b -> f (Ext b)
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
(Int -> Rank -> ShowS)
-> (Rank -> String) -> ([Rank] -> ShowS) -> Show Rank
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
(Rank -> Rank -> Bool) -> (Rank -> Rank -> Bool) -> Eq Rank
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
Eq Rank
-> (Rank -> Rank -> Ordering)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> Ord 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

  -- | @stripDims n shape@ strips the outer @n@ dimensions from
  -- @shape@.
  stripDims :: Int -> a -> a

  -- | 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) = [SubExp] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SubExp]
l
  stripDims :: Int -> ShapeBase SubExp -> ShapeBase SubExp
stripDims Int
n (Shape [SubExp]
dims) = [SubExp] -> ShapeBase SubExp
forall d. [d] -> ShapeBase d
Shape ([SubExp] -> ShapeBase SubExp) -> [SubExp] -> ShapeBase SubExp
forall a b. (a -> b) -> a -> b
$ Int -> [SubExp] -> [SubExp]
forall a. Int -> [a] -> [a]
drop Int
n [SubExp]
dims
  subShapeOf :: ShapeBase SubExp -> ShapeBase SubExp -> Bool
subShapeOf = ShapeBase SubExp -> ShapeBase SubExp -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance ArrayShape (ShapeBase ExtSize) where
  shapeRank :: ShapeBase ExtSize -> Int
shapeRank (Shape [ExtSize]
l) = [ExtSize] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExtSize]
l
  stripDims :: Int -> ShapeBase ExtSize -> ShapeBase ExtSize
stripDims Int
n (Shape [ExtSize]
dims) = [ExtSize] -> ShapeBase ExtSize
forall d. [d] -> ShapeBase d
Shape ([ExtSize] -> ShapeBase ExtSize) -> [ExtSize] -> ShapeBase ExtSize
forall a b. (a -> b) -> a -> b
$ Int -> [ExtSize] -> [ExtSize]
forall a. Int -> [a] -> [a]
drop Int
n [ExtSize]
dims
  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.
    [ExtSize] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExtSize]
ds1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ExtSize] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExtSize]
ds2
      Bool -> Bool -> Bool
&& State (Map Int Int) Bool -> Map Int Int -> Bool
forall s a. State s a -> s -> a
evalState ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool)
-> StateT (Map Int Int) Identity [Bool] -> State (Map Int Int) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExtSize -> ExtSize -> State (Map Int Int) Bool)
-> [ExtSize] -> [ExtSize] -> StateT (Map Int Int) Identity [Bool]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ExtSize -> ExtSize -> State (Map Int Int) Bool
forall {m :: * -> *} {a}.
(Eq a, MonadState (Map Int Int) m) =>
Ext a -> Ext a -> m Bool
subDimOf [ExtSize]
ds1 [ExtSize]
ds2) Map Int Int
forall k a. Map k a
M.empty
    where
      subDimOf :: Ext a -> Ext a -> m Bool
subDimOf (Free a
se1) (Free a
se2) = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ a
se1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
se2
      subDimOf (Ext Int
_) (Free a
_) = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      subDimOf (Free a
_) (Ext Int
_) = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      subDimOf (Ext Int
x) (Ext Int
y) = do
        Map Int Int
extmap <- m (Map Int Int)
forall s (m :: * -> *). MonadState s m => m s
get
        case Int -> Map Int Int -> Maybe Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            | Bool
otherwise -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          Maybe Int
Nothing -> do
            Map Int Int -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Map Int Int -> m ()) -> Map Int Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Map Int Int -> Map Int Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
y Int
x Map Int Int
extmap
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

instance Semigroup Rank where
  Rank Int
x <> :: Rank -> Rank -> Rank
<> Rank Int
y = Int -> Rank
Rank (Int -> Rank) -> Int -> Rank
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
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
  stripDims :: Int -> Rank -> Rank
stripDims Int
n (Rank Int
x) = Int -> Rank
Rank (Int -> Rank) -> Int -> Rank
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
  subShapeOf :: Rank -> Rank -> Bool
subShapeOf = Rank -> Rank -> Bool
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
(Int -> Space -> ShowS)
-> (Space -> String) -> ([Space] -> ShowS) -> Show Space
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
(Space -> Space -> Bool) -> (Space -> Space -> Bool) -> Eq Space
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
Eq Space
-> (Space -> Space -> Ordering)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Space)
-> (Space -> Space -> Space)
-> Ord 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
(NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool) -> Eq NoUniqueness
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
Eq NoUniqueness
-> (NoUniqueness -> NoUniqueness -> Ordering)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> NoUniqueness)
-> (NoUniqueness -> NoUniqueness -> NoUniqueness)
-> Ord 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
(Int -> NoUniqueness -> ShowS)
-> (NoUniqueness -> String)
-> ([NoUniqueness] -> ShowS)
-> Show NoUniqueness
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
[TypeBase shape u] -> ShowS
TypeBase shape u -> String
(Int -> TypeBase shape u -> ShowS)
-> (TypeBase shape u -> String)
-> ([TypeBase shape u] -> ShowS)
-> Show (TypeBase shape u)
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
(TypeBase shape u -> TypeBase shape u -> Bool)
-> (TypeBase shape u -> TypeBase shape u -> Bool)
-> Eq (TypeBase shape u)
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, Eq (TypeBase shape u)
Eq (TypeBase shape u)
-> (TypeBase shape u -> TypeBase shape u -> Ordering)
-> (TypeBase shape u -> TypeBase shape u -> Bool)
-> (TypeBase shape u -> TypeBase shape u -> Bool)
-> (TypeBase shape u -> TypeBase shape u -> Bool)
-> (TypeBase shape u -> TypeBase shape u -> Bool)
-> (TypeBase shape u -> TypeBase shape u -> TypeBase shape u)
-> (TypeBase shape u -> TypeBase shape u -> TypeBase shape u)
-> Ord (TypeBase shape u)
TypeBase shape u -> TypeBase shape u -> Bool
TypeBase shape u -> TypeBase shape u -> Ordering
TypeBase shape u -> TypeBase shape u -> TypeBase shape u
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) = PrimType -> c -> d -> TypeBase c d
forall shape u. PrimType -> shape -> u -> TypeBase shape u
Array PrimType
t (c -> d -> TypeBase c d) -> f c -> f (d -> TypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
shape f (d -> TypeBase c d) -> f d -> f (TypeBase c d)
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) = TypeBase c d -> f (TypeBase c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeBase c d -> f (TypeBase c d))
-> TypeBase c d -> f (TypeBase c d)
forall a b. (a -> b) -> a -> b
$ PrimType -> TypeBase c d
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) = VName -> ShapeBase SubExp -> [Type] -> d -> TypeBase c d
forall shape u.
VName -> ShapeBase SubExp -> [Type] -> u -> TypeBase shape u
Acc VName
arrs ShapeBase SubExp
ispace [Type]
ts (d -> TypeBase c d) -> f d -> f (TypeBase c d)
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) = TypeBase c d -> f (TypeBase c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeBase c d -> f (TypeBase c d))
-> TypeBase c d -> f (TypeBase c d)
forall a b. (a -> b) -> a -> b
$ Space -> TypeBase c d
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 = (a -> b) -> (c -> d) -> TypeBase a c -> TypeBase b d
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 = (a -> m) -> (b -> m) -> TypeBase a b -> m
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
(Diet -> Diet -> Bool) -> (Diet -> Diet -> Bool) -> Eq Diet
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
Eq Diet
-> (Diet -> Diet -> Ordering)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Diet)
-> (Diet -> Diet -> Diet)
-> Ord 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
(Int -> Diet -> ShowS)
-> (Diet -> String) -> ([Diet] -> ShowS) -> Show Diet
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
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
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 VName -> VName -> Bool
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 VName -> VName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Ident -> VName
identName Ident
y

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

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

instance Monoid Certificates where
  mempty :: Certificates
mempty = [VName] -> Certificates
Certificates [VName]
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
(Int -> SubExp -> ShowS)
-> (SubExp -> String) -> ([SubExp] -> ShowS) -> Show SubExp
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
(SubExp -> SubExp -> Bool)
-> (SubExp -> SubExp -> Bool) -> Eq SubExp
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
Eq SubExp
-> (SubExp -> SubExp -> Ordering)
-> (SubExp -> SubExp -> Bool)
-> (SubExp -> SubExp -> Bool)
-> (SubExp -> SubExp -> Bool)
-> (SubExp -> SubExp -> Bool)
-> (SubExp -> SubExp -> SubExp)
-> (SubExp -> SubExp -> SubExp)
-> Ord 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
  { -- | Name of the parameter.
    forall dec. Param dec -> VName
paramName :: VName,
    -- | Function parameter decoration.
    forall dec. Param dec -> dec
paramDec :: dec
  }
  deriving (Eq (Param dec)
Eq (Param dec)
-> (Param dec -> Param dec -> Ordering)
-> (Param dec -> Param dec -> Bool)
-> (Param dec -> Param dec -> Bool)
-> (Param dec -> Param dec -> Bool)
-> (Param dec -> Param dec -> Bool)
-> (Param dec -> Param dec -> Param dec)
-> (Param dec -> Param dec -> Param dec)
-> Ord (Param dec)
Param dec -> Param dec -> Bool
Param dec -> Param dec -> Ordering
Param dec -> Param dec -> Param dec
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
[Param dec] -> ShowS
Param dec -> String
(Int -> Param dec -> ShowS)
-> (Param dec -> String)
-> ([Param dec] -> ShowS)
-> Show (Param dec)
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
(Param dec -> Param dec -> Bool)
-> (Param dec -> Param dec -> Bool) -> Eq (Param dec)
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 = (a -> m) -> Param a -> m
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 = (a -> b) -> Param a -> Param b
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 VName
name a
dec) = VName -> b -> Param b
forall dec. VName -> dec -> Param dec
Param VName
name (b -> Param b) -> f b -> f (Param b)
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
(DimIndex d -> DimIndex d -> Bool)
-> (DimIndex d -> DimIndex d -> Bool) -> Eq (DimIndex d)
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, Eq (DimIndex d)
Eq (DimIndex d)
-> (DimIndex d -> DimIndex d -> Ordering)
-> (DimIndex d -> DimIndex d -> Bool)
-> (DimIndex d -> DimIndex d -> Bool)
-> (DimIndex d -> DimIndex d -> Bool)
-> (DimIndex d -> DimIndex d -> Bool)
-> (DimIndex d -> DimIndex d -> DimIndex d)
-> (DimIndex d -> DimIndex d -> DimIndex d)
-> Ord (DimIndex d)
DimIndex d -> DimIndex d -> Bool
DimIndex d -> DimIndex d -> Ordering
DimIndex d -> DimIndex d -> DimIndex 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 (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
[DimIndex d] -> ShowS
DimIndex d -> String
(Int -> DimIndex d -> ShowS)
-> (DimIndex d -> String)
-> ([DimIndex d] -> ShowS)
-> Show (DimIndex d)
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) = b -> DimIndex b
forall d. d -> DimIndex d
DimFix (b -> DimIndex b) -> b -> DimIndex b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
i
  fmap a -> b
f (DimSlice a
i a
j a
s) = b -> b -> b -> DimIndex b
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 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
j m -> m -> m
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) = b -> DimIndex b
forall d. d -> DimIndex d
DimFix (b -> DimIndex b) -> f b -> f (DimIndex b)
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) = b -> b -> b -> DimIndex b
forall d. d -> d -> d -> DimIndex d
DimSlice (b -> b -> b -> DimIndex b) -> f b -> f (b -> b -> DimIndex b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
i f (b -> b -> DimIndex b) -> f b -> f (b -> DimIndex b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
j f (b -> DimIndex b) -> f b -> f (DimIndex b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
s

-- | A list of 'DimFix'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.
type Slice d = [DimIndex d]

-- | 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) = d -> Maybe d
forall a. a -> Maybe a
Just d
d
dimFix DimIndex d
_ = Maybe 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 = (DimIndex d -> Maybe d) -> [DimIndex d] -> Maybe [d]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DimIndex d -> Maybe d
forall d. DimIndex d -> Maybe d
dimFix

-- | The dimensions of the array produced by this slice.
sliceDims :: Slice d -> [d]
sliceDims :: forall d. Slice d -> [d]
sliceDims = (DimIndex d -> Maybe d) -> [DimIndex d] -> [d]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DimIndex d -> Maybe d
forall d. DimIndex d -> Maybe d
dimSlice
  where
    dimSlice :: DimIndex a -> Maybe a
dimSlice (DimSlice a
_ a
d a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
d
    dimSlice DimFix {} = Maybe a
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 = d -> d -> d -> DimIndex d
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 (DimFix d
j : [DimIndex d]
mis') [d]
is' =
  d
j d -> [d] -> [d]
forall a. a -> [a] -> [a]
: [DimIndex d] -> [d] -> [d]
forall d. Num d => Slice d -> [d] -> [d]
fixSlice [DimIndex d]
mis' [d]
is'
fixSlice (DimSlice d
orig_k d
_ d
orig_s : [DimIndex d]
mis') (d
i : [d]
is') =
  (d
orig_k d -> d -> d
forall a. Num a => a -> a -> a
+ d
i d -> d -> d
forall a. Num a => a -> a -> a
* d
orig_s) d -> [d] -> [d]
forall a. a -> [a] -> [a]
: [DimIndex d] -> [d] -> [d]
forall d. Num d => Slice d -> [d] -> [d]
fixSlice [DimIndex d]
mis' [d]
is'
fixSlice [DimIndex d]
_ [d]
_ = []

-- | 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 (DimFix d
j : [DimIndex d]
js') [DimIndex d]
is' =
  d -> DimIndex d
forall d. d -> DimIndex d
DimFix d
j DimIndex d -> [DimIndex d] -> [DimIndex d]
forall a. a -> [a] -> [a]
: [DimIndex d] -> [DimIndex d] -> [DimIndex d]
forall d. Num d => Slice d -> Slice d -> Slice d
sliceSlice [DimIndex d]
js' [DimIndex d]
is'
sliceSlice (DimSlice d
j d
_ d
s : [DimIndex d]
js') (DimFix d
i : [DimIndex d]
is') =
  d -> DimIndex d
forall d. d -> DimIndex d
DimFix (d
j d -> d -> d
forall a. Num a => a -> a -> a
+ (d
i d -> d -> d
forall a. Num a => a -> a -> a
* d
s)) DimIndex d -> [DimIndex d] -> [DimIndex d]
forall a. a -> [a] -> [a]
: [DimIndex d] -> [DimIndex d] -> [DimIndex d]
forall d. Num d => Slice d -> Slice d -> Slice 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') =
  d -> d -> d -> DimIndex d
forall d. d -> d -> d -> DimIndex d
DimSlice (d
j d -> d -> d
forall a. Num a => a -> a -> a
+ (d
s0 d -> d -> d
forall a. Num a => a -> a -> a
* d
i)) d
n (d
s0 d -> d -> d
forall a. Num a => a -> a -> a
* d
s1) DimIndex d -> [DimIndex d] -> [DimIndex d]
forall a. a -> [a] -> [a]
: [DimIndex d] -> [DimIndex d] -> [DimIndex d]
forall d. Num d => Slice d -> Slice d -> Slice d
sliceSlice [DimIndex d]
js' [DimIndex d]
is'
sliceSlice [DimIndex d]
_ [DimIndex d]
_ = []

-- | 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 PatElemT dec = PatElem
  { -- | The name being bound.
    forall dec. PatElemT dec -> VName
patElemName :: VName,
    -- | Pattern element decoration.
    forall dec. PatElemT dec -> dec
patElemDec :: dec
  }
  deriving (Eq (PatElemT dec)
Eq (PatElemT dec)
-> (PatElemT dec -> PatElemT dec -> Ordering)
-> (PatElemT dec -> PatElemT dec -> Bool)
-> (PatElemT dec -> PatElemT dec -> Bool)
-> (PatElemT dec -> PatElemT dec -> Bool)
-> (PatElemT dec -> PatElemT dec -> Bool)
-> (PatElemT dec -> PatElemT dec -> PatElemT dec)
-> (PatElemT dec -> PatElemT dec -> PatElemT dec)
-> Ord (PatElemT dec)
PatElemT dec -> PatElemT dec -> Bool
PatElemT dec -> PatElemT dec -> Ordering
PatElemT dec -> PatElemT dec -> PatElemT dec
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 (PatElemT dec)
forall dec. Ord dec => PatElemT dec -> PatElemT dec -> Bool
forall dec. Ord dec => PatElemT dec -> PatElemT dec -> Ordering
forall dec. Ord dec => PatElemT dec -> PatElemT dec -> PatElemT dec
min :: PatElemT dec -> PatElemT dec -> PatElemT dec
$cmin :: forall dec. Ord dec => PatElemT dec -> PatElemT dec -> PatElemT dec
max :: PatElemT dec -> PatElemT dec -> PatElemT dec
$cmax :: forall dec. Ord dec => PatElemT dec -> PatElemT dec -> PatElemT dec
>= :: PatElemT dec -> PatElemT dec -> Bool
$c>= :: forall dec. Ord dec => PatElemT dec -> PatElemT dec -> Bool
> :: PatElemT dec -> PatElemT dec -> Bool
$c> :: forall dec. Ord dec => PatElemT dec -> PatElemT dec -> Bool
<= :: PatElemT dec -> PatElemT dec -> Bool
$c<= :: forall dec. Ord dec => PatElemT dec -> PatElemT dec -> Bool
< :: PatElemT dec -> PatElemT dec -> Bool
$c< :: forall dec. Ord dec => PatElemT dec -> PatElemT dec -> Bool
compare :: PatElemT dec -> PatElemT dec -> Ordering
$ccompare :: forall dec. Ord dec => PatElemT dec -> PatElemT dec -> Ordering
Ord, Int -> PatElemT dec -> ShowS
[PatElemT dec] -> ShowS
PatElemT dec -> String
(Int -> PatElemT dec -> ShowS)
-> (PatElemT dec -> String)
-> ([PatElemT dec] -> ShowS)
-> Show (PatElemT dec)
forall dec. Show dec => Int -> PatElemT dec -> ShowS
forall dec. Show dec => [PatElemT dec] -> ShowS
forall dec. Show dec => PatElemT dec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatElemT dec] -> ShowS
$cshowList :: forall dec. Show dec => [PatElemT dec] -> ShowS
show :: PatElemT dec -> String
$cshow :: forall dec. Show dec => PatElemT dec -> String
showsPrec :: Int -> PatElemT dec -> ShowS
$cshowsPrec :: forall dec. Show dec => Int -> PatElemT dec -> ShowS
Show, PatElemT dec -> PatElemT dec -> Bool
(PatElemT dec -> PatElemT dec -> Bool)
-> (PatElemT dec -> PatElemT dec -> Bool) -> Eq (PatElemT dec)
forall dec. Eq dec => PatElemT dec -> PatElemT dec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatElemT dec -> PatElemT dec -> Bool
$c/= :: forall dec. Eq dec => PatElemT dec -> PatElemT dec -> Bool
== :: PatElemT dec -> PatElemT dec -> Bool
$c== :: forall dec. Eq dec => PatElemT dec -> PatElemT dec -> Bool
Eq)

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

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

instance Traversable PatElemT where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatElemT a -> f (PatElemT b)
traverse a -> f b
f (PatElem VName
name a
dec) =
    VName -> b -> PatElemT b
forall dec. VName -> dec -> PatElemT dec
PatElem VName
name (b -> PatElemT b) -> f b -> f (PatElemT b)
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
(ErrorMsg a -> ErrorMsg a -> Bool)
-> (ErrorMsg a -> ErrorMsg a -> Bool) -> Eq (ErrorMsg a)
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, Eq (ErrorMsg a)
Eq (ErrorMsg a)
-> (ErrorMsg a -> ErrorMsg a -> Ordering)
-> (ErrorMsg a -> ErrorMsg a -> Bool)
-> (ErrorMsg a -> ErrorMsg a -> Bool)
-> (ErrorMsg a -> ErrorMsg a -> Bool)
-> (ErrorMsg a -> ErrorMsg a -> Bool)
-> (ErrorMsg a -> ErrorMsg a -> ErrorMsg a)
-> (ErrorMsg a -> ErrorMsg a -> ErrorMsg a)
-> Ord (ErrorMsg a)
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
[ErrorMsg a] -> ShowS
ErrorMsg a -> String
(Int -> ErrorMsg a -> ShowS)
-> (ErrorMsg a -> String)
-> ([ErrorMsg a] -> ShowS)
-> Show (ErrorMsg a)
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 = [ErrorMsgPart a] -> ErrorMsg a
forall a. [ErrorMsgPart a] -> ErrorMsg a
ErrorMsg ([ErrorMsgPart a] -> ErrorMsg a)
-> (String -> [ErrorMsgPart a]) -> String -> ErrorMsg a
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ErrorMsgPart a -> [ErrorMsgPart a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorMsgPart a -> [ErrorMsgPart a])
-> (String -> ErrorMsgPart a) -> String -> [ErrorMsgPart a]
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ErrorMsgPart a
forall a. IsString a => String -> a
fromString

-- | A part of an error message.
data ErrorMsgPart a
  = -- | A literal string.
    ErrorString String
  | -- | A run-time integer value.
    ErrorInt32 a
  | -- | A bigger run-time integer value.
    ErrorInt64 a
  deriving (ErrorMsgPart a -> ErrorMsgPart a -> Bool
(ErrorMsgPart a -> ErrorMsgPart a -> Bool)
-> (ErrorMsgPart a -> ErrorMsgPart a -> Bool)
-> Eq (ErrorMsgPart a)
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, Eq (ErrorMsgPart a)
Eq (ErrorMsgPart a)
-> (ErrorMsgPart a -> ErrorMsgPart a -> Ordering)
-> (ErrorMsgPart a -> ErrorMsgPart a -> Bool)
-> (ErrorMsgPart a -> ErrorMsgPart a -> Bool)
-> (ErrorMsgPart a -> ErrorMsgPart a -> Bool)
-> (ErrorMsgPart a -> ErrorMsgPart a -> Bool)
-> (ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart a)
-> (ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart a)
-> Ord (ErrorMsgPart a)
ErrorMsgPart a -> ErrorMsgPart a -> Bool
ErrorMsgPart a -> ErrorMsgPart a -> Ordering
ErrorMsgPart a -> ErrorMsgPart a -> ErrorMsgPart 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 (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
[ErrorMsgPart a] -> ShowS
ErrorMsgPart a -> String
(Int -> ErrorMsgPart a -> ShowS)
-> (ErrorMsgPart a -> String)
-> ([ErrorMsgPart a] -> ShowS)
-> Show (ErrorMsgPart a)
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 = String -> ErrorMsgPart a
forall a. String -> ErrorMsgPart a
ErrorString

instance Functor ErrorMsg where
  fmap :: forall a b. (a -> b) -> ErrorMsg a -> ErrorMsg b
fmap a -> b
f (ErrorMsg [ErrorMsgPart a]
parts) = [ErrorMsgPart b] -> ErrorMsg b
forall a. [ErrorMsgPart a] -> ErrorMsg a
ErrorMsg ([ErrorMsgPart b] -> ErrorMsg b) -> [ErrorMsgPart b] -> ErrorMsg b
forall a b. (a -> b) -> a -> b
$ (ErrorMsgPart a -> ErrorMsgPart b)
-> [ErrorMsgPart a] -> [ErrorMsgPart b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> ErrorMsgPart a -> ErrorMsgPart b
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) = (ErrorMsgPart a -> m) -> [ErrorMsgPart a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> ErrorMsgPart a -> m
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) = [ErrorMsgPart b] -> ErrorMsg b
forall a. [ErrorMsgPart a] -> ErrorMsg a
ErrorMsg ([ErrorMsgPart b] -> ErrorMsg b)
-> f [ErrorMsgPart b] -> f (ErrorMsg b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ErrorMsgPart a -> f (ErrorMsgPart b))
-> [ErrorMsgPart a] -> f [ErrorMsgPart b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> ErrorMsgPart a -> f (ErrorMsgPart b)
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 a -> b
_ (ErrorString String
s) = String -> ErrorMsgPart b
forall a. String -> ErrorMsgPart a
ErrorString String
s
  fmap a -> b
f (ErrorInt32 a
a) = b -> ErrorMsgPart b
forall a. a -> ErrorMsgPart a
ErrorInt32 (b -> ErrorMsgPart b) -> b -> ErrorMsgPart b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
  fmap a -> b
f (ErrorInt64 a
a) = b -> ErrorMsgPart b
forall a. a -> ErrorMsgPart a
ErrorInt64 (b -> ErrorMsgPart b) -> b -> ErrorMsgPart b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

instance Foldable ErrorMsgPart where
  foldMap :: forall m a. Monoid m => (a -> m) -> ErrorMsgPart a -> m
foldMap a -> m
_ ErrorString {} = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (ErrorInt32 a
a) = a -> m
f a
a
  foldMap a -> m
f (ErrorInt64 a
a) = a -> m
f a
a

instance Traversable ErrorMsgPart where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrorMsgPart a -> f (ErrorMsgPart b)
traverse a -> f b
_ (ErrorString String
s) = ErrorMsgPart b -> f (ErrorMsgPart b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorMsgPart b -> f (ErrorMsgPart b))
-> ErrorMsgPart b -> f (ErrorMsgPart b)
forall a b. (a -> b) -> a -> b
$ String -> ErrorMsgPart b
forall a. String -> ErrorMsgPart a
ErrorString String
s
  traverse a -> f b
f (ErrorInt32 a
a) = b -> ErrorMsgPart b
forall a. a -> ErrorMsgPart a
ErrorInt32 (b -> ErrorMsgPart b) -> f b -> f (ErrorMsgPart b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  traverse a -> f b
f (ErrorInt64 a
a) = b -> ErrorMsgPart b
forall a. a -> ErrorMsgPart a
ErrorInt64 (b -> ErrorMsgPart b) -> f b -> f (ErrorMsgPart b)
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) = (ErrorMsgPart a -> Maybe PrimType)
-> [ErrorMsgPart a] -> [PrimType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ErrorMsgPart a -> Maybe PrimType
forall {a}. ErrorMsgPart a -> Maybe PrimType
onPart [ErrorMsgPart a]
parts
  where
    onPart :: ErrorMsgPart a -> Maybe PrimType
onPart ErrorString {} = Maybe PrimType
forall a. Maybe a
Nothing
    onPart ErrorInt32 {} = PrimType -> Maybe PrimType
forall a. a -> Maybe a
Just (PrimType -> Maybe PrimType) -> PrimType -> Maybe PrimType
forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
IntType IntType
Int32
    onPart ErrorInt64 {} = PrimType -> Maybe PrimType
forall a. a -> Maybe a
Just (PrimType -> Maybe PrimType) -> PrimType -> Maybe PrimType
forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
IntType IntType
Int64