{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}
{-# 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.Monad.State
import Data.Maybe
import Data.String
import qualified Data.Map.Strict as M
import Data.Traversable (fmapDefault, foldMapDefault)

import Language.Futhark.Core
import Futhark.IR.Primitive

-- | The size of an array type as a list of its dimension sizes, with
-- the type of sizes being parametric.
newtype ShapeBase d = Shape { 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
$cp1Ord :: forall d. Ord d => Eq (ShapeBase d)
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 :: (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 :: (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 :: (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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeBase a -> [a]
forall a. ShapeBase a -> [a]
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
$cp1Ord :: forall a. Ord a => Eq (Ext a)
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 :: (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 :: (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 :: (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
$cp1Ord :: Eq Rank
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
           | ScalarSpace [SubExp] PrimType
             -- ^ A special kind of memory that is a statically sized
             -- array of some primitive type.  Used for private memory
             -- on GPUs.
             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
$cp1Ord :: Eq Space
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
$cp1Ord :: Eq NoUniqueness
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)

-- | A Futhark type is either an array or an element type.  When
-- comparing types for equality with '==', shapes must match.
data TypeBase shape u = Prim PrimType
                      | 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 shape, Show u) =>
Int -> TypeBase shape u -> ShowS
forall shape u. (Show shape, Show u) => [TypeBase shape u] -> ShowS
forall shape u. (Show shape, Show u) => TypeBase shape u -> String
showList :: [TypeBase shape u] -> ShowS
$cshowList :: forall shape u. (Show shape, Show u) => [TypeBase shape u] -> ShowS
show :: TypeBase shape u -> String
$cshow :: forall shape u. (Show shape, Show u) => TypeBase shape u -> String
showsPrec :: Int -> TypeBase shape u -> ShowS
$cshowsPrec :: forall shape u.
(Show shape, Show u) =>
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 shape, Eq u) =>
TypeBase shape u -> TypeBase shape u -> Bool
/= :: TypeBase shape u -> TypeBase shape u -> Bool
$c/= :: forall shape u.
(Eq shape, Eq u) =>
TypeBase shape u -> TypeBase shape u -> Bool
== :: TypeBase shape u -> TypeBase shape u -> Bool
$c== :: forall shape u.
(Eq shape, Eq u) =>
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 shape, Ord u) => Eq (TypeBase shape u)
forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> Bool
forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> Ordering
forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> TypeBase shape u
min :: TypeBase shape u -> TypeBase shape u -> TypeBase shape u
$cmin :: forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> TypeBase shape u
max :: TypeBase shape u -> TypeBase shape u -> TypeBase shape u
$cmax :: forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> TypeBase shape u
>= :: TypeBase shape u -> TypeBase shape u -> Bool
$c>= :: forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> Bool
> :: TypeBase shape u -> TypeBase shape u -> Bool
$c> :: forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> Bool
<= :: TypeBase shape u -> TypeBase shape u -> Bool
$c<= :: forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> Bool
< :: TypeBase shape u -> TypeBase shape u -> Bool
$c< :: forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> Bool
compare :: TypeBase shape u -> TypeBase shape u -> Ordering
$ccompare :: forall shape u.
(Ord shape, Ord u) =>
TypeBase shape u -> TypeBase shape u -> Ordering
$cp1Ord :: forall shape u. (Ord shape, Ord u) => Eq (TypeBase shape u)
Ord)

-- | 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 = Consume -- ^ Consumes this value.
          | Observe -- ^ Only observes value in this position, does
                    -- not consume.  A result may alias this.
          | ObservePrim -- ^ As 'Observe', but the result will not
                        -- alias, because the parameter does not carry
                        -- aliases.
            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
$cp1Ord :: Eq Diet
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
$cp1Ord :: Eq Certificates
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
$cp1Ord :: Eq SubExp
Ord)

-- | A function or lambda parameter.
data Param dec = Param
                 { Param dec -> VName
paramName :: VName
                   -- ^ Name of the parameter.
                 , Param dec -> dec
paramDec :: dec
                   -- ^ Function parameter decoration.
                 } 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
$cp1Ord :: forall dec. Ord dec => Eq (Param dec)
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 :: (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 :: (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 :: (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 = DimFix
                  d -- ^ Fix index in this dimension.
                | DimSlice d d d
                  -- ^ @DimSlice start_offset num_elems stride@.
                  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
$cp1Ord :: forall d. Ord d => Eq (DimIndex d)
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 :: (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 :: (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 :: (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 :: 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 :: Slice d -> Maybe [d]
sliceIndices = (DimIndex d -> Maybe d) -> Slice 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 :: Slice d -> [d]
sliceDims = (DimIndex d -> Maybe d) -> Slice 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 :: 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 :: Slice d -> [d] -> [d]
fixSlice (DimFix d
j:Slice d
mis') [d]
is' =
  d
j d -> [d] -> [d]
forall a. a -> [a] -> [a]
: Slice d -> [d] -> [d]
forall d. Num d => Slice d -> [d] -> [d]
fixSlice Slice d
mis' [d]
is'
fixSlice (DimSlice d
orig_k d
_ d
orig_s:Slice d
mis') (d
i:[d]
is') =
  (d
orig_kd -> d -> d
forall a. Num a => a -> a -> a
+d
id -> d -> d
forall a. Num a => a -> a -> a
*d
orig_s) d -> [d] -> [d]
forall a. a -> [a] -> [a]
: Slice d -> [d] -> [d]
forall d. Num d => Slice d -> [d] -> [d]
fixSlice Slice d
mis' [d]
is'
fixSlice Slice 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 :: Slice d -> Slice d -> Slice d
sliceSlice (DimFix d
j:Slice d
js') Slice d
is' =
  d -> DimIndex d
forall d. d -> DimIndex d
DimFix d
j DimIndex d -> Slice d -> Slice d
forall a. a -> [a] -> [a]
: Slice d -> Slice d -> Slice d
forall d. Num d => Slice d -> Slice d -> Slice d
sliceSlice Slice d
js' Slice d
is'
sliceSlice (DimSlice d
j d
_ d
s:Slice d
js') (DimFix d
i:Slice d
is') =
  d -> DimIndex d
forall d. d -> DimIndex d
DimFix (d
j d -> d -> d
forall a. Num a => a -> a -> a
+ (d
id -> d -> d
forall a. Num a => a -> a -> a
*d
s)) DimIndex d -> Slice d -> Slice d
forall a. a -> [a] -> [a]
: Slice d -> Slice d -> Slice d
forall d. Num d => Slice d -> Slice d -> Slice d
sliceSlice Slice d
js' Slice d
is'
sliceSlice (DimSlice d
j d
_ d
s0:Slice d
js') (DimSlice d
i d
n d
s1:Slice d
is') =
  d -> d -> d -> DimIndex d
forall d. d -> d -> d -> DimIndex d
DimSlice (d
jd -> d -> d
forall a. Num a => a -> a -> a
+(d
s0d -> d -> d
forall a. Num a => a -> a -> a
*d
i)) d
n (d
s0d -> d -> d
forall a. Num a => a -> a -> a
*d
s1) DimIndex d -> Slice d -> Slice d
forall a. a -> [a] -> [a]
: Slice d -> Slice d -> Slice d
forall d. Num d => Slice d -> Slice d -> Slice d
sliceSlice Slice d
js' Slice d
is'
sliceSlice Slice d
_ Slice 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 { PatElemT dec -> VName
patElemName :: VName
                               -- ^ The name being bound.
                             , PatElemT dec -> dec
patElemDec :: dec
                               -- ^ Pattern element decoration.
                             }
                   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
$cp1Ord :: forall dec. Ord dec => Eq (PatElemT dec)
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 :: (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 :: (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 :: (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
$cp1Ord :: forall a. Ord a => Eq (ErrorMsg a)
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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorMsgPart a
forall a. IsString a => String -> a
fromString

-- | A part of an error message.
data ErrorMsgPart a = ErrorString String -- ^ A literal string.
                    | ErrorInt32 a -- ^ A run-time integer value.
                    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
$cp1Ord :: forall a. Ord a => Eq (ErrorMsgPart a)
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 :: (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 :: (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 :: (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 :: (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

instance Foldable ErrorMsgPart where
  foldMap :: (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

instance Traversable ErrorMsgPart where
  traverse :: (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

-- | How many non-constant parts does the error message have, and what
-- is their type?
errorMsgArgTypes :: ErrorMsg a -> [PrimType]
errorMsgArgTypes :: 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