{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE Safe                       #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE Strict                     #-}
-- | The Futhark source language AST definition.  Many types, such as
-- 'ExpBase'@, are parametrised by type and name representation.  See
-- the @https://futhark.readthedocs.org@ for a language reference, or
-- this module may be a little hard to understand.
module Language.Futhark.Syntax
  (
   module Language.Futhark.Core

  -- * Types
  , Uniqueness(..)
  , IntType(..)
  , FloatType(..)
  , PrimType(..)
  , ArrayDim (..)
  , DimDecl (..)
  , ShapeDecl (..)
  , shapeRank
  , stripDims
  , unifyShapes
  , TypeName(..)
  , typeNameFromQualName
  , qualNameFromTypeName
  , TypeBase(..)
  , TypeArg(..)
  , DimExp(..)
  , TypeExp(..)
  , TypeArgExp(..)
  , PName(..)
  , ScalarTypeBase(..)
  , PatternType
  , StructType
  , ValueType
  , Diet(..)
  , TypeDeclBase (..)

    -- * Values
  , IntValue(..)
  , FloatValue(..)
  , PrimValue(..)
  , IsPrimValue(..)
  , Value(..)

  -- * Abstract syntax tree
  , AttrInfo(..)
  , BinOp (..)
  , IdentBase (..)
  , Inclusiveness(..)
  , DimIndexBase(..)
  , ExpBase(..)
  , FieldBase(..)
  , CaseBase(..)
  , LoopFormBase (..)
  , PatternBase(..)

  -- * Module language
  , SpecBase(..)
  , SigExpBase(..)
  , TypeRefBase(..)
  , SigBindBase(..)
  , ModExpBase(..)
  , ModBindBase(..)
  , ModParamBase(..)

  -- * Definitions
  , DocComment(..)
  , ValBindBase(..)
  , EntryPoint(..)
  , EntryType(..)
  , Liftedness(..)
  , TypeBindBase(..)
  , TypeParamBase(..)
  , typeParamName
  , ProgBase(..)
  , DecBase(..)

  -- * Miscellaneous
  , Showable
  , NoInfo(..)
  , Info(..)
  , Alias(..)
  , Aliasing
  , QualName(..)
  )
  where

import           Control.Applicative
import           Control.Monad
import           Data.Array
import           Data.Bifoldable
import           Data.Bifunctor
import           Data.Bitraversable
import           Data.Foldable
import qualified Data.Map.Strict                  as M
import           Data.Monoid                      hiding (Sum)
import           Data.Ord
import qualified Data.Set                         as S
import           Data.Traversable
import qualified Data.List.NonEmpty               as NE
import           Prelude

import           Futhark.IR.Primitive (FloatType (..),
                                                   FloatValue (..),
                                                   IntType (..), IntValue (..))
import           Futhark.Util.Pretty
import           Futhark.Util.Loc
import           Language.Futhark.Core

-- | Convenience class for deriving 'Show' instances for the AST.
class (Show vn,
       Show (f VName),
       Show (f (Diet, Maybe VName)),
       Show (f String),
       Show (f [VName]),
       Show (f ([VName], [VName])),
       Show (f PatternType),
       Show (f (PatternType, [VName])),
       Show (f (StructType, [VName])),
       Show (f EntryPoint),
       Show (f Int),
       Show (f StructType),
       Show (f (StructType, Maybe VName)),
       Show (f (Aliasing, StructType)),
       Show (f (M.Map VName VName)),
       Show (f Uniqueness)) => Showable f vn where

-- | No information functor.  Usually used for placeholder type- or
-- aliasing information.
data NoInfo a = NoInfo
              deriving (NoInfo a -> NoInfo a -> Bool
(NoInfo a -> NoInfo a -> Bool)
-> (NoInfo a -> NoInfo a -> Bool) -> Eq (NoInfo a)
forall a. NoInfo a -> NoInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoInfo a -> NoInfo a -> Bool
$c/= :: forall a. NoInfo a -> NoInfo a -> Bool
== :: NoInfo a -> NoInfo a -> Bool
$c== :: forall a. NoInfo a -> NoInfo a -> Bool
Eq, Eq (NoInfo a)
Eq (NoInfo a)
-> (NoInfo a -> NoInfo a -> Ordering)
-> (NoInfo a -> NoInfo a -> Bool)
-> (NoInfo a -> NoInfo a -> Bool)
-> (NoInfo a -> NoInfo a -> Bool)
-> (NoInfo a -> NoInfo a -> Bool)
-> (NoInfo a -> NoInfo a -> NoInfo a)
-> (NoInfo a -> NoInfo a -> NoInfo a)
-> Ord (NoInfo a)
NoInfo a -> NoInfo a -> Bool
NoInfo a -> NoInfo a -> Ordering
NoInfo a -> NoInfo a -> NoInfo a
forall a. Eq (NoInfo 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. NoInfo a -> NoInfo a -> Bool
forall a. NoInfo a -> NoInfo a -> Ordering
forall a. NoInfo a -> NoInfo a -> NoInfo a
min :: NoInfo a -> NoInfo a -> NoInfo a
$cmin :: forall a. NoInfo a -> NoInfo a -> NoInfo a
max :: NoInfo a -> NoInfo a -> NoInfo a
$cmax :: forall a. NoInfo a -> NoInfo a -> NoInfo a
>= :: NoInfo a -> NoInfo a -> Bool
$c>= :: forall a. NoInfo a -> NoInfo a -> Bool
> :: NoInfo a -> NoInfo a -> Bool
$c> :: forall a. NoInfo a -> NoInfo a -> Bool
<= :: NoInfo a -> NoInfo a -> Bool
$c<= :: forall a. NoInfo a -> NoInfo a -> Bool
< :: NoInfo a -> NoInfo a -> Bool
$c< :: forall a. NoInfo a -> NoInfo a -> Bool
compare :: NoInfo a -> NoInfo a -> Ordering
$ccompare :: forall a. NoInfo a -> NoInfo a -> Ordering
$cp1Ord :: forall a. Eq (NoInfo a)
Ord, Int -> NoInfo a -> ShowS
[NoInfo a] -> ShowS
NoInfo a -> String
(Int -> NoInfo a -> ShowS)
-> (NoInfo a -> String) -> ([NoInfo a] -> ShowS) -> Show (NoInfo a)
forall a. Int -> NoInfo a -> ShowS
forall a. [NoInfo a] -> ShowS
forall a. NoInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoInfo a] -> ShowS
$cshowList :: forall a. [NoInfo a] -> ShowS
show :: NoInfo a -> String
$cshow :: forall a. NoInfo a -> String
showsPrec :: Int -> NoInfo a -> ShowS
$cshowsPrec :: forall a. Int -> NoInfo a -> ShowS
Show)

instance Show vn => Showable NoInfo vn where
instance Functor NoInfo where
  fmap :: (a -> b) -> NoInfo a -> NoInfo b
fmap a -> b
_ NoInfo a
NoInfo = NoInfo b
forall a. NoInfo a
NoInfo
instance Foldable NoInfo where
  foldr :: (a -> b -> b) -> b -> NoInfo a -> b
foldr a -> b -> b
_ b
b NoInfo a
NoInfo = b
b
instance Traversable NoInfo where
  traverse :: (a -> f b) -> NoInfo a -> f (NoInfo b)
traverse a -> f b
_ NoInfo a
NoInfo = NoInfo b -> f (NoInfo b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo b
forall a. NoInfo a
NoInfo

-- | Some information.  The dual to 'NoInfo'
newtype Info a = Info { Info a -> a
unInfo :: a }
            deriving (Info a -> Info a -> Bool
(Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool) -> Eq (Info a)
forall a. Eq a => Info a -> Info a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Info a -> Info a -> Bool
$c/= :: forall a. Eq a => Info a -> Info a -> Bool
== :: Info a -> Info a -> Bool
$c== :: forall a. Eq a => Info a -> Info a -> Bool
Eq, Eq (Info a)
Eq (Info a)
-> (Info a -> Info a -> Ordering)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Info a)
-> (Info a -> Info a -> Info a)
-> Ord (Info a)
Info a -> Info a -> Bool
Info a -> Info a -> Ordering
Info a -> Info a -> Info 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 (Info a)
forall a. Ord a => Info a -> Info a -> Bool
forall a. Ord a => Info a -> Info a -> Ordering
forall a. Ord a => Info a -> Info a -> Info a
min :: Info a -> Info a -> Info a
$cmin :: forall a. Ord a => Info a -> Info a -> Info a
max :: Info a -> Info a -> Info a
$cmax :: forall a. Ord a => Info a -> Info a -> Info a
>= :: Info a -> Info a -> Bool
$c>= :: forall a. Ord a => Info a -> Info a -> Bool
> :: Info a -> Info a -> Bool
$c> :: forall a. Ord a => Info a -> Info a -> Bool
<= :: Info a -> Info a -> Bool
$c<= :: forall a. Ord a => Info a -> Info a -> Bool
< :: Info a -> Info a -> Bool
$c< :: forall a. Ord a => Info a -> Info a -> Bool
compare :: Info a -> Info a -> Ordering
$ccompare :: forall a. Ord a => Info a -> Info a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Info a)
Ord, Int -> Info a -> ShowS
[Info a] -> ShowS
Info a -> String
(Int -> Info a -> ShowS)
-> (Info a -> String) -> ([Info a] -> ShowS) -> Show (Info a)
forall a. Show a => Int -> Info a -> ShowS
forall a. Show a => [Info a] -> ShowS
forall a. Show a => Info a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info a] -> ShowS
$cshowList :: forall a. Show a => [Info a] -> ShowS
show :: Info a -> String
$cshow :: forall a. Show a => Info a -> String
showsPrec :: Int -> Info a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Info a -> ShowS
Show)

instance Show vn => Showable Info vn where
instance Functor Info where
  fmap :: (a -> b) -> Info a -> Info b
fmap a -> b
f (Info a
x) = b -> Info b
forall a. a -> Info a
Info (b -> Info b) -> b -> Info b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
instance Foldable Info where
  foldr :: (a -> b -> b) -> b -> Info a -> b
foldr a -> b -> b
f b
b (Info a
x) = a -> b -> b
f a
x b
b
instance Traversable Info where
  traverse :: (a -> f b) -> Info a -> f (Info b)
traverse a -> f b
f (Info a
x) = b -> Info b
forall a. a -> Info a
Info (b -> Info b) -> f b -> f (Info b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

-- | Low-level primitive types.
data PrimType = Signed IntType
              | Unsigned IntType
              | FloatType FloatType
              | Bool
              deriving (PrimType -> PrimType -> Bool
(PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool) -> Eq PrimType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimType -> PrimType -> Bool
$c/= :: PrimType -> PrimType -> Bool
== :: PrimType -> PrimType -> Bool
$c== :: PrimType -> PrimType -> Bool
Eq, Eq PrimType
Eq PrimType
-> (PrimType -> PrimType -> Ordering)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> PrimType)
-> (PrimType -> PrimType -> PrimType)
-> Ord PrimType
PrimType -> PrimType -> Bool
PrimType -> PrimType -> Ordering
PrimType -> PrimType -> PrimType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrimType -> PrimType -> PrimType
$cmin :: PrimType -> PrimType -> PrimType
max :: PrimType -> PrimType -> PrimType
$cmax :: PrimType -> PrimType -> PrimType
>= :: PrimType -> PrimType -> Bool
$c>= :: PrimType -> PrimType -> Bool
> :: PrimType -> PrimType -> Bool
$c> :: PrimType -> PrimType -> Bool
<= :: PrimType -> PrimType -> Bool
$c<= :: PrimType -> PrimType -> Bool
< :: PrimType -> PrimType -> Bool
$c< :: PrimType -> PrimType -> Bool
compare :: PrimType -> PrimType -> Ordering
$ccompare :: PrimType -> PrimType -> Ordering
$cp1Ord :: Eq PrimType
Ord, Int -> PrimType -> ShowS
[PrimType] -> ShowS
PrimType -> String
(Int -> PrimType -> ShowS)
-> (PrimType -> String) -> ([PrimType] -> ShowS) -> Show PrimType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimType] -> ShowS
$cshowList :: [PrimType] -> ShowS
show :: PrimType -> String
$cshow :: PrimType -> String
showsPrec :: Int -> PrimType -> ShowS
$cshowsPrec :: Int -> PrimType -> ShowS
Show)

-- | Non-array values.
data PrimValue = SignedValue !IntValue
               | UnsignedValue !IntValue
               | FloatValue !FloatValue
               | BoolValue !Bool
               deriving (PrimValue -> PrimValue -> Bool
(PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool) -> Eq PrimValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimValue -> PrimValue -> Bool
$c/= :: PrimValue -> PrimValue -> Bool
== :: PrimValue -> PrimValue -> Bool
$c== :: PrimValue -> PrimValue -> Bool
Eq, Eq PrimValue
Eq PrimValue
-> (PrimValue -> PrimValue -> Ordering)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> PrimValue)
-> (PrimValue -> PrimValue -> PrimValue)
-> Ord PrimValue
PrimValue -> PrimValue -> Bool
PrimValue -> PrimValue -> Ordering
PrimValue -> PrimValue -> PrimValue
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 :: PrimValue -> PrimValue -> PrimValue
$cmin :: PrimValue -> PrimValue -> PrimValue
max :: PrimValue -> PrimValue -> PrimValue
$cmax :: PrimValue -> PrimValue -> PrimValue
>= :: PrimValue -> PrimValue -> Bool
$c>= :: PrimValue -> PrimValue -> Bool
> :: PrimValue -> PrimValue -> Bool
$c> :: PrimValue -> PrimValue -> Bool
<= :: PrimValue -> PrimValue -> Bool
$c<= :: PrimValue -> PrimValue -> Bool
< :: PrimValue -> PrimValue -> Bool
$c< :: PrimValue -> PrimValue -> Bool
compare :: PrimValue -> PrimValue -> Ordering
$ccompare :: PrimValue -> PrimValue -> Ordering
$cp1Ord :: Eq PrimValue
Ord, Int -> PrimValue -> ShowS
[PrimValue] -> ShowS
PrimValue -> String
(Int -> PrimValue -> ShowS)
-> (PrimValue -> String)
-> ([PrimValue] -> ShowS)
-> Show PrimValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimValue] -> ShowS
$cshowList :: [PrimValue] -> ShowS
show :: PrimValue -> String
$cshow :: PrimValue -> String
showsPrec :: Int -> PrimValue -> ShowS
$cshowsPrec :: Int -> PrimValue -> ShowS
Show)

-- | A class for converting ordinary Haskell values to primitive
-- Futhark values.
class IsPrimValue v where
  primValue :: v -> PrimValue

instance IsPrimValue Int where
  primValue :: Int -> PrimValue
primValue = IntValue -> PrimValue
SignedValue (IntValue -> PrimValue) -> (Int -> IntValue) -> Int -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int -> Int32) -> Int -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsPrimValue Int8 where
  primValue :: Int8 -> PrimValue
primValue = IntValue -> PrimValue
SignedValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value
instance IsPrimValue Int16 where
  primValue :: Int16 -> PrimValue
primValue = IntValue -> PrimValue
SignedValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value
instance IsPrimValue Int32 where
  primValue :: Int32 -> PrimValue
primValue = IntValue -> PrimValue
SignedValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value
instance IsPrimValue Int64 where
  primValue :: Int64 -> PrimValue
primValue = IntValue -> PrimValue
SignedValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value

instance IsPrimValue Word8 where
  primValue :: Word8 -> PrimValue
primValue = IntValue -> PrimValue
UnsignedValue (IntValue -> PrimValue)
-> (Word8 -> IntValue) -> Word8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value (Int8 -> IntValue) -> (Word8 -> Int8) -> Word8 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsPrimValue Word16 where
  primValue :: Word16 -> PrimValue
primValue = IntValue -> PrimValue
UnsignedValue (IntValue -> PrimValue)
-> (Word16 -> IntValue) -> Word16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value (Int16 -> IntValue) -> (Word16 -> Int16) -> Word16 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsPrimValue Word32 where
  primValue :: Word32 -> PrimValue
primValue = IntValue -> PrimValue
UnsignedValue (IntValue -> PrimValue)
-> (Word32 -> IntValue) -> Word32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Word32 -> Int32) -> Word32 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsPrimValue Word64 where
  primValue :: Word64 -> PrimValue
primValue = IntValue -> PrimValue
UnsignedValue (IntValue -> PrimValue)
-> (Word64 -> IntValue) -> Word64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value (Int64 -> IntValue) -> (Word64 -> Int64) -> Word64 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsPrimValue Float where
  primValue :: Float -> PrimValue
primValue = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Float -> FloatValue) -> Float -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> FloatValue
Float32Value

instance IsPrimValue Double where
  primValue :: Double -> PrimValue
primValue = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Double -> FloatValue) -> Double -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FloatValue
Float64Value

instance IsPrimValue Bool where
  primValue :: Bool -> PrimValue
primValue = Bool -> PrimValue
BoolValue

-- | The payload of an attribute.
data AttrInfo
  = AttrAtom Name
  | AttrComp Name [AttrInfo]
  deriving (AttrInfo -> AttrInfo -> Bool
(AttrInfo -> AttrInfo -> Bool)
-> (AttrInfo -> AttrInfo -> Bool) -> Eq AttrInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrInfo -> AttrInfo -> Bool
$c/= :: AttrInfo -> AttrInfo -> Bool
== :: AttrInfo -> AttrInfo -> Bool
$c== :: AttrInfo -> AttrInfo -> Bool
Eq, Eq AttrInfo
Eq AttrInfo
-> (AttrInfo -> AttrInfo -> Ordering)
-> (AttrInfo -> AttrInfo -> Bool)
-> (AttrInfo -> AttrInfo -> Bool)
-> (AttrInfo -> AttrInfo -> Bool)
-> (AttrInfo -> AttrInfo -> Bool)
-> (AttrInfo -> AttrInfo -> AttrInfo)
-> (AttrInfo -> AttrInfo -> AttrInfo)
-> Ord AttrInfo
AttrInfo -> AttrInfo -> Bool
AttrInfo -> AttrInfo -> Ordering
AttrInfo -> AttrInfo -> AttrInfo
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 :: AttrInfo -> AttrInfo -> AttrInfo
$cmin :: AttrInfo -> AttrInfo -> AttrInfo
max :: AttrInfo -> AttrInfo -> AttrInfo
$cmax :: AttrInfo -> AttrInfo -> AttrInfo
>= :: AttrInfo -> AttrInfo -> Bool
$c>= :: AttrInfo -> AttrInfo -> Bool
> :: AttrInfo -> AttrInfo -> Bool
$c> :: AttrInfo -> AttrInfo -> Bool
<= :: AttrInfo -> AttrInfo -> Bool
$c<= :: AttrInfo -> AttrInfo -> Bool
< :: AttrInfo -> AttrInfo -> Bool
$c< :: AttrInfo -> AttrInfo -> Bool
compare :: AttrInfo -> AttrInfo -> Ordering
$ccompare :: AttrInfo -> AttrInfo -> Ordering
$cp1Ord :: Eq AttrInfo
Ord, Int -> AttrInfo -> ShowS
[AttrInfo] -> ShowS
AttrInfo -> String
(Int -> AttrInfo -> ShowS)
-> (AttrInfo -> String) -> ([AttrInfo] -> ShowS) -> Show AttrInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrInfo] -> ShowS
$cshowList :: [AttrInfo] -> ShowS
show :: AttrInfo -> String
$cshow :: AttrInfo -> String
showsPrec :: Int -> AttrInfo -> ShowS
$cshowsPrec :: Int -> AttrInfo -> ShowS
Show)

-- | A type class for things that can be array dimensions.
class Eq dim => ArrayDim dim where
  -- | @unifyDims x y@ combines @x@ and @y@ to contain their maximum
  -- common information, and fails if they conflict.
  unifyDims :: dim -> dim -> Maybe dim

instance ArrayDim () where
  unifyDims :: () -> () -> Maybe ()
unifyDims () () = () -> Maybe ()
forall a. a -> Maybe a
Just ()

-- | Declaration of a dimension size.
data DimDecl vn = NamedDim (QualName vn)
                  -- ^ The size of the dimension is this name, which
                  -- must be in scope.  In a return type, this will
                  -- give rise to an assertion.
                | ConstDim Int
                  -- ^ The size is a constant.
                | AnyDim
                  -- ^ No dimension declaration.
                deriving Int -> DimDecl vn -> ShowS
[DimDecl vn] -> ShowS
DimDecl vn -> String
(Int -> DimDecl vn -> ShowS)
-> (DimDecl vn -> String)
-> ([DimDecl vn] -> ShowS)
-> Show (DimDecl vn)
forall vn. Show vn => Int -> DimDecl vn -> ShowS
forall vn. Show vn => [DimDecl vn] -> ShowS
forall vn. Show vn => DimDecl vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DimDecl vn] -> ShowS
$cshowList :: forall vn. Show vn => [DimDecl vn] -> ShowS
show :: DimDecl vn -> String
$cshow :: forall vn. Show vn => DimDecl vn -> String
showsPrec :: Int -> DimDecl vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> DimDecl vn -> ShowS
Show
deriving instance Eq (DimDecl Name)
deriving instance Eq (DimDecl VName)
deriving instance Ord (DimDecl Name)
deriving instance Ord (DimDecl VName)

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

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

instance Traversable DimDecl where
  traverse :: (a -> f b) -> DimDecl a -> f (DimDecl b)
traverse a -> f b
f (NamedDim QualName a
qn) = QualName b -> DimDecl b
forall vn. QualName vn -> DimDecl vn
NamedDim (QualName b -> DimDecl b) -> f (QualName b) -> f (DimDecl b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> QualName a -> f (QualName b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f QualName a
qn
  traverse a -> f b
_ (ConstDim Int
x) = DimDecl b -> f (DimDecl b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DimDecl b -> f (DimDecl b)) -> DimDecl b -> f (DimDecl b)
forall a b. (a -> b) -> a -> b
$ Int -> DimDecl b
forall vn. Int -> DimDecl vn
ConstDim Int
x
  traverse a -> f b
_ DimDecl a
AnyDim = DimDecl b -> f (DimDecl b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DimDecl b
forall vn. DimDecl vn
AnyDim

-- Note that the notion of unifyDims here is intentionally not what we
-- use when we do real type unification in the type checker.
instance ArrayDim (DimDecl VName) where
  unifyDims :: DimDecl VName -> DimDecl VName -> Maybe (DimDecl VName)
unifyDims DimDecl VName
AnyDim DimDecl VName
y = DimDecl VName -> Maybe (DimDecl VName)
forall a. a -> Maybe a
Just DimDecl VName
y
  unifyDims DimDecl VName
x DimDecl VName
AnyDim = DimDecl VName -> Maybe (DimDecl VName)
forall a. a -> Maybe a
Just DimDecl VName
x
  unifyDims (NamedDim QualName VName
x) (NamedDim QualName VName
y) | QualName VName
x QualName VName -> QualName VName -> Bool
forall a. Eq a => a -> a -> Bool
== QualName VName
y = DimDecl VName -> Maybe (DimDecl VName)
forall a. a -> Maybe a
Just (DimDecl VName -> Maybe (DimDecl VName))
-> DimDecl VName -> Maybe (DimDecl VName)
forall a b. (a -> b) -> a -> b
$ QualName VName -> DimDecl VName
forall vn. QualName vn -> DimDecl vn
NamedDim QualName VName
x
  unifyDims (ConstDim Int
x) (ConstDim Int
y) | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y = DimDecl VName -> Maybe (DimDecl VName)
forall a. a -> Maybe a
Just (DimDecl VName -> Maybe (DimDecl VName))
-> DimDecl VName -> Maybe (DimDecl VName)
forall a b. (a -> b) -> a -> b
$ Int -> DimDecl VName
forall vn. Int -> DimDecl vn
ConstDim Int
x
  unifyDims DimDecl VName
_ DimDecl VName
_ = Maybe (DimDecl VName)
forall a. Maybe a
Nothing

-- | The size of an array type is a list of its dimension sizes.  If
-- 'Nothing', that dimension is of a (statically) unknown size.
newtype ShapeDecl dim = ShapeDecl { ShapeDecl dim -> [dim]
shapeDims :: [dim] }
                      deriving (ShapeDecl dim -> ShapeDecl dim -> Bool
(ShapeDecl dim -> ShapeDecl dim -> Bool)
-> (ShapeDecl dim -> ShapeDecl dim -> Bool) -> Eq (ShapeDecl dim)
forall dim. Eq dim => ShapeDecl dim -> ShapeDecl dim -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeDecl dim -> ShapeDecl dim -> Bool
$c/= :: forall dim. Eq dim => ShapeDecl dim -> ShapeDecl dim -> Bool
== :: ShapeDecl dim -> ShapeDecl dim -> Bool
$c== :: forall dim. Eq dim => ShapeDecl dim -> ShapeDecl dim -> Bool
Eq, Eq (ShapeDecl dim)
Eq (ShapeDecl dim)
-> (ShapeDecl dim -> ShapeDecl dim -> Ordering)
-> (ShapeDecl dim -> ShapeDecl dim -> Bool)
-> (ShapeDecl dim -> ShapeDecl dim -> Bool)
-> (ShapeDecl dim -> ShapeDecl dim -> Bool)
-> (ShapeDecl dim -> ShapeDecl dim -> Bool)
-> (ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim)
-> (ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim)
-> Ord (ShapeDecl dim)
ShapeDecl dim -> ShapeDecl dim -> Bool
ShapeDecl dim -> ShapeDecl dim -> Ordering
ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim
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 dim. Ord dim => Eq (ShapeDecl dim)
forall dim. Ord dim => ShapeDecl dim -> ShapeDecl dim -> Bool
forall dim. Ord dim => ShapeDecl dim -> ShapeDecl dim -> Ordering
forall dim.
Ord dim =>
ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim
min :: ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim
$cmin :: forall dim.
Ord dim =>
ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim
max :: ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim
$cmax :: forall dim.
Ord dim =>
ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim
>= :: ShapeDecl dim -> ShapeDecl dim -> Bool
$c>= :: forall dim. Ord dim => ShapeDecl dim -> ShapeDecl dim -> Bool
> :: ShapeDecl dim -> ShapeDecl dim -> Bool
$c> :: forall dim. Ord dim => ShapeDecl dim -> ShapeDecl dim -> Bool
<= :: ShapeDecl dim -> ShapeDecl dim -> Bool
$c<= :: forall dim. Ord dim => ShapeDecl dim -> ShapeDecl dim -> Bool
< :: ShapeDecl dim -> ShapeDecl dim -> Bool
$c< :: forall dim. Ord dim => ShapeDecl dim -> ShapeDecl dim -> Bool
compare :: ShapeDecl dim -> ShapeDecl dim -> Ordering
$ccompare :: forall dim. Ord dim => ShapeDecl dim -> ShapeDecl dim -> Ordering
$cp1Ord :: forall dim. Ord dim => Eq (ShapeDecl dim)
Ord, Int -> ShapeDecl dim -> ShowS
[ShapeDecl dim] -> ShowS
ShapeDecl dim -> String
(Int -> ShapeDecl dim -> ShowS)
-> (ShapeDecl dim -> String)
-> ([ShapeDecl dim] -> ShowS)
-> Show (ShapeDecl dim)
forall dim. Show dim => Int -> ShapeDecl dim -> ShowS
forall dim. Show dim => [ShapeDecl dim] -> ShowS
forall dim. Show dim => ShapeDecl dim -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapeDecl dim] -> ShowS
$cshowList :: forall dim. Show dim => [ShapeDecl dim] -> ShowS
show :: ShapeDecl dim -> String
$cshow :: forall dim. Show dim => ShapeDecl dim -> String
showsPrec :: Int -> ShapeDecl dim -> ShowS
$cshowsPrec :: forall dim. Show dim => Int -> ShapeDecl dim -> ShowS
Show)

instance Foldable ShapeDecl where
  foldr :: (a -> b -> b) -> b -> ShapeDecl a -> b
foldr a -> b -> b
f b
x (ShapeDecl [a]
ds) = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
x [a]
ds

instance Traversable ShapeDecl where
  traverse :: (a -> f b) -> ShapeDecl a -> f (ShapeDecl b)
traverse a -> f b
f (ShapeDecl [a]
ds) = [b] -> ShapeDecl b
forall dim. [dim] -> ShapeDecl dim
ShapeDecl ([b] -> ShapeDecl b) -> f [b] -> f (ShapeDecl b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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]
ds

instance Functor ShapeDecl where
  fmap :: (a -> b) -> ShapeDecl a -> ShapeDecl b
fmap a -> b
f (ShapeDecl [a]
ds) = [b] -> ShapeDecl b
forall dim. [dim] -> ShapeDecl dim
ShapeDecl ([b] -> ShapeDecl b) -> [b] -> ShapeDecl b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
ds

instance Semigroup (ShapeDecl dim) where
  ShapeDecl [dim]
l1 <> :: ShapeDecl dim -> ShapeDecl dim -> ShapeDecl dim
<> ShapeDecl [dim]
l2 = [dim] -> ShapeDecl dim
forall dim. [dim] -> ShapeDecl dim
ShapeDecl ([dim] -> ShapeDecl dim) -> [dim] -> ShapeDecl dim
forall a b. (a -> b) -> a -> b
$ [dim]
l1 [dim] -> [dim] -> [dim]
forall a. [a] -> [a] -> [a]
++ [dim]
l2

instance Monoid (ShapeDecl dim) where
  mempty :: ShapeDecl dim
mempty = [dim] -> ShapeDecl dim
forall dim. [dim] -> ShapeDecl dim
ShapeDecl []

-- | The number of dimensions contained in a shape.
shapeRank :: ShapeDecl dim -> Int
shapeRank :: ShapeDecl dim -> Int
shapeRank = [dim] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([dim] -> Int) -> (ShapeDecl dim -> [dim]) -> ShapeDecl dim -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeDecl dim -> [dim]
forall a. ShapeDecl a -> [a]
shapeDims

-- | @stripDims n shape@ strips the outer @n@ dimensions from
-- @shape@, returning 'Nothing' if this would result in zero or
-- fewer dimensions.
stripDims :: Int -> ShapeDecl dim -> Maybe (ShapeDecl dim)
stripDims :: Int -> ShapeDecl dim -> Maybe (ShapeDecl dim)
stripDims Int
i (ShapeDecl [dim]
l)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [dim] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [dim]
l = ShapeDecl dim -> Maybe (ShapeDecl dim)
forall a. a -> Maybe a
Just (ShapeDecl dim -> Maybe (ShapeDecl dim))
-> ShapeDecl dim -> Maybe (ShapeDecl dim)
forall a b. (a -> b) -> a -> b
$ [dim] -> ShapeDecl dim
forall dim. [dim] -> ShapeDecl dim
ShapeDecl ([dim] -> ShapeDecl dim) -> [dim] -> ShapeDecl dim
forall a b. (a -> b) -> a -> b
$ Int -> [dim] -> [dim]
forall a. Int -> [a] -> [a]
drop Int
i [dim]
l
  | Bool
otherwise    = Maybe (ShapeDecl dim)
forall a. Maybe a
Nothing


-- | @unifyShapes x y@ combines @x@ and @y@ to contain their maximum
-- common information, and fails if they conflict.
unifyShapes :: ArrayDim dim => ShapeDecl dim -> ShapeDecl dim -> Maybe (ShapeDecl dim)
unifyShapes :: ShapeDecl dim -> ShapeDecl dim -> Maybe (ShapeDecl dim)
unifyShapes (ShapeDecl [dim]
xs) (ShapeDecl [dim]
ys) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [dim] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [dim]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [dim] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [dim]
ys
  [dim] -> ShapeDecl dim
forall dim. [dim] -> ShapeDecl dim
ShapeDecl ([dim] -> ShapeDecl dim) -> Maybe [dim] -> Maybe (ShapeDecl dim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (dim -> dim -> Maybe dim) -> [dim] -> [dim] -> Maybe [dim]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM dim -> dim -> Maybe dim
forall dim. ArrayDim dim => dim -> dim -> Maybe dim
unifyDims [dim]
xs [dim]
ys

-- | A type name consists of qualifiers (for error messages) and a
-- 'VName' (for equality checking).
data TypeName = TypeName { TypeName -> [VName]
typeQuals :: [VName], TypeName -> VName
typeLeaf :: VName }
              deriving (Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeName] -> ShowS
$cshowList :: [TypeName] -> ShowS
show :: TypeName -> String
$cshow :: TypeName -> String
showsPrec :: Int -> TypeName -> ShowS
$cshowsPrec :: Int -> TypeName -> ShowS
Show)

instance Eq TypeName where
  TypeName [VName]
_ VName
x == :: TypeName -> TypeName -> Bool
== TypeName [VName]
_ VName
y = VName
x VName -> VName -> Bool
forall a. Eq a => a -> a -> Bool
== VName
y

instance Ord TypeName where
  TypeName [VName]
_ VName
x compare :: TypeName -> TypeName -> Ordering
`compare` TypeName [VName]
_ VName
y = VName
x VName -> VName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` VName
y

-- | Convert a 'QualName' to a 'TypeName'.
typeNameFromQualName :: QualName VName -> TypeName
typeNameFromQualName :: QualName VName -> TypeName
typeNameFromQualName (QualName [VName]
qs VName
x) = [VName] -> VName -> TypeName
TypeName [VName]
qs VName
x

-- | Convert a 'TypeName' to a 'QualName'.
qualNameFromTypeName :: TypeName -> QualName VName
qualNameFromTypeName :: TypeName -> QualName VName
qualNameFromTypeName (TypeName [VName]
qs VName
x) = [VName] -> VName -> QualName VName
forall vn. [vn] -> vn -> QualName vn
QualName [VName]
qs VName
x

-- | The name (if any) of a function parameter.  The 'Eq' and 'Ord'
-- instances always compare values of this type equal.
data PName = Named VName | Unnamed
           deriving (Int -> PName -> ShowS
[PName] -> ShowS
PName -> String
(Int -> PName -> ShowS)
-> (PName -> String) -> ([PName] -> ShowS) -> Show PName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PName] -> ShowS
$cshowList :: [PName] -> ShowS
show :: PName -> String
$cshow :: PName -> String
showsPrec :: Int -> PName -> ShowS
$cshowsPrec :: Int -> PName -> ShowS
Show)

instance Eq PName where
  PName
_ == :: PName -> PName -> Bool
== PName
_ = Bool
True

instance Ord PName where
  PName
_ <= :: PName -> PName -> Bool
<= PName
_ = Bool
True

-- | Types that can be elements of arrays.  This representation does
-- allow arrays of records of functions, which is nonsensical, but it
-- convolutes the code too much if we try to statically rule it out.
data ScalarTypeBase dim as
  = Prim PrimType
  | TypeVar as Uniqueness TypeName [TypeArg dim]
  | Record (M.Map Name (TypeBase dim as))
  | Sum (M.Map Name [TypeBase dim as])
  | Arrow as PName (TypeBase dim as) (TypeBase dim as)
    -- ^ The aliasing corresponds to the lexical
    -- closure of the function.
  deriving (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
(ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool)
-> (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool)
-> Eq (ScalarTypeBase dim as)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall dim as.
(Eq as, Eq dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
/= :: ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
$c/= :: forall dim as.
(Eq as, Eq dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
== :: ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
$c== :: forall dim as.
(Eq as, Eq dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
Eq, Eq (ScalarTypeBase dim as)
Eq (ScalarTypeBase dim as)
-> (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Ordering)
-> (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool)
-> (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool)
-> (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool)
-> (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool)
-> (ScalarTypeBase dim as
    -> ScalarTypeBase dim as -> ScalarTypeBase dim as)
-> (ScalarTypeBase dim as
    -> ScalarTypeBase dim as -> ScalarTypeBase dim as)
-> Ord (ScalarTypeBase dim as)
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Ordering
ScalarTypeBase dim as
-> ScalarTypeBase dim as -> ScalarTypeBase dim as
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 dim as. (Ord as, Ord dim) => Eq (ScalarTypeBase dim as)
forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Ordering
forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as
-> ScalarTypeBase dim as -> ScalarTypeBase dim as
min :: ScalarTypeBase dim as
-> ScalarTypeBase dim as -> ScalarTypeBase dim as
$cmin :: forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as
-> ScalarTypeBase dim as -> ScalarTypeBase dim as
max :: ScalarTypeBase dim as
-> ScalarTypeBase dim as -> ScalarTypeBase dim as
$cmax :: forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as
-> ScalarTypeBase dim as -> ScalarTypeBase dim as
>= :: ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
$c>= :: forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
> :: ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
$c> :: forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
<= :: ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
$c<= :: forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
< :: ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
$c< :: forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
compare :: ScalarTypeBase dim as -> ScalarTypeBase dim as -> Ordering
$ccompare :: forall dim as.
(Ord as, Ord dim) =>
ScalarTypeBase dim as -> ScalarTypeBase dim as -> Ordering
$cp1Ord :: forall dim as. (Ord as, Ord dim) => Eq (ScalarTypeBase dim as)
Ord, Int -> ScalarTypeBase dim as -> ShowS
[ScalarTypeBase dim as] -> ShowS
ScalarTypeBase dim as -> String
(Int -> ScalarTypeBase dim as -> ShowS)
-> (ScalarTypeBase dim as -> String)
-> ([ScalarTypeBase dim as] -> ShowS)
-> Show (ScalarTypeBase dim as)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall dim as.
(Show as, Show dim) =>
Int -> ScalarTypeBase dim as -> ShowS
forall dim as.
(Show as, Show dim) =>
[ScalarTypeBase dim as] -> ShowS
forall dim as.
(Show as, Show dim) =>
ScalarTypeBase dim as -> String
showList :: [ScalarTypeBase dim as] -> ShowS
$cshowList :: forall dim as.
(Show as, Show dim) =>
[ScalarTypeBase dim as] -> ShowS
show :: ScalarTypeBase dim as -> String
$cshow :: forall dim as.
(Show as, Show dim) =>
ScalarTypeBase dim as -> String
showsPrec :: Int -> ScalarTypeBase dim as -> ShowS
$cshowsPrec :: forall dim as.
(Show as, Show dim) =>
Int -> ScalarTypeBase dim as -> ShowS
Show)

instance Bitraversable ScalarTypeBase where
  bitraverse :: (a -> f c)
-> (b -> f d) -> ScalarTypeBase a b -> f (ScalarTypeBase c d)
bitraverse a -> f c
_ b -> f d
_ (Prim PrimType
t) = ScalarTypeBase c d -> f (ScalarTypeBase c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarTypeBase c d -> f (ScalarTypeBase c d))
-> ScalarTypeBase c d -> f (ScalarTypeBase c d)
forall a b. (a -> b) -> a -> b
$ PrimType -> ScalarTypeBase c d
forall dim as. PrimType -> ScalarTypeBase dim as
Prim PrimType
t
  bitraverse a -> f c
f b -> f d
g (Record Map Name (TypeBase a b)
fs) = Map Name (TypeBase c d) -> ScalarTypeBase c d
forall dim as. Map Name (TypeBase dim as) -> ScalarTypeBase dim as
Record (Map Name (TypeBase c d) -> ScalarTypeBase c d)
-> f (Map Name (TypeBase c d)) -> f (ScalarTypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeBase a b -> f (TypeBase c d))
-> Map Name (TypeBase a b) -> f (Map Name (TypeBase c d))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) Map Name (TypeBase a b)
fs
  bitraverse a -> f c
f b -> f d
g (TypeVar b
als Uniqueness
u TypeName
t [TypeArg a]
args) =
    d -> Uniqueness -> TypeName -> [TypeArg c] -> ScalarTypeBase c d
forall dim as.
as
-> Uniqueness -> TypeName -> [TypeArg dim] -> ScalarTypeBase dim as
TypeVar (d -> Uniqueness -> TypeName -> [TypeArg c] -> ScalarTypeBase c d)
-> f d
-> f (Uniqueness -> TypeName -> [TypeArg c] -> ScalarTypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
als f (Uniqueness -> TypeName -> [TypeArg c] -> ScalarTypeBase c d)
-> f Uniqueness
-> f (TypeName -> [TypeArg c] -> ScalarTypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Uniqueness -> f Uniqueness
forall (f :: * -> *) a. Applicative f => a -> f a
pure Uniqueness
u f (TypeName -> [TypeArg c] -> ScalarTypeBase c d)
-> f TypeName -> f ([TypeArg c] -> ScalarTypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeName -> f TypeName
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeName
t f ([TypeArg c] -> ScalarTypeBase c d)
-> f [TypeArg c] -> f (ScalarTypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeArg a -> f (TypeArg c)) -> [TypeArg a] -> f [TypeArg c]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> TypeArg a -> f (TypeArg c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f) [TypeArg a]
args
  bitraverse a -> f c
f b -> f d
g (Arrow b
als PName
v TypeBase a b
t1 TypeBase a b
t2) =
    d -> PName -> TypeBase c d -> TypeBase c d -> ScalarTypeBase c d
forall dim as.
as
-> PName
-> TypeBase dim as
-> TypeBase dim as
-> ScalarTypeBase dim as
Arrow (d -> PName -> TypeBase c d -> TypeBase c d -> ScalarTypeBase c d)
-> f d
-> f (PName -> TypeBase c d -> TypeBase c d -> ScalarTypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
als f (PName -> TypeBase c d -> TypeBase c d -> ScalarTypeBase c d)
-> f PName
-> f (TypeBase c d -> TypeBase c d -> ScalarTypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PName -> f PName
forall (f :: * -> *) a. Applicative f => a -> f a
pure PName
v f (TypeBase c d -> TypeBase c d -> ScalarTypeBase c d)
-> f (TypeBase c d) -> f (TypeBase c d -> ScalarTypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g TypeBase a b
t1 f (TypeBase c d -> ScalarTypeBase c d)
-> f (TypeBase c d) -> f (ScalarTypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g TypeBase a b
t2
  bitraverse a -> f c
f b -> f d
g (Sum Map Name [TypeBase a b]
cs) = Map Name [TypeBase c d] -> ScalarTypeBase c d
forall dim as. Map Name [TypeBase dim as] -> ScalarTypeBase dim as
Sum (Map Name [TypeBase c d] -> ScalarTypeBase c d)
-> f (Map Name [TypeBase c d]) -> f (ScalarTypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([TypeBase a b] -> f [TypeBase c d])
-> Map Name [TypeBase a b] -> f (Map Name [TypeBase c d])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (([TypeBase a b] -> f [TypeBase c d])
 -> Map Name [TypeBase a b] -> f (Map Name [TypeBase c d]))
-> ((TypeBase a b -> f (TypeBase c d))
    -> [TypeBase a b] -> f [TypeBase c d])
-> (TypeBase a b -> f (TypeBase c d))
-> Map Name [TypeBase a b]
-> f (Map Name [TypeBase c d])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeBase a b -> f (TypeBase c d))
-> [TypeBase a b] -> f [TypeBase c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) ((a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) Map Name [TypeBase a b]
cs

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

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

-- | An expanded Futhark type is either an array, or something that
-- can be an element of an array.  When comparing types for equality,
-- function parameter names are ignored.  This representation permits
-- some malformed types (arrays of functions), but importantly rules
-- out arrays-of-arrays.
data TypeBase dim as
  = Scalar (ScalarTypeBase dim as)
  | Array as Uniqueness (ScalarTypeBase dim ()) (ShapeDecl dim)
  deriving (TypeBase dim as -> TypeBase dim as -> Bool
(TypeBase dim as -> TypeBase dim as -> Bool)
-> (TypeBase dim as -> TypeBase dim as -> Bool)
-> Eq (TypeBase dim as)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall dim as.
(Eq as, Eq dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
/= :: TypeBase dim as -> TypeBase dim as -> Bool
$c/= :: forall dim as.
(Eq as, Eq dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
== :: TypeBase dim as -> TypeBase dim as -> Bool
$c== :: forall dim as.
(Eq as, Eq dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
Eq, Eq (TypeBase dim as)
Eq (TypeBase dim as)
-> (TypeBase dim as -> TypeBase dim as -> Ordering)
-> (TypeBase dim as -> TypeBase dim as -> Bool)
-> (TypeBase dim as -> TypeBase dim as -> Bool)
-> (TypeBase dim as -> TypeBase dim as -> Bool)
-> (TypeBase dim as -> TypeBase dim as -> Bool)
-> (TypeBase dim as -> TypeBase dim as -> TypeBase dim as)
-> (TypeBase dim as -> TypeBase dim as -> TypeBase dim as)
-> Ord (TypeBase dim as)
TypeBase dim as -> TypeBase dim as -> Bool
TypeBase dim as -> TypeBase dim as -> Ordering
TypeBase dim as -> TypeBase dim as -> TypeBase dim as
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 dim as. (Ord as, Ord dim) => Eq (TypeBase dim as)
forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> Ordering
forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> TypeBase dim as
min :: TypeBase dim as -> TypeBase dim as -> TypeBase dim as
$cmin :: forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> TypeBase dim as
max :: TypeBase dim as -> TypeBase dim as -> TypeBase dim as
$cmax :: forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> TypeBase dim as
>= :: TypeBase dim as -> TypeBase dim as -> Bool
$c>= :: forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
> :: TypeBase dim as -> TypeBase dim as -> Bool
$c> :: forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
<= :: TypeBase dim as -> TypeBase dim as -> Bool
$c<= :: forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
< :: TypeBase dim as -> TypeBase dim as -> Bool
$c< :: forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> Bool
compare :: TypeBase dim as -> TypeBase dim as -> Ordering
$ccompare :: forall dim as.
(Ord as, Ord dim) =>
TypeBase dim as -> TypeBase dim as -> Ordering
$cp1Ord :: forall dim as. (Ord as, Ord dim) => Eq (TypeBase dim as)
Ord, Int -> TypeBase dim as -> ShowS
[TypeBase dim as] -> ShowS
TypeBase dim as -> String
(Int -> TypeBase dim as -> ShowS)
-> (TypeBase dim as -> String)
-> ([TypeBase dim as] -> ShowS)
-> Show (TypeBase dim as)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall dim as.
(Show as, Show dim) =>
Int -> TypeBase dim as -> ShowS
forall dim as. (Show as, Show dim) => [TypeBase dim as] -> ShowS
forall dim as. (Show as, Show dim) => TypeBase dim as -> String
showList :: [TypeBase dim as] -> ShowS
$cshowList :: forall dim as. (Show as, Show dim) => [TypeBase dim as] -> ShowS
show :: TypeBase dim as -> String
$cshow :: forall dim as. (Show as, Show dim) => TypeBase dim as -> String
showsPrec :: Int -> TypeBase dim as -> ShowS
$cshowsPrec :: forall dim as.
(Show as, Show dim) =>
Int -> TypeBase dim as -> ShowS
Show)

instance Bitraversable TypeBase where
  bitraverse :: (a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
bitraverse a -> f c
f b -> f d
g (Scalar ScalarTypeBase a b
t) = ScalarTypeBase c d -> TypeBase c d
forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar (ScalarTypeBase c d -> TypeBase c d)
-> f (ScalarTypeBase c d) -> f (TypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c)
-> (b -> f d) -> ScalarTypeBase a b -> f (ScalarTypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g ScalarTypeBase a b
t
  bitraverse a -> f c
f b -> f d
g (Array b
a Uniqueness
u ScalarTypeBase a ()
t ShapeDecl a
shape) =
    d
-> Uniqueness -> ScalarTypeBase c () -> ShapeDecl c -> TypeBase c d
forall dim as.
as
-> Uniqueness
-> ScalarTypeBase dim ()
-> ShapeDecl dim
-> TypeBase dim as
Array (d
 -> Uniqueness
 -> ScalarTypeBase c ()
 -> ShapeDecl c
 -> TypeBase c d)
-> f d
-> f (Uniqueness
      -> ScalarTypeBase c () -> ShapeDecl c -> TypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a f (Uniqueness
   -> ScalarTypeBase c () -> ShapeDecl c -> TypeBase c d)
-> f Uniqueness
-> f (ScalarTypeBase c () -> ShapeDecl c -> TypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Uniqueness -> f Uniqueness
forall (f :: * -> *) a. Applicative f => a -> f a
pure Uniqueness
u f (ScalarTypeBase c () -> ShapeDecl c -> TypeBase c d)
-> f (ScalarTypeBase c ()) -> f (ShapeDecl c -> TypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c)
-> (() -> f ()) -> ScalarTypeBase a () -> f (ScalarTypeBase c ())
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarTypeBase a ()
t f (ShapeDecl c -> TypeBase c d)
-> f (ShapeDecl c) -> f (TypeBase c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> ShapeDecl a -> f (ShapeDecl c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f ShapeDecl a
shape

instance Bifunctor TypeBase where
  bimap :: (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 :: (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

-- | An argument passed to a type constructor.
data TypeArg dim = TypeArgDim dim SrcLoc
                 | TypeArgType (TypeBase dim ()) SrcLoc
             deriving (TypeArg dim -> TypeArg dim -> Bool
(TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool) -> Eq (TypeArg dim)
forall dim. Eq dim => TypeArg dim -> TypeArg dim -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeArg dim -> TypeArg dim -> Bool
$c/= :: forall dim. Eq dim => TypeArg dim -> TypeArg dim -> Bool
== :: TypeArg dim -> TypeArg dim -> Bool
$c== :: forall dim. Eq dim => TypeArg dim -> TypeArg dim -> Bool
Eq, Eq (TypeArg dim)
Eq (TypeArg dim)
-> (TypeArg dim -> TypeArg dim -> Ordering)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> TypeArg dim)
-> (TypeArg dim -> TypeArg dim -> TypeArg dim)
-> Ord (TypeArg dim)
TypeArg dim -> TypeArg dim -> Bool
TypeArg dim -> TypeArg dim -> Ordering
TypeArg dim -> TypeArg dim -> TypeArg dim
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 dim. Ord dim => Eq (TypeArg dim)
forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Bool
forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Ordering
forall dim. Ord dim => TypeArg dim -> TypeArg dim -> TypeArg dim
min :: TypeArg dim -> TypeArg dim -> TypeArg dim
$cmin :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> TypeArg dim
max :: TypeArg dim -> TypeArg dim -> TypeArg dim
$cmax :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> TypeArg dim
>= :: TypeArg dim -> TypeArg dim -> Bool
$c>= :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Bool
> :: TypeArg dim -> TypeArg dim -> Bool
$c> :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Bool
<= :: TypeArg dim -> TypeArg dim -> Bool
$c<= :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Bool
< :: TypeArg dim -> TypeArg dim -> Bool
$c< :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Bool
compare :: TypeArg dim -> TypeArg dim -> Ordering
$ccompare :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Ordering
$cp1Ord :: forall dim. Ord dim => Eq (TypeArg dim)
Ord, Int -> TypeArg dim -> ShowS
[TypeArg dim] -> ShowS
TypeArg dim -> String
(Int -> TypeArg dim -> ShowS)
-> (TypeArg dim -> String)
-> ([TypeArg dim] -> ShowS)
-> Show (TypeArg dim)
forall dim. Show dim => Int -> TypeArg dim -> ShowS
forall dim. Show dim => [TypeArg dim] -> ShowS
forall dim. Show dim => TypeArg dim -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeArg dim] -> ShowS
$cshowList :: forall dim. Show dim => [TypeArg dim] -> ShowS
show :: TypeArg dim -> String
$cshow :: forall dim. Show dim => TypeArg dim -> String
showsPrec :: Int -> TypeArg dim -> ShowS
$cshowsPrec :: forall dim. Show dim => Int -> TypeArg dim -> ShowS
Show)

instance Traversable TypeArg where
  traverse :: (a -> f b) -> TypeArg a -> f (TypeArg b)
traverse a -> f b
f (TypeArgDim a
v SrcLoc
loc) = b -> SrcLoc -> TypeArg b
forall dim. dim -> SrcLoc -> TypeArg dim
TypeArgDim (b -> SrcLoc -> TypeArg b) -> f b -> f (SrcLoc -> TypeArg b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v f (SrcLoc -> TypeArg b) -> f SrcLoc -> f (TypeArg b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (TypeArgType TypeBase a ()
t SrcLoc
loc) = TypeBase b () -> SrcLoc -> TypeArg b
forall dim. TypeBase dim () -> SrcLoc -> TypeArg dim
TypeArgType (TypeBase b () -> SrcLoc -> TypeArg b)
-> f (TypeBase b ()) -> f (SrcLoc -> TypeArg b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> (() -> f ()) -> TypeBase a () -> f (TypeBase b ())
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase a ()
t f (SrcLoc -> TypeArg b) -> f SrcLoc -> f (TypeArg b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

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

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

-- | A variable that is aliased.  Can be still in-scope, or have gone
-- out of scope and be free.  In the latter case, it behaves more like
-- an equivalence class.  See uniqueness-error18.fut for an example of
-- why this is necessary.
data Alias = AliasBound { Alias -> VName
aliasVar :: VName }
           | AliasFree { aliasVar :: VName }
           deriving (Alias -> Alias -> Bool
(Alias -> Alias -> Bool) -> (Alias -> Alias -> Bool) -> Eq Alias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alias -> Alias -> Bool
$c/= :: Alias -> Alias -> Bool
== :: Alias -> Alias -> Bool
$c== :: Alias -> Alias -> Bool
Eq, Eq Alias
Eq Alias
-> (Alias -> Alias -> Ordering)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Alias)
-> (Alias -> Alias -> Alias)
-> Ord Alias
Alias -> Alias -> Bool
Alias -> Alias -> Ordering
Alias -> Alias -> Alias
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 :: Alias -> Alias -> Alias
$cmin :: Alias -> Alias -> Alias
max :: Alias -> Alias -> Alias
$cmax :: Alias -> Alias -> Alias
>= :: Alias -> Alias -> Bool
$c>= :: Alias -> Alias -> Bool
> :: Alias -> Alias -> Bool
$c> :: Alias -> Alias -> Bool
<= :: Alias -> Alias -> Bool
$c<= :: Alias -> Alias -> Bool
< :: Alias -> Alias -> Bool
$c< :: Alias -> Alias -> Bool
compare :: Alias -> Alias -> Ordering
$ccompare :: Alias -> Alias -> Ordering
$cp1Ord :: Eq Alias
Ord, Int -> Alias -> ShowS
[Alias] -> ShowS
Alias -> String
(Int -> Alias -> ShowS)
-> (Alias -> String) -> ([Alias] -> ShowS) -> Show Alias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alias] -> ShowS
$cshowList :: [Alias] -> ShowS
show :: Alias -> String
$cshow :: Alias -> String
showsPrec :: Int -> Alias -> ShowS
$cshowsPrec :: Int -> Alias -> ShowS
Show)

-- | Aliasing for a type, which is a set of the variables that are
-- aliased.
type Aliasing = S.Set Alias

-- | A type with aliasing information and shape annotations, used for
-- describing the type patterns and expressions.
type PatternType = TypeBase (DimDecl VName) Aliasing

-- | A "structural" type with shape annotations and no aliasing
-- information, used for declarations.
type StructType = TypeBase (DimDecl VName) ()

-- | A value type contains full, manifest size information.
type ValueType = TypeBase Int32 ()

-- | A dimension declaration expression for use in a 'TypeExp'.
data DimExp vn = DimExpNamed (QualName vn) SrcLoc
                 -- ^ The size of the dimension is this name, which
                 -- must be in scope.
               | DimExpConst Int SrcLoc
                  -- ^ The size is a constant.
               | DimExpAny
                  -- ^ No dimension declaration.
                deriving Int -> DimExp vn -> ShowS
[DimExp vn] -> ShowS
DimExp vn -> String
(Int -> DimExp vn -> ShowS)
-> (DimExp vn -> String)
-> ([DimExp vn] -> ShowS)
-> Show (DimExp vn)
forall vn. Show vn => Int -> DimExp vn -> ShowS
forall vn. Show vn => [DimExp vn] -> ShowS
forall vn. Show vn => DimExp vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DimExp vn] -> ShowS
$cshowList :: forall vn. Show vn => [DimExp vn] -> ShowS
show :: DimExp vn -> String
$cshow :: forall vn. Show vn => DimExp vn -> String
showsPrec :: Int -> DimExp vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> DimExp vn -> ShowS
Show
deriving instance Eq (DimExp Name)
deriving instance Eq (DimExp VName)
deriving instance Ord (DimExp Name)
deriving instance Ord (DimExp VName)

-- | An unstructured type with type variables and possibly shape
-- declarations - this is what the user types in the source program.
-- These are used to construct 'TypeBase's in the type checker.
data TypeExp vn = TEVar (QualName vn) SrcLoc
                | TETuple [TypeExp vn] SrcLoc
                | TERecord [(Name, TypeExp vn)] SrcLoc
                | TEArray (TypeExp vn) (DimExp vn) SrcLoc
                | TEUnique (TypeExp vn) SrcLoc
                | TEApply (TypeExp vn) (TypeArgExp vn) SrcLoc
                | TEArrow (Maybe vn) (TypeExp vn) (TypeExp vn) SrcLoc
                | TESum [(Name, [TypeExp vn])] SrcLoc
                 deriving (Int -> TypeExp vn -> ShowS
[TypeExp vn] -> ShowS
TypeExp vn -> String
(Int -> TypeExp vn -> ShowS)
-> (TypeExp vn -> String)
-> ([TypeExp vn] -> ShowS)
-> Show (TypeExp vn)
forall vn. Show vn => Int -> TypeExp vn -> ShowS
forall vn. Show vn => [TypeExp vn] -> ShowS
forall vn. Show vn => TypeExp vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeExp vn] -> ShowS
$cshowList :: forall vn. Show vn => [TypeExp vn] -> ShowS
show :: TypeExp vn -> String
$cshow :: forall vn. Show vn => TypeExp vn -> String
showsPrec :: Int -> TypeExp vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> TypeExp vn -> ShowS
Show)
deriving instance Eq (TypeExp Name)
deriving instance Eq (TypeExp VName)
deriving instance Ord (TypeExp Name)
deriving instance Ord (TypeExp VName)

instance Located (TypeExp vn) where
  locOf :: TypeExp vn -> Loc
locOf (TEArray TypeExp vn
_ DimExp vn
_ SrcLoc
loc)   = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TETuple [TypeExp vn]
_ SrcLoc
loc)     = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TERecord [(Name, TypeExp vn)]
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEVar QualName vn
_ SrcLoc
loc)       = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEUnique TypeExp vn
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEApply TypeExp vn
_ TypeArgExp vn
_ SrcLoc
loc)   = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEArrow Maybe vn
_ TypeExp vn
_ TypeExp vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TESum [(Name, [TypeExp vn])]
_ SrcLoc
loc)      = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | A type argument expression passed to a type constructor.
data TypeArgExp vn = TypeArgExpDim (DimExp vn) SrcLoc
                   | TypeArgExpType (TypeExp vn)
                deriving (Int -> TypeArgExp vn -> ShowS
[TypeArgExp vn] -> ShowS
TypeArgExp vn -> String
(Int -> TypeArgExp vn -> ShowS)
-> (TypeArgExp vn -> String)
-> ([TypeArgExp vn] -> ShowS)
-> Show (TypeArgExp vn)
forall vn. Show vn => Int -> TypeArgExp vn -> ShowS
forall vn. Show vn => [TypeArgExp vn] -> ShowS
forall vn. Show vn => TypeArgExp vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeArgExp vn] -> ShowS
$cshowList :: forall vn. Show vn => [TypeArgExp vn] -> ShowS
show :: TypeArgExp vn -> String
$cshow :: forall vn. Show vn => TypeArgExp vn -> String
showsPrec :: Int -> TypeArgExp vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> TypeArgExp vn -> ShowS
Show)
deriving instance Eq (TypeArgExp Name)
deriving instance Eq (TypeArgExp VName)
deriving instance Ord (TypeArgExp Name)
deriving instance Ord (TypeArgExp VName)

instance Located (TypeArgExp vn) where
  locOf :: TypeArgExp vn -> Loc
locOf (TypeArgExpDim DimExp vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TypeArgExpType TypeExp vn
t)    = TypeExp vn -> Loc
forall a. Located a => a -> Loc
locOf TypeExp vn
t

-- | A declaration of the type of something.
data TypeDeclBase f vn =
  TypeDecl { TypeDeclBase f vn -> TypeExp vn
declaredType :: TypeExp vn
                             -- ^ The type declared by the user.
           , TypeDeclBase f vn -> f StructType
expandedType :: f StructType
                             -- ^ The type deduced by the type checker.
           }
deriving instance Showable f vn => Show (TypeDeclBase f vn)
deriving instance Eq (TypeDeclBase NoInfo VName)
deriving instance Ord (TypeDeclBase NoInfo VName)

instance Located (TypeDeclBase f vn) where
  locOf :: TypeDeclBase f vn -> Loc
locOf = TypeExp vn -> Loc
forall a. Located a => a -> Loc
locOf (TypeExp vn -> Loc)
-> (TypeDeclBase f vn -> TypeExp vn) -> TypeDeclBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDeclBase f vn -> TypeExp vn
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType

-- | Information about which parts of a value/type are consumed.
data Diet = RecordDiet (M.Map Name Diet) -- ^ Consumes these fields in the record.
          | FuncDiet Diet Diet
            -- ^ A function that consumes its argument(s) like this.
            -- The final 'Diet' should always be 'Observe', as there
            -- is no way for a function to consume its return value.
          | Consume -- ^ Consumes this value.
          | Observe -- ^ Only observes value in this position, does
                    -- not consume.
            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, 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)

-- | Simple Futhark values.  Values are fully evaluated and their type
-- is always unambiguous.
data Value = PrimValue !PrimValue
           | ArrayValue !(Array Int Value) ValueType
             -- ^ It is assumed that the array is 0-indexed.  The type
             -- is the full type.
             deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

-- | An identifier consists of its name and the type of the value
-- bound to the identifier.
data IdentBase f vn = Ident { IdentBase f vn -> vn
identName   :: vn
                            , IdentBase f vn -> f PatternType
identType   :: f PatternType
                            , IdentBase f vn -> SrcLoc
identSrcLoc :: SrcLoc
                            }
deriving instance Showable f vn => Show (IdentBase f vn)

instance Eq vn => Eq (IdentBase ty vn) where
  IdentBase ty vn
x == :: IdentBase ty vn -> IdentBase ty vn -> Bool
== IdentBase ty vn
y = IdentBase ty vn -> vn
forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase ty vn
x vn -> vn -> Bool
forall a. Eq a => a -> a -> Bool
== IdentBase ty vn -> vn
forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase ty vn
y

instance Ord vn => Ord (IdentBase ty vn) where
  compare :: IdentBase ty vn -> IdentBase ty vn -> Ordering
compare = (IdentBase ty vn -> vn)
-> IdentBase ty vn -> IdentBase ty vn -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing IdentBase ty vn -> vn
forall (f :: * -> *) vn. IdentBase f vn -> vn
identName

instance Located (IdentBase ty vn) where
  locOf :: IdentBase ty vn -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (IdentBase ty vn -> SrcLoc) -> IdentBase ty vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentBase ty vn -> SrcLoc
forall (f :: * -> *) vn. IdentBase f vn -> SrcLoc
identSrcLoc

-- | Default binary operators.
data BinOp =  Backtick
              -- ^ A pseudo-operator standing in for any normal
              -- identifier used as an operator (they all have the
              -- same fixity).
           -- Binary Ops for Numbers
           | Plus
           | Minus
           | Pow
           | Times
           | Divide
           | Mod
           | Quot
           | Rem
           | ShiftR
           | ShiftL
           | Band
           | Xor
           | Bor
           | LogAnd
           | LogOr
           -- Relational Ops for all primitive types at least
           | Equal
           | NotEqual
           | Less
           | Leq
           | Greater
           | Geq
           -- Some functional ops.
           | PipeRight -- ^ @|>@
           | PipeLeft -- ^ @<|@
           -- Misc
             deriving (BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq, Eq BinOp
Eq BinOp
-> (BinOp -> BinOp -> Ordering)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> BinOp)
-> (BinOp -> BinOp -> BinOp)
-> Ord BinOp
BinOp -> BinOp -> Bool
BinOp -> BinOp -> Ordering
BinOp -> BinOp -> BinOp
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 :: BinOp -> BinOp -> BinOp
$cmin :: BinOp -> BinOp -> BinOp
max :: BinOp -> BinOp -> BinOp
$cmax :: BinOp -> BinOp -> BinOp
>= :: BinOp -> BinOp -> Bool
$c>= :: BinOp -> BinOp -> Bool
> :: BinOp -> BinOp -> Bool
$c> :: BinOp -> BinOp -> Bool
<= :: BinOp -> BinOp -> Bool
$c<= :: BinOp -> BinOp -> Bool
< :: BinOp -> BinOp -> Bool
$c< :: BinOp -> BinOp -> Bool
compare :: BinOp -> BinOp -> Ordering
$ccompare :: BinOp -> BinOp -> Ordering
$cp1Ord :: Eq BinOp
Ord, Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show, Int -> BinOp
BinOp -> Int
BinOp -> [BinOp]
BinOp -> BinOp
BinOp -> BinOp -> [BinOp]
BinOp -> BinOp -> BinOp -> [BinOp]
(BinOp -> BinOp)
-> (BinOp -> BinOp)
-> (Int -> BinOp)
-> (BinOp -> Int)
-> (BinOp -> [BinOp])
-> (BinOp -> BinOp -> [BinOp])
-> (BinOp -> BinOp -> [BinOp])
-> (BinOp -> BinOp -> BinOp -> [BinOp])
-> Enum BinOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BinOp -> BinOp -> BinOp -> [BinOp]
$cenumFromThenTo :: BinOp -> BinOp -> BinOp -> [BinOp]
enumFromTo :: BinOp -> BinOp -> [BinOp]
$cenumFromTo :: BinOp -> BinOp -> [BinOp]
enumFromThen :: BinOp -> BinOp -> [BinOp]
$cenumFromThen :: BinOp -> BinOp -> [BinOp]
enumFrom :: BinOp -> [BinOp]
$cenumFrom :: BinOp -> [BinOp]
fromEnum :: BinOp -> Int
$cfromEnum :: BinOp -> Int
toEnum :: Int -> BinOp
$ctoEnum :: Int -> BinOp
pred :: BinOp -> BinOp
$cpred :: BinOp -> BinOp
succ :: BinOp -> BinOp
$csucc :: BinOp -> BinOp
Enum, BinOp
BinOp -> BinOp -> Bounded BinOp
forall a. a -> a -> Bounded a
maxBound :: BinOp
$cmaxBound :: BinOp
minBound :: BinOp
$cminBound :: BinOp
Bounded)

-- | Whether a bound for an end-point of a 'DimSlice' or a range
-- literal is inclusive or exclusive.
data Inclusiveness a = DownToExclusive a
                     | ToInclusive a -- ^ May be "down to" if step is negative.
                     | UpToExclusive a
                     deriving (Inclusiveness a -> Inclusiveness a -> Bool
(Inclusiveness a -> Inclusiveness a -> Bool)
-> (Inclusiveness a -> Inclusiveness a -> Bool)
-> Eq (Inclusiveness a)
forall a. Eq a => Inclusiveness a -> Inclusiveness a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inclusiveness a -> Inclusiveness a -> Bool
$c/= :: forall a. Eq a => Inclusiveness a -> Inclusiveness a -> Bool
== :: Inclusiveness a -> Inclusiveness a -> Bool
$c== :: forall a. Eq a => Inclusiveness a -> Inclusiveness a -> Bool
Eq, Eq (Inclusiveness a)
Eq (Inclusiveness a)
-> (Inclusiveness a -> Inclusiveness a -> Ordering)
-> (Inclusiveness a -> Inclusiveness a -> Bool)
-> (Inclusiveness a -> Inclusiveness a -> Bool)
-> (Inclusiveness a -> Inclusiveness a -> Bool)
-> (Inclusiveness a -> Inclusiveness a -> Bool)
-> (Inclusiveness a -> Inclusiveness a -> Inclusiveness a)
-> (Inclusiveness a -> Inclusiveness a -> Inclusiveness a)
-> Ord (Inclusiveness a)
Inclusiveness a -> Inclusiveness a -> Bool
Inclusiveness a -> Inclusiveness a -> Ordering
Inclusiveness a -> Inclusiveness a -> Inclusiveness 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 (Inclusiveness a)
forall a. Ord a => Inclusiveness a -> Inclusiveness a -> Bool
forall a. Ord a => Inclusiveness a -> Inclusiveness a -> Ordering
forall a.
Ord a =>
Inclusiveness a -> Inclusiveness a -> Inclusiveness a
min :: Inclusiveness a -> Inclusiveness a -> Inclusiveness a
$cmin :: forall a.
Ord a =>
Inclusiveness a -> Inclusiveness a -> Inclusiveness a
max :: Inclusiveness a -> Inclusiveness a -> Inclusiveness a
$cmax :: forall a.
Ord a =>
Inclusiveness a -> Inclusiveness a -> Inclusiveness a
>= :: Inclusiveness a -> Inclusiveness a -> Bool
$c>= :: forall a. Ord a => Inclusiveness a -> Inclusiveness a -> Bool
> :: Inclusiveness a -> Inclusiveness a -> Bool
$c> :: forall a. Ord a => Inclusiveness a -> Inclusiveness a -> Bool
<= :: Inclusiveness a -> Inclusiveness a -> Bool
$c<= :: forall a. Ord a => Inclusiveness a -> Inclusiveness a -> Bool
< :: Inclusiveness a -> Inclusiveness a -> Bool
$c< :: forall a. Ord a => Inclusiveness a -> Inclusiveness a -> Bool
compare :: Inclusiveness a -> Inclusiveness a -> Ordering
$ccompare :: forall a. Ord a => Inclusiveness a -> Inclusiveness a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Inclusiveness a)
Ord, Int -> Inclusiveness a -> ShowS
[Inclusiveness a] -> ShowS
Inclusiveness a -> String
(Int -> Inclusiveness a -> ShowS)
-> (Inclusiveness a -> String)
-> ([Inclusiveness a] -> ShowS)
-> Show (Inclusiveness a)
forall a. Show a => Int -> Inclusiveness a -> ShowS
forall a. Show a => [Inclusiveness a] -> ShowS
forall a. Show a => Inclusiveness a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inclusiveness a] -> ShowS
$cshowList :: forall a. Show a => [Inclusiveness a] -> ShowS
show :: Inclusiveness a -> String
$cshow :: forall a. Show a => Inclusiveness a -> String
showsPrec :: Int -> Inclusiveness a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Inclusiveness a -> ShowS
Show)

instance Located a => Located (Inclusiveness a) where
  locOf :: Inclusiveness a -> Loc
locOf (DownToExclusive a
x) = a -> Loc
forall a. Located a => a -> Loc
locOf a
x
  locOf (ToInclusive a
x) = a -> Loc
forall a. Located a => a -> Loc
locOf a
x
  locOf (UpToExclusive a
x) = a -> Loc
forall a. Located a => a -> Loc
locOf a
x

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

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

instance Traversable Inclusiveness where
  traverse :: (a -> f b) -> Inclusiveness a -> f (Inclusiveness b)
traverse a -> f b
f (DownToExclusive a
x) = b -> Inclusiveness b
forall a. a -> Inclusiveness a
DownToExclusive (b -> Inclusiveness b) -> f b -> f (Inclusiveness b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
  traverse a -> f b
f (ToInclusive a
x) = b -> Inclusiveness b
forall a. a -> Inclusiveness a
ToInclusive (b -> Inclusiveness b) -> f b -> f (Inclusiveness b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
  traverse a -> f b
f (UpToExclusive a
x) = b -> Inclusiveness b
forall a. a -> Inclusiveness a
UpToExclusive (b -> Inclusiveness b) -> f b -> f (Inclusiveness b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

-- | An indexing of a single dimension.
data DimIndexBase f vn = DimFix (ExpBase f vn)
                       | DimSlice (Maybe (ExpBase f vn))
                                  (Maybe (ExpBase f vn))
                                  (Maybe (ExpBase f vn))
deriving instance Showable f vn => Show (DimIndexBase f vn)
deriving instance Eq (DimIndexBase NoInfo VName)
deriving instance Ord (DimIndexBase NoInfo VName)

-- | A name qualified with a breadcrumb of module accesses.
data QualName vn = QualName { QualName vn -> [vn]
qualQuals :: ![vn]
                            , QualName vn -> vn
qualLeaf  :: !vn
                            }
  deriving (Int -> QualName vn -> ShowS
[QualName vn] -> ShowS
QualName vn -> String
(Int -> QualName vn -> ShowS)
-> (QualName vn -> String)
-> ([QualName vn] -> ShowS)
-> Show (QualName vn)
forall vn. Show vn => Int -> QualName vn -> ShowS
forall vn. Show vn => [QualName vn] -> ShowS
forall vn. Show vn => QualName vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualName vn] -> ShowS
$cshowList :: forall vn. Show vn => [QualName vn] -> ShowS
show :: QualName vn -> String
$cshow :: forall vn. Show vn => QualName vn -> String
showsPrec :: Int -> QualName vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> QualName vn -> ShowS
Show)

instance Eq (QualName Name) where
  QualName [Name]
qs1 Name
v1 == :: QualName Name -> QualName Name -> Bool
== QualName [Name]
qs2 Name
v2 = [Name]
qs1 [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
qs2 Bool -> Bool -> Bool
&& Name
v1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
v2

instance Eq (QualName VName) where
  QualName [VName]
_ VName
v1 == :: QualName VName -> QualName VName -> Bool
== QualName [VName]
_ VName
v2 = VName
v1 VName -> VName -> Bool
forall a. Eq a => a -> a -> Bool
== VName
v2

instance Ord (QualName Name) where
  QualName [Name]
qs1 Name
v1 compare :: QualName Name -> QualName Name -> Ordering
`compare` QualName [Name]
qs2 Name
v2 = ([Name], Name) -> ([Name], Name) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Name]
qs1, Name
v1) ([Name]
qs2, Name
v2)

instance Ord (QualName VName) where
  QualName [VName]
_ VName
v1 compare :: QualName VName -> QualName VName -> Ordering
`compare` QualName [VName]
_ VName
v2 = VName -> VName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare VName
v1 VName
v2

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

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

instance Traversable QualName where
  traverse :: (a -> f b) -> QualName a -> f (QualName b)
traverse a -> f b
f (QualName [a]
qs a
v) = [b] -> b -> QualName b
forall vn. [vn] -> vn -> QualName vn
QualName ([b] -> b -> QualName b) -> f [b] -> f (b -> QualName b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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]
qs f (b -> QualName b) -> f b -> f (QualName b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
v

-- | The Futhark expression language.
--
-- In a value of type @Exp f vn@, annotations are wrapped in the
-- functor @f@, and all names are of type @vn@.
--
-- This allows us to encode whether or not the expression has been
-- type-checked in the Haskell type of the expression.  Specifically,
-- the parser will produce expressions of type @Exp 'NoInfo' 'Name'@,
-- and the type checker will convert these to @Exp 'Info' 'VName'@, in
-- which type information is always present and all names are unique.
data ExpBase f vn =
              Literal PrimValue SrcLoc

            | IntLit Integer (f PatternType) SrcLoc
            -- ^ A polymorphic integral literal.

            | FloatLit Double (f PatternType) SrcLoc
            -- ^ A polymorphic decimal literal.

            | StringLit [Word8] SrcLoc
            -- ^ A string literal is just a fancy syntax for an array
            -- of bytes.

            | Parens (ExpBase f vn) SrcLoc
            -- ^ A parenthesized expression.

            | QualParens (QualName vn, SrcLoc) (ExpBase f vn) SrcLoc

            | TupLit    [ExpBase f vn] SrcLoc
            -- ^ Tuple literals, e.g., @{1+3, {x, y+z}}@.

            | RecordLit [FieldBase f vn] SrcLoc
            -- ^ Record literals, e.g. @{x=2,y=3,z}@.

            | ArrayLit  [ExpBase f vn] (f PatternType) SrcLoc
            -- ^ Array literals, e.g., @[ [1+x, 3], [2, 1+4] ]@.
            -- Second arg is the row type of the rows of the array.

            | Range (ExpBase f vn) (Maybe (ExpBase f vn)) (Inclusiveness (ExpBase f vn))
              (f PatternType, f [VName]) SrcLoc

            | Var (QualName vn) (f PatternType) SrcLoc

            | Ascript (ExpBase f vn) (TypeDeclBase f vn) SrcLoc
            -- ^ Type ascription: @e : t@.

            | Coerce (ExpBase f vn) (TypeDeclBase f vn) (f PatternType, f [VName]) SrcLoc
            -- ^ Size coercion: @e :> t@.

            | LetPat (PatternBase f vn) (ExpBase f vn) (ExpBase f vn)
              (f PatternType, f [VName]) SrcLoc

            | LetFun vn ([TypeParamBase vn],
                         [PatternBase f vn],
                         Maybe (TypeExp vn),
                         f StructType,
                         ExpBase f vn)
              (ExpBase f vn) (f PatternType) SrcLoc

            | If (ExpBase f vn) (ExpBase f vn) (ExpBase f vn) (f PatternType, f [VName]) SrcLoc

            | Apply (ExpBase f vn) (ExpBase f vn)
              (f (Diet, Maybe VName)) (f PatternType, f [VName]) SrcLoc
              -- ^ The @Maybe VName@ is a possible existential size
              -- that is instantiated by this argument..
              --
              -- The @[VName]@ are the existential sizes that come
              -- into being at this call site.

            | Negate (ExpBase f vn) SrcLoc
              -- ^ Numeric negation (ugly special case; Haskell did it first).

            | Lambda [PatternBase f vn] (ExpBase f vn)
              (Maybe (TypeExp vn)) (f (Aliasing, StructType)) SrcLoc

            | OpSection (QualName vn) (f PatternType) SrcLoc
              -- ^ @+@; first two types are operands, third is result.
            | OpSectionLeft (QualName vn) (f PatternType) (ExpBase f vn)
              (f (StructType, Maybe VName), f StructType) (f PatternType, f [VName]) SrcLoc
              -- ^ @2+@; first type is operand, second is result.
            | OpSectionRight (QualName vn) (f PatternType) (ExpBase f vn)
              (f StructType, f (StructType, Maybe VName)) (f PatternType) SrcLoc
              -- ^ @+2@; first type is operand, second is result.
            | ProjectSection [Name] (f PatternType) SrcLoc
              -- ^ Field projection as a section: @(.x.y.z)@.
            | IndexSection [DimIndexBase f vn] (f PatternType) SrcLoc
              -- ^ Array indexing as a section: @(.[i,j])@.

            | DoLoop
              [VName] -- Size parameters.
              (PatternBase f vn) -- Merge variable pattern.
              (ExpBase f vn) -- Initial values of merge variables.
              (LoopFormBase f vn) -- Do or while loop.
              (ExpBase f vn) -- Loop body.
              (f (PatternType, [VName])) -- Return type.
              SrcLoc

            | BinOp (QualName vn, SrcLoc) (f PatternType)
              (ExpBase f vn, f (StructType, Maybe VName))
              (ExpBase f vn, f (StructType, Maybe VName))
              (f PatternType) (f [VName]) SrcLoc

            | Project Name (ExpBase f vn) (f PatternType) SrcLoc

            -- Primitive array operations
            | LetWith (IdentBase f vn) (IdentBase f vn)
                      [DimIndexBase f vn] (ExpBase f vn)
                      (ExpBase f vn) (f PatternType) SrcLoc

            | Index (ExpBase f vn) [DimIndexBase f vn] (f PatternType, f [VName]) SrcLoc

            | Update (ExpBase f vn) [DimIndexBase f vn] (ExpBase f vn) SrcLoc

            | RecordUpdate (ExpBase f vn) [Name] (ExpBase f vn) (f PatternType) SrcLoc

            | Assert (ExpBase f vn) (ExpBase f vn) (f String) SrcLoc
            -- ^ Fail if the first expression does not return true,
            -- and return the value of the second expression if it
            -- does.

            | Constr Name [ExpBase f vn] (f PatternType) SrcLoc
            -- ^ An n-ary value constructor.

            | Match (ExpBase f vn) (NE.NonEmpty (CaseBase f vn))
              (f PatternType, f [VName]) SrcLoc
            -- ^ A match expression.

            | Attr AttrInfo (ExpBase f vn) SrcLoc
            -- ^ An attribute applied to the following expression.

deriving instance Showable f vn => Show (ExpBase f vn)
deriving instance Eq (ExpBase NoInfo VName)
deriving instance Ord (ExpBase NoInfo VName)

instance Located (ExpBase f vn) where
  locOf :: ExpBase f vn -> Loc
locOf (Literal PrimValue
_ SrcLoc
loc)                = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IntLit Integer
_ f PatternType
_ SrcLoc
loc)               = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (FloatLit Double
_ f PatternType
_ SrcLoc
loc)             = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Parens ExpBase f vn
_ SrcLoc
loc)                 = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (QualParens (QualName vn, SrcLoc)
_ ExpBase f vn
_ SrcLoc
loc)           = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TupLit [ExpBase f vn]
_ SrcLoc
pos)                 = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (RecordLit [FieldBase f vn]
_ SrcLoc
pos)              = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Project Name
_ ExpBase f vn
_ f PatternType
_ SrcLoc
pos)            = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (ArrayLit [ExpBase f vn]
_ f PatternType
_ SrcLoc
pos)             = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (StringLit [Word8]
_ SrcLoc
loc)              = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Range ExpBase f vn
_ Maybe (ExpBase f vn)
_ Inclusiveness (ExpBase f vn)
_ (f PatternType, f [VName])
_ SrcLoc
pos)            = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (BinOp (QualName vn, SrcLoc)
_ f PatternType
_ (ExpBase f vn, f (StructType, Maybe VName))
_ (ExpBase f vn, f (StructType, Maybe VName))
_ f PatternType
_ f [VName]
_ SrcLoc
loc)        = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (If ExpBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ (f PatternType, f [VName])
_ SrcLoc
pos)               = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Var QualName vn
_ f PatternType
_ SrcLoc
loc)                  = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Ascript ExpBase f vn
_ TypeDeclBase f vn
_ SrcLoc
loc)              = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Coerce ExpBase f vn
_ TypeDeclBase f vn
_ (f PatternType, f [VName])
_ SrcLoc
loc)             = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Negate ExpBase f vn
_ SrcLoc
pos)                 = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Apply ExpBase f vn
_ ExpBase f vn
_ f (Diet, Maybe VName)
_ (f PatternType, f [VName])
_ SrcLoc
loc)            = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetPat PatternBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ (f PatternType, f [VName])
_ SrcLoc
loc)           = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetFun vn
_ ([TypeParamBase vn], [PatternBase f vn], Maybe (TypeExp vn),
 f StructType, ExpBase f vn)
_ ExpBase f vn
_ f PatternType
_ SrcLoc
loc)           = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetWith IdentBase f vn
_ IdentBase f vn
_ [DimIndexBase f vn]
_ ExpBase f vn
_ ExpBase f vn
_ f PatternType
_ SrcLoc
loc)      = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Index ExpBase f vn
_ [DimIndexBase f vn]
_ (f PatternType, f [VName])
_ SrcLoc
loc)              = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Update ExpBase f vn
_ [DimIndexBase f vn]
_ ExpBase f vn
_ SrcLoc
pos)             = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (RecordUpdate ExpBase f vn
_ [Name]
_ ExpBase f vn
_ f PatternType
_ SrcLoc
pos)     = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Lambda [PatternBase f vn]
_ ExpBase f vn
_ Maybe (TypeExp vn)
_ f (Aliasing, StructType)
_ SrcLoc
loc)           = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSection QualName vn
_ f PatternType
_ SrcLoc
loc)            = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSectionLeft QualName vn
_ f PatternType
_ ExpBase f vn
_ (f (StructType, Maybe VName), f StructType)
_ (f PatternType, f [VName])
_ SrcLoc
loc)  = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSectionRight QualName vn
_ f PatternType
_ ExpBase f vn
_ (f StructType, f (StructType, Maybe VName))
_ f PatternType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ProjectSection [Name]
_ f PatternType
_ SrcLoc
loc)       = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IndexSection [DimIndexBase f vn]
_ f PatternType
_ SrcLoc
loc)         = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (DoLoop [VName]
_ PatternBase f vn
_ ExpBase f vn
_ LoopFormBase f vn
_ ExpBase f vn
_ f (PatternType, [VName])
_ SrcLoc
loc)       = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Assert ExpBase f vn
_ ExpBase f vn
_ f String
_ SrcLoc
loc)             = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Constr Name
_ [ExpBase f vn]
_ f PatternType
_ SrcLoc
loc)             = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Match ExpBase f vn
_ NonEmpty (CaseBase f vn)
_ (f PatternType, f [VName])
_ SrcLoc
loc)              = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Attr AttrInfo
_ ExpBase f vn
_ SrcLoc
loc)                 = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | An entry in a record literal.
data FieldBase f vn = RecordFieldExplicit Name (ExpBase f vn) SrcLoc
                    | RecordFieldImplicit vn (f PatternType) SrcLoc
deriving instance Showable f vn => Show (FieldBase f vn)
deriving instance Eq (FieldBase NoInfo VName)
deriving instance Ord (FieldBase NoInfo VName)

instance Located (FieldBase f vn) where
  locOf :: FieldBase f vn -> Loc
locOf (RecordFieldExplicit Name
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (RecordFieldImplicit vn
_ f PatternType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | A case in a match expression.
data CaseBase f vn = CasePat (PatternBase f vn) (ExpBase f vn) SrcLoc
deriving instance Showable f vn => Show (CaseBase f vn)
deriving instance Eq (CaseBase NoInfo VName)
deriving instance Ord (CaseBase NoInfo VName)

instance Located (CaseBase f vn) where
  locOf :: CaseBase f vn -> Loc
locOf (CasePat PatternBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | Whether the loop is a @for@-loop or a @while@-loop.
data LoopFormBase f vn = For (IdentBase f vn) (ExpBase f vn)
                       | ForIn (PatternBase f vn) (ExpBase f vn)
                       | While (ExpBase f vn)
deriving instance Showable f vn => Show (LoopFormBase f vn)
deriving instance Eq (LoopFormBase NoInfo VName)
deriving instance Ord (LoopFormBase NoInfo VName)

-- | A pattern as used most places where variables are bound (function
-- parameters, @let@ expressions, etc).
data PatternBase f vn = TuplePattern [PatternBase f vn] SrcLoc
                      | RecordPattern [(Name, PatternBase f vn)] SrcLoc
                      | PatternParens (PatternBase f vn) SrcLoc
                      | Id vn (f PatternType) SrcLoc
                      | Wildcard (f PatternType) SrcLoc -- Nothing, i.e. underscore.
                      | PatternAscription (PatternBase f vn) (TypeDeclBase f vn) SrcLoc
                      | PatternLit (ExpBase f vn) (f PatternType) SrcLoc
                      | PatternConstr Name (f PatternType) [PatternBase f vn] SrcLoc
deriving instance Showable f vn => Show (PatternBase f vn)
deriving instance Eq (PatternBase NoInfo VName)
deriving instance Ord (PatternBase NoInfo VName)

instance Located (PatternBase f vn) where
  locOf :: PatternBase f vn -> Loc
locOf (TuplePattern [PatternBase f vn]
_ SrcLoc
loc)        = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (RecordPattern [(Name, PatternBase f vn)]
_ SrcLoc
loc)       = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatternParens PatternBase f vn
_ SrcLoc
loc)       = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Id vn
_ f PatternType
_ SrcLoc
loc)                = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Wildcard f PatternType
_ SrcLoc
loc)            = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatternAscription PatternBase f vn
_ TypeDeclBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatternLit ExpBase f vn
_ f PatternType
_ SrcLoc
loc)        = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatternConstr Name
_ f PatternType
_ [PatternBase f vn]
_ SrcLoc
loc)   = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | Documentation strings, including source location.
data DocComment = DocComment String SrcLoc
  deriving (Int -> DocComment -> ShowS
[DocComment] -> ShowS
DocComment -> String
(Int -> DocComment -> ShowS)
-> (DocComment -> String)
-> ([DocComment] -> ShowS)
-> Show DocComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocComment] -> ShowS
$cshowList :: [DocComment] -> ShowS
show :: DocComment -> String
$cshow :: DocComment -> String
showsPrec :: Int -> DocComment -> ShowS
$cshowsPrec :: Int -> DocComment -> ShowS
Show)

instance Located DocComment where
  locOf :: DocComment -> Loc
locOf (DocComment String
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | Part of the type of an entry point.  Has an actual type, and
-- maybe also an ascribed type expression.
data EntryType =
  EntryType { EntryType -> StructType
entryType :: StructType
            , EntryType -> Maybe (TypeExp VName)
entryAscribed :: Maybe (TypeExp VName)
            }
  deriving (Int -> EntryType -> ShowS
[EntryType] -> ShowS
EntryType -> String
(Int -> EntryType -> ShowS)
-> (EntryType -> String)
-> ([EntryType] -> ShowS)
-> Show EntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryType] -> ShowS
$cshowList :: [EntryType] -> ShowS
show :: EntryType -> String
$cshow :: EntryType -> String
showsPrec :: Int -> EntryType -> ShowS
$cshowsPrec :: Int -> EntryType -> ShowS
Show)

-- | Information about the external interface exposed by an entry
-- point.  The important thing is that that we remember the original
-- source-language types, without desugaring them at all.  The
-- annoying thing is that we do not require type annotations on entry
-- points, so the types can be either ascribed or inferred.
data EntryPoint =
  EntryPoint { EntryPoint -> [EntryType]
entryParams :: [EntryType]
             , EntryPoint -> EntryType
entryReturn :: EntryType
             }
  deriving (Int -> EntryPoint -> ShowS
[EntryPoint] -> ShowS
EntryPoint -> String
(Int -> EntryPoint -> ShowS)
-> (EntryPoint -> String)
-> ([EntryPoint] -> ShowS)
-> Show EntryPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryPoint] -> ShowS
$cshowList :: [EntryPoint] -> ShowS
show :: EntryPoint -> String
$cshow :: EntryPoint -> String
showsPrec :: Int -> EntryPoint -> ShowS
$cshowsPrec :: Int -> EntryPoint -> ShowS
Show)

-- | Function Declarations
data ValBindBase f vn = ValBind
  { ValBindBase f vn -> Maybe (f EntryPoint)
valBindEntryPoint :: Maybe (f EntryPoint)
    -- ^ Just if this function is an entry point.  If so, it also
    -- contains the externally visible interface.  Note that this may not
    -- strictly be well-typed after some desugaring operations, as it
    -- may refer to abstract types that are no longer in scope.
  , ValBindBase f vn -> vn
valBindName       :: vn
  , ValBindBase f vn -> Maybe (TypeExp vn)
valBindRetDecl    :: Maybe (TypeExp vn)
  , ValBindBase f vn -> f (StructType, [VName])
valBindRetType    :: f (StructType, [VName])
  , ValBindBase f vn -> [TypeParamBase vn]
valBindTypeParams :: [TypeParamBase vn]
  , ValBindBase f vn -> [PatternBase f vn]
valBindParams     :: [PatternBase f vn]
  , ValBindBase f vn -> ExpBase f vn
valBindBody       :: ExpBase f vn
  , ValBindBase f vn -> Maybe DocComment
valBindDoc        :: Maybe DocComment
  , ValBindBase f vn -> [AttrInfo]
valBindAttrs      :: [AttrInfo]
  , ValBindBase f vn -> SrcLoc
valBindLocation   :: SrcLoc
  }
deriving instance Showable f vn => Show (ValBindBase f vn)

instance Located (ValBindBase f vn) where
  locOf :: ValBindBase f vn -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (ValBindBase f vn -> SrcLoc) -> ValBindBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValBindBase f vn -> SrcLoc
forall (f :: * -> *) vn. ValBindBase f vn -> SrcLoc
valBindLocation

-- | Type Declarations
data TypeBindBase f vn = TypeBind { TypeBindBase f vn -> vn
typeAlias        :: vn
                                  , TypeBindBase f vn -> Liftedness
typeLiftedness   :: Liftedness
                                  , TypeBindBase f vn -> [TypeParamBase vn]
typeParams       :: [TypeParamBase vn]
                                  , TypeBindBase f vn -> TypeDeclBase f vn
typeExp          :: TypeDeclBase f vn
                                  , TypeBindBase f vn -> Maybe DocComment
typeDoc          :: Maybe DocComment
                                  , TypeBindBase f vn -> SrcLoc
typeBindLocation :: SrcLoc
                                  }
deriving instance Showable f vn => Show (TypeBindBase f vn)

instance Located (TypeBindBase f vn) where
  locOf :: TypeBindBase f vn -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (TypeBindBase f vn -> SrcLoc) -> TypeBindBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeBindBase f vn -> SrcLoc
forall (f :: * -> *) vn. TypeBindBase f vn -> SrcLoc
typeBindLocation

-- | The liftedness of a type parameter.  By the @Ord@ instance,
-- @Unlifted < SizeLifted < Lifted@.
data Liftedness
  = Unlifted
    -- ^ May only be instantiated with a zero-order type of (possibly
    -- symbolically) known size.
  | SizeLifted
    -- ^ May only be instantiated with a zero-order type, but the size
    -- can be varying.
  | Lifted
    -- ^ May be instantiated with a functional type.
  deriving (Liftedness -> Liftedness -> Bool
(Liftedness -> Liftedness -> Bool)
-> (Liftedness -> Liftedness -> Bool) -> Eq Liftedness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Liftedness -> Liftedness -> Bool
$c/= :: Liftedness -> Liftedness -> Bool
== :: Liftedness -> Liftedness -> Bool
$c== :: Liftedness -> Liftedness -> Bool
Eq, Eq Liftedness
Eq Liftedness
-> (Liftedness -> Liftedness -> Ordering)
-> (Liftedness -> Liftedness -> Bool)
-> (Liftedness -> Liftedness -> Bool)
-> (Liftedness -> Liftedness -> Bool)
-> (Liftedness -> Liftedness -> Bool)
-> (Liftedness -> Liftedness -> Liftedness)
-> (Liftedness -> Liftedness -> Liftedness)
-> Ord Liftedness
Liftedness -> Liftedness -> Bool
Liftedness -> Liftedness -> Ordering
Liftedness -> Liftedness -> Liftedness
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 :: Liftedness -> Liftedness -> Liftedness
$cmin :: Liftedness -> Liftedness -> Liftedness
max :: Liftedness -> Liftedness -> Liftedness
$cmax :: Liftedness -> Liftedness -> Liftedness
>= :: Liftedness -> Liftedness -> Bool
$c>= :: Liftedness -> Liftedness -> Bool
> :: Liftedness -> Liftedness -> Bool
$c> :: Liftedness -> Liftedness -> Bool
<= :: Liftedness -> Liftedness -> Bool
$c<= :: Liftedness -> Liftedness -> Bool
< :: Liftedness -> Liftedness -> Bool
$c< :: Liftedness -> Liftedness -> Bool
compare :: Liftedness -> Liftedness -> Ordering
$ccompare :: Liftedness -> Liftedness -> Ordering
$cp1Ord :: Eq Liftedness
Ord, Int -> Liftedness -> ShowS
[Liftedness] -> ShowS
Liftedness -> String
(Int -> Liftedness -> ShowS)
-> (Liftedness -> String)
-> ([Liftedness] -> ShowS)
-> Show Liftedness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Liftedness] -> ShowS
$cshowList :: [Liftedness] -> ShowS
show :: Liftedness -> String
$cshow :: Liftedness -> String
showsPrec :: Int -> Liftedness -> ShowS
$cshowsPrec :: Int -> Liftedness -> ShowS
Show)

-- | A type parameter.
data TypeParamBase vn
  = TypeParamDim vn SrcLoc
    -- ^ A type parameter that must be a size.
  | TypeParamType Liftedness vn SrcLoc
    -- ^ A type parameter that must be a type.
  deriving (TypeParamBase vn -> TypeParamBase vn -> Bool
(TypeParamBase vn -> TypeParamBase vn -> Bool)
-> (TypeParamBase vn -> TypeParamBase vn -> Bool)
-> Eq (TypeParamBase vn)
forall vn. Eq vn => TypeParamBase vn -> TypeParamBase vn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeParamBase vn -> TypeParamBase vn -> Bool
$c/= :: forall vn. Eq vn => TypeParamBase vn -> TypeParamBase vn -> Bool
== :: TypeParamBase vn -> TypeParamBase vn -> Bool
$c== :: forall vn. Eq vn => TypeParamBase vn -> TypeParamBase vn -> Bool
Eq, Eq (TypeParamBase vn)
Eq (TypeParamBase vn)
-> (TypeParamBase vn -> TypeParamBase vn -> Ordering)
-> (TypeParamBase vn -> TypeParamBase vn -> Bool)
-> (TypeParamBase vn -> TypeParamBase vn -> Bool)
-> (TypeParamBase vn -> TypeParamBase vn -> Bool)
-> (TypeParamBase vn -> TypeParamBase vn -> Bool)
-> (TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn)
-> (TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn)
-> Ord (TypeParamBase vn)
TypeParamBase vn -> TypeParamBase vn -> Bool
TypeParamBase vn -> TypeParamBase vn -> Ordering
TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn
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 vn. Ord vn => Eq (TypeParamBase vn)
forall vn. Ord vn => TypeParamBase vn -> TypeParamBase vn -> Bool
forall vn.
Ord vn =>
TypeParamBase vn -> TypeParamBase vn -> Ordering
forall vn.
Ord vn =>
TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn
min :: TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn
$cmin :: forall vn.
Ord vn =>
TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn
max :: TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn
$cmax :: forall vn.
Ord vn =>
TypeParamBase vn -> TypeParamBase vn -> TypeParamBase vn
>= :: TypeParamBase vn -> TypeParamBase vn -> Bool
$c>= :: forall vn. Ord vn => TypeParamBase vn -> TypeParamBase vn -> Bool
> :: TypeParamBase vn -> TypeParamBase vn -> Bool
$c> :: forall vn. Ord vn => TypeParamBase vn -> TypeParamBase vn -> Bool
<= :: TypeParamBase vn -> TypeParamBase vn -> Bool
$c<= :: forall vn. Ord vn => TypeParamBase vn -> TypeParamBase vn -> Bool
< :: TypeParamBase vn -> TypeParamBase vn -> Bool
$c< :: forall vn. Ord vn => TypeParamBase vn -> TypeParamBase vn -> Bool
compare :: TypeParamBase vn -> TypeParamBase vn -> Ordering
$ccompare :: forall vn.
Ord vn =>
TypeParamBase vn -> TypeParamBase vn -> Ordering
$cp1Ord :: forall vn. Ord vn => Eq (TypeParamBase vn)
Ord, Int -> TypeParamBase vn -> ShowS
[TypeParamBase vn] -> ShowS
TypeParamBase vn -> String
(Int -> TypeParamBase vn -> ShowS)
-> (TypeParamBase vn -> String)
-> ([TypeParamBase vn] -> ShowS)
-> Show (TypeParamBase vn)
forall vn. Show vn => Int -> TypeParamBase vn -> ShowS
forall vn. Show vn => [TypeParamBase vn] -> ShowS
forall vn. Show vn => TypeParamBase vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeParamBase vn] -> ShowS
$cshowList :: forall vn. Show vn => [TypeParamBase vn] -> ShowS
show :: TypeParamBase vn -> String
$cshow :: forall vn. Show vn => TypeParamBase vn -> String
showsPrec :: Int -> TypeParamBase vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> TypeParamBase vn -> ShowS
Show)

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

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

instance Traversable TypeParamBase where
  traverse :: (a -> f b) -> TypeParamBase a -> f (TypeParamBase b)
traverse a -> f b
f (TypeParamDim a
v SrcLoc
loc) = b -> SrcLoc -> TypeParamBase b
forall vn. vn -> SrcLoc -> TypeParamBase vn
TypeParamDim (b -> SrcLoc -> TypeParamBase b)
-> f b -> f (SrcLoc -> TypeParamBase b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v f (SrcLoc -> TypeParamBase b) -> f SrcLoc -> f (TypeParamBase b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (TypeParamType Liftedness
l a
v SrcLoc
loc) = Liftedness -> b -> SrcLoc -> TypeParamBase b
forall vn. Liftedness -> vn -> SrcLoc -> TypeParamBase vn
TypeParamType Liftedness
l (b -> SrcLoc -> TypeParamBase b)
-> f b -> f (SrcLoc -> TypeParamBase b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v f (SrcLoc -> TypeParamBase b) -> f SrcLoc -> f (TypeParamBase b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

instance Located (TypeParamBase vn) where
  locOf :: TypeParamBase vn -> Loc
locOf (TypeParamDim vn
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TypeParamType Liftedness
_ vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | The name of a type parameter.
typeParamName :: TypeParamBase vn -> vn
typeParamName :: TypeParamBase vn -> vn
typeParamName (TypeParamDim vn
v SrcLoc
_)    = vn
v
typeParamName (TypeParamType Liftedness
_ vn
v SrcLoc
_) = vn
v

-- | A spec is a component of a module type.
data SpecBase f vn
  = ValSpec  { SpecBase f vn -> vn
specName       :: vn
             , SpecBase f vn -> [TypeParamBase vn]
specTypeParams :: [TypeParamBase vn]
             , SpecBase f vn -> TypeDeclBase f vn
specType       :: TypeDeclBase f vn
             , SpecBase f vn -> Maybe DocComment
specDoc        :: Maybe DocComment
             , SpecBase f vn -> SrcLoc
specLocation   :: SrcLoc
             }
  | TypeAbbrSpec (TypeBindBase f vn)
  | TypeSpec Liftedness vn [TypeParamBase vn] (Maybe DocComment) SrcLoc
    -- ^ Abstract type.
  | ModSpec vn (SigExpBase f vn) (Maybe DocComment) SrcLoc
  | IncludeSpec (SigExpBase f vn) SrcLoc
deriving instance Showable f vn => Show (SpecBase f vn)

instance Located (SpecBase f vn) where
  locOf :: SpecBase f vn -> Loc
locOf (ValSpec vn
_ [TypeParamBase vn]
_ TypeDeclBase f vn
_ Maybe DocComment
_ SrcLoc
loc)  = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TypeAbbrSpec TypeBindBase f vn
tbind)   = TypeBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf TypeBindBase f vn
tbind
  locOf (TypeSpec Liftedness
_ vn
_ [TypeParamBase vn]
_ Maybe DocComment
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModSpec vn
_ SigExpBase f vn
_ Maybe DocComment
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IncludeSpec SigExpBase f vn
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | A module type expression.
data SigExpBase f vn
  = SigVar (QualName vn) (f (M.Map VName VName)) SrcLoc
  | SigParens (SigExpBase f vn) SrcLoc
  | SigSpecs [SpecBase f vn] SrcLoc
  | SigWith (SigExpBase f vn) (TypeRefBase f vn) SrcLoc
  | SigArrow (Maybe vn) (SigExpBase f vn) (SigExpBase f vn) SrcLoc
deriving instance Showable f vn => Show (SigExpBase f vn)

-- | A type refinement.
data TypeRefBase f vn = TypeRef (QualName vn) [TypeParamBase vn] (TypeDeclBase f vn) SrcLoc
deriving instance Showable f vn => Show (TypeRefBase f vn)

instance Located (TypeRefBase f vn) where
  locOf :: TypeRefBase f vn -> Loc
locOf (TypeRef QualName vn
_ [TypeParamBase vn]
_ TypeDeclBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

instance Located (SigExpBase f vn) where
  locOf :: SigExpBase f vn -> Loc
locOf (SigVar QualName vn
_ f (Map VName VName)
_ SrcLoc
loc)     = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigParens SigExpBase f vn
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigSpecs [SpecBase f vn]
_ SrcLoc
loc)     = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigWith SigExpBase f vn
_ TypeRefBase f vn
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigArrow Maybe vn
_ SigExpBase f vn
_ SigExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | Module type binding.
data SigBindBase f vn = SigBind { SigBindBase f vn -> vn
sigName :: vn
                                , SigBindBase f vn -> SigExpBase f vn
sigExp  :: SigExpBase f vn
                                , SigBindBase f vn -> Maybe DocComment
sigDoc  :: Maybe DocComment
                                , SigBindBase f vn -> SrcLoc
sigLoc  :: SrcLoc
                                }
deriving instance Showable f vn => Show (SigBindBase f vn)

instance Located (SigBindBase f vn) where
  locOf :: SigBindBase f vn -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (SigBindBase f vn -> SrcLoc) -> SigBindBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigBindBase f vn -> SrcLoc
forall (f :: * -> *) vn. SigBindBase f vn -> SrcLoc
sigLoc

-- | Module expression.
data ModExpBase f vn
  = ModVar (QualName vn) SrcLoc
  | ModParens (ModExpBase f vn) SrcLoc
  | ModImport FilePath (f FilePath) SrcLoc
    -- ^ The contents of another file as a module.
  | ModDecs [DecBase f vn] SrcLoc
  | ModApply (ModExpBase f vn) (ModExpBase f vn)
    (f (M.Map VName VName)) (f (M.Map VName VName)) SrcLoc
    -- ^ Functor application.  The first mapping is from parameter
    -- names to argument names, while the second maps names in the
    -- constructed module to the names inside the functor.
  | ModAscript (ModExpBase f vn) (SigExpBase f vn) (f (M.Map VName VName)) SrcLoc
  | ModLambda (ModParamBase f vn)
    (Maybe (SigExpBase f vn, f (M.Map VName VName)))
    (ModExpBase f vn)
    SrcLoc
deriving instance Showable f vn => Show (ModExpBase f vn)

instance Located (ModExpBase f vn) where
  locOf :: ModExpBase f vn -> Loc
locOf (ModVar QualName vn
_ SrcLoc
loc)         = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModParens ModExpBase f vn
_ SrcLoc
loc)      = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModImport String
_ f String
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModDecs [DecBase f vn]
_ SrcLoc
loc)        = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModApply ModExpBase f vn
_ ModExpBase f vn
_ f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModAscript ModExpBase f vn
_ SigExpBase f vn
_ f (Map VName VName)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModLambda ModParamBase f vn
_ Maybe (SigExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
_ SrcLoc
loc)  = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | A module binding.
data ModBindBase f vn =
  ModBind { ModBindBase f vn -> vn
modName      :: vn
          , ModBindBase f vn -> [ModParamBase f vn]
modParams    :: [ModParamBase f vn]
          , ModBindBase f vn -> Maybe (SigExpBase f vn, f (Map VName VName))
modSignature :: Maybe (SigExpBase f vn, f (M.Map VName VName))
          , ModBindBase f vn -> ModExpBase f vn
modExp       :: ModExpBase f vn
          , ModBindBase f vn -> Maybe DocComment
modDoc       :: Maybe DocComment
          , ModBindBase f vn -> SrcLoc
modLocation  :: SrcLoc
          }
deriving instance Showable f vn => Show (ModBindBase f vn)

instance Located (ModBindBase f vn) where
  locOf :: ModBindBase f vn -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (ModBindBase f vn -> SrcLoc) -> ModBindBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModBindBase f vn -> SrcLoc
forall (f :: * -> *) vn. ModBindBase f vn -> SrcLoc
modLocation

-- | A module parameter.
data ModParamBase f vn = ModParam { ModParamBase f vn -> vn
modParamName     :: vn
                                  , ModParamBase f vn -> SigExpBase f vn
modParamType     :: SigExpBase f vn
                                  , ModParamBase f vn -> f [VName]
modParamAbs      :: f [VName]
                                  , ModParamBase f vn -> SrcLoc
modParamLocation :: SrcLoc
                                  }
deriving instance Showable f vn => Show (ModParamBase f vn)

instance Located (ModParamBase f vn) where
  locOf :: ModParamBase f vn -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (ModParamBase f vn -> SrcLoc) -> ModParamBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModParamBase f vn -> SrcLoc
forall (f :: * -> *) vn. ModParamBase f vn -> SrcLoc
modParamLocation

-- | A top-level binding.
data DecBase f vn = ValDec (ValBindBase f vn)
                  | TypeDec (TypeBindBase f vn)
                  | SigDec (SigBindBase f vn)
                  | ModDec (ModBindBase f vn)
                  | OpenDec (ModExpBase f vn) SrcLoc
                  | LocalDec (DecBase f vn) SrcLoc
                  | ImportDec FilePath (f FilePath) SrcLoc
deriving instance Showable f vn => Show (DecBase f vn)

instance Located (DecBase f vn) where
  locOf :: DecBase f vn -> Loc
locOf (ValDec ValBindBase f vn
d)          = ValBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf ValBindBase f vn
d
  locOf (TypeDec TypeBindBase f vn
d)         = TypeBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf TypeBindBase f vn
d
  locOf (SigDec SigBindBase f vn
d)          = SigBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf SigBindBase f vn
d
  locOf (ModDec ModBindBase f vn
d)          = ModBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf ModBindBase f vn
d
  locOf (OpenDec ModExpBase f vn
_ SrcLoc
loc)     = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LocalDec DecBase f vn
_ SrcLoc
loc)    = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ImportDec String
_ f String
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | The program described by a single Futhark file.  May depend on
-- other files.
data ProgBase f vn = Prog { ProgBase f vn -> Maybe DocComment
progDoc :: Maybe DocComment
                          , ProgBase f vn -> [DecBase f vn]
progDecs :: [DecBase f vn]
                          }
deriving instance Showable f vn => Show (ProgBase f vn)

--- Some prettyprinting definitions are here because we need them in
--- the Attributes module.

instance Pretty PrimType where
  ppr :: PrimType -> Doc
ppr (Unsigned IntType
Int8)  = String -> Doc
text String
"u8"
  ppr (Unsigned IntType
Int16) = String -> Doc
text String
"u16"
  ppr (Unsigned IntType
Int32) = String -> Doc
text String
"u32"
  ppr (Unsigned IntType
Int64) = String -> Doc
text String
"u64"
  ppr (Signed IntType
t)       = IntType -> Doc
forall a. Pretty a => a -> Doc
ppr IntType
t
  ppr (FloatType FloatType
t)    = FloatType -> Doc
forall a. Pretty a => a -> Doc
ppr FloatType
t
  ppr PrimType
Bool             = String -> Doc
text String
"bool"

instance Pretty BinOp where
  ppr :: BinOp -> Doc
ppr BinOp
Backtick  = String -> Doc
text String
"``"
  ppr BinOp
Plus      = String -> Doc
text String
"+"
  ppr BinOp
Minus     = String -> Doc
text String
"-"
  ppr BinOp
Pow       = String -> Doc
text String
"**"
  ppr BinOp
Times     = String -> Doc
text String
"*"
  ppr BinOp
Divide    = String -> Doc
text String
"/"
  ppr BinOp
Mod       = String -> Doc
text String
"%"
  ppr BinOp
Quot      = String -> Doc
text String
"//"
  ppr BinOp
Rem       = String -> Doc
text String
"%%"
  ppr BinOp
ShiftR    = String -> Doc
text String
">>"
  ppr BinOp
ShiftL    = String -> Doc
text String
"<<"
  ppr BinOp
Band      = String -> Doc
text String
"&"
  ppr BinOp
Xor       = String -> Doc
text String
"^"
  ppr BinOp
Bor       = String -> Doc
text String
"|"
  ppr BinOp
LogAnd    = String -> Doc
text String
"&&"
  ppr BinOp
LogOr     = String -> Doc
text String
"||"
  ppr BinOp
Equal     = String -> Doc
text String
"=="
  ppr BinOp
NotEqual  = String -> Doc
text String
"!="
  ppr BinOp
Less      = String -> Doc
text String
"<"
  ppr BinOp
Leq       = String -> Doc
text String
"<="
  ppr BinOp
Greater   = String -> Doc
text String
">"
  ppr BinOp
Geq       = String -> Doc
text String
">="
  ppr BinOp
PipeLeft  = String -> Doc
text String
"<|"
  ppr BinOp
PipeRight = String -> Doc
text String
"|>"