{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Strict #-}

-- | The Futhark source language AST definition.  Many types, such as
-- 'ExpBase'@, are parametrised by type and name representation.
-- E.g. in a value of type @ExpBase f vn@, annotations are wrapped in
-- the functor @f@, and all names are of type @vn@.  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,
    pretty,

    -- * 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 (..),
    SliceBase,
    SizeBinder (..),
    AppExpBase (..),
    AppRes (..),
    ExpBase (..),
    FieldBase (..),
    CaseBase (..),
    LoopFormBase (..),
    PatLit (..),
    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.List.NonEmpty as NE
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 Futhark.IR.Primitive
  ( FloatType (..),
    FloatValue (..),
    IntType (..),
    IntValue (..),
  )
import Futhark.Util.Loc
import Futhark.Util.Pretty
import Language.Futhark.Core
import Prelude

-- | 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 StructType),
    Show (f (StructType, Maybe VName)),
    Show (f (PName, StructType)),
    Show (f (PName, StructType, Maybe VName)),
    Show (f (Aliasing, StructType)),
    Show (f (M.Map VName VName)),
    Show (f AppRes)
  ) =>
  Showable f vn

-- | 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
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

instance Functor NoInfo where
  fmap :: forall a b. (a -> b) -> NoInfo a -> NoInfo b
fmap a -> b
_ NoInfo a
NoInfo = NoInfo b
forall a. NoInfo a
NoInfo

instance Foldable NoInfo where
  foldr :: forall a b. (a -> b -> b) -> b -> NoInfo a -> b
foldr a -> b -> b
_ b
b NoInfo a
NoInfo = b
b

instance Traversable NoInfo where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(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 {forall a. 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
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

instance Functor Info where
  fmap :: forall a b. (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 :: forall a b. (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 :: forall (f :: * -> *) a b.
Applicative f =>
(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
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
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
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
  = -- | The size of the dimension is this name, which
    -- must be in scope.  In a return type, this will
    -- give rise to an assertion.
    NamedDim (QualName vn)
  | -- | The size is a constant.
    ConstDim Int
  | -- | No known size - but still possibly given a unique name, so we
    -- can recognise e.g. @type square [n] = [n][n]i32@ and make
    -- @square []@ do the right thing.  If @Nothing@, then this is a
    -- name distinct from any other.
    AnyDim (Maybe vn)
  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 VName)

deriving instance Ord (DimDecl VName)

instance Functor DimDecl where
  fmap :: forall a b. (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 :: forall m a. Monoid m => (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 :: forall (f :: * -> *) a b.
Applicative f =>
(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
f (AnyDim Maybe a
v) = Maybe b -> DimDecl b
forall vn. Maybe vn -> DimDecl vn
AnyDim (Maybe b -> DimDecl b) -> f (Maybe b) -> f (DimDecl b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Maybe a -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Maybe a
v

-- 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 AnyDim {} DimDecl VName
y = DimDecl VName -> Maybe (DimDecl VName)
forall a. a -> Maybe a
Just DimDecl VName
y
  unifyDims DimDecl VName
x 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 {forall dim. 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
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 :: forall a b. (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 :: forall (f :: * -> *) a b.
Applicative f =>
(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 :: forall a b. (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 :: forall a. ShapeDecl a -> 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 dim. ShapeDecl dim -> [dim]
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 :: forall dim. 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 :: forall dim.
ArrayDim dim =>
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])
  | -- | The aliasing corresponds to the lexical
    -- closure of the function.
    Arrow as PName (TypeBase dim as) (TypeBase dim as)
  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
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 :: forall (f :: * -> *) a c b d.
Applicative f =>
(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 :: forall a b c d.
(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 :: forall m a b.
Monoid m =>
(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
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 :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
bitraverse a -> f c
f b -> f d
g (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 :: forall a b c d.
(a -> b) -> (c -> d) -> TypeBase a c -> TypeBase b d
bimap = (a -> b) -> (c -> d) -> TypeBase a c -> TypeBase b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault

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

-- | 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
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 :: forall (f :: * -> *) a b.
Applicative f =>
(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 :: forall a b. (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 :: forall m a. Monoid m => (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
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 Int64 ()

-- | A dimension declaration expression for use in a 'TypeExp'.
data DimExp vn
  = -- | The size of the dimension is this name, which
    -- must be in scope.
    DimExpNamed (QualName vn) SrcLoc
  | -- | The size is a constant.
    DimExpConst Int SrcLoc
  | -- | No dimension declaration.
    DimExpAny
  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
  { -- | The type declared by the user.
    forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType :: TypeExp vn,
    -- | The type deduced by the type checker.
    forall (f :: * -> *) vn. TypeDeclBase f vn -> f StructType
expandedType :: f StructType
  }

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
  = -- | Consumes these fields in the record.
    RecordDiet (M.Map Name 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.
    FuncDiet Diet Diet
  | -- | Consumes this value.
    Consume
  | -- | Only observes value in this position, does
    -- not consume.
    Observe
  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
  | -- | It is assumed that the array is 0-indexed.  The type
    -- is the full type.
    ArrayValue !(Array Int Value) ValueType
  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
  { forall (f :: * -> *) vn. IdentBase f vn -> vn
identName :: vn,
    forall (f :: * -> *) vn. IdentBase f vn -> f PatternType
identType :: f PatternType,
    forall (f :: * -> *) vn. 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
  = -- | A pseudo-operator standing in for any normal
    -- identifier used as an operator (they all have the
    -- same fixity).
    -- Binary Ops for Numbers
    Backtick
  | 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
  | -- | @<|@
    -- Misc
    PipeLeft
  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
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
  | -- | May be "down to" if step is negative.
    ToInclusive a
  | 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
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 :: forall a b. (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 :: forall m a. Monoid m => (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 :: forall (f :: * -> *) a b.
Applicative f =>
(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 slicing of an array (potentially multiple dimensions).
type SliceBase f vn = [DimIndexBase f vn]

-- | A name qualified with a breadcrumb of module accesses.
data QualName vn = QualName
  { forall vn. QualName vn -> [vn]
qualQuals :: ![vn],
    forall 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 :: forall a b. (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 :: forall m a. Monoid m => (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 :: forall (f :: * -> *) a b.
Applicative f =>
(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

-- | A binding of a size in a pattern (essentially a size parameter in
-- a @let@ expression).
data SizeBinder vn = SizeBinder {forall vn. SizeBinder vn -> vn
sizeName :: !vn, forall vn. SizeBinder vn -> SrcLoc
sizeLoc :: !SrcLoc}
  deriving (SizeBinder vn -> SizeBinder vn -> Bool
(SizeBinder vn -> SizeBinder vn -> Bool)
-> (SizeBinder vn -> SizeBinder vn -> Bool) -> Eq (SizeBinder vn)
forall vn. Eq vn => SizeBinder vn -> SizeBinder vn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SizeBinder vn -> SizeBinder vn -> Bool
$c/= :: forall vn. Eq vn => SizeBinder vn -> SizeBinder vn -> Bool
== :: SizeBinder vn -> SizeBinder vn -> Bool
$c== :: forall vn. Eq vn => SizeBinder vn -> SizeBinder vn -> Bool
Eq, Eq (SizeBinder vn)
Eq (SizeBinder vn)
-> (SizeBinder vn -> SizeBinder vn -> Ordering)
-> (SizeBinder vn -> SizeBinder vn -> Bool)
-> (SizeBinder vn -> SizeBinder vn -> Bool)
-> (SizeBinder vn -> SizeBinder vn -> Bool)
-> (SizeBinder vn -> SizeBinder vn -> Bool)
-> (SizeBinder vn -> SizeBinder vn -> SizeBinder vn)
-> (SizeBinder vn -> SizeBinder vn -> SizeBinder vn)
-> Ord (SizeBinder vn)
SizeBinder vn -> SizeBinder vn -> Bool
SizeBinder vn -> SizeBinder vn -> Ordering
SizeBinder vn -> SizeBinder vn -> SizeBinder 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 (SizeBinder vn)
forall vn. Ord vn => SizeBinder vn -> SizeBinder vn -> Bool
forall vn. Ord vn => SizeBinder vn -> SizeBinder vn -> Ordering
forall vn.
Ord vn =>
SizeBinder vn -> SizeBinder vn -> SizeBinder vn
min :: SizeBinder vn -> SizeBinder vn -> SizeBinder vn
$cmin :: forall vn.
Ord vn =>
SizeBinder vn -> SizeBinder vn -> SizeBinder vn
max :: SizeBinder vn -> SizeBinder vn -> SizeBinder vn
$cmax :: forall vn.
Ord vn =>
SizeBinder vn -> SizeBinder vn -> SizeBinder vn
>= :: SizeBinder vn -> SizeBinder vn -> Bool
$c>= :: forall vn. Ord vn => SizeBinder vn -> SizeBinder vn -> Bool
> :: SizeBinder vn -> SizeBinder vn -> Bool
$c> :: forall vn. Ord vn => SizeBinder vn -> SizeBinder vn -> Bool
<= :: SizeBinder vn -> SizeBinder vn -> Bool
$c<= :: forall vn. Ord vn => SizeBinder vn -> SizeBinder vn -> Bool
< :: SizeBinder vn -> SizeBinder vn -> Bool
$c< :: forall vn. Ord vn => SizeBinder vn -> SizeBinder vn -> Bool
compare :: SizeBinder vn -> SizeBinder vn -> Ordering
$ccompare :: forall vn. Ord vn => SizeBinder vn -> SizeBinder vn -> Ordering
Ord, Int -> SizeBinder vn -> ShowS
[SizeBinder vn] -> ShowS
SizeBinder vn -> String
(Int -> SizeBinder vn -> ShowS)
-> (SizeBinder vn -> String)
-> ([SizeBinder vn] -> ShowS)
-> Show (SizeBinder vn)
forall vn. Show vn => Int -> SizeBinder vn -> ShowS
forall vn. Show vn => [SizeBinder vn] -> ShowS
forall vn. Show vn => SizeBinder vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SizeBinder vn] -> ShowS
$cshowList :: forall vn. Show vn => [SizeBinder vn] -> ShowS
show :: SizeBinder vn -> String
$cshow :: forall vn. Show vn => SizeBinder vn -> String
showsPrec :: Int -> SizeBinder vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> SizeBinder vn -> ShowS
Show)

instance Located (SizeBinder vn) where
  locOf :: SizeBinder vn -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (SizeBinder vn -> SrcLoc) -> SizeBinder vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeBinder vn -> SrcLoc
forall vn. SizeBinder vn -> SrcLoc
sizeLoc

-- | An "application expression" is a semantic (not syntactic)
-- grouping of expressions that have "funcall-like" semantics, mostly
-- meaning that they can return existential sizes.  In our type
-- theory, these are all thought to be bound to names (*Administrative
-- Normal Form*), but as this is not practical in a real language, we
-- instead use an annotation ('AppRes') that stores the information we
-- need, so we can pretend that an application expression was really
-- bound to a name.
data AppExpBase f vn
  = -- | The @Maybe VName@ is a possible existential size
    -- that is instantiated by this argument..
    Apply
      (ExpBase f vn)
      (ExpBase f vn)
      (f (Diet, Maybe VName))
      SrcLoc
  | -- | Size coercion: @e :> t@.
    Coerce (ExpBase f vn) (TypeDeclBase f vn) SrcLoc
  | Range
      (ExpBase f vn)
      (Maybe (ExpBase f vn))
      (Inclusiveness (ExpBase f vn))
      SrcLoc
  | LetPat
      [SizeBinder vn]
      (PatternBase f vn)
      (ExpBase f vn)
      (ExpBase f vn)
      SrcLoc
  | LetFun
      vn
      ( [TypeParamBase vn],
        [PatternBase f vn],
        Maybe (TypeExp vn),
        f StructType,
        ExpBase f vn
      )
      (ExpBase f vn)
      SrcLoc
  | If (ExpBase f vn) (ExpBase f vn) (ExpBase f vn) SrcLoc
  | 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.
      SrcLoc
  | BinOp
      (QualName vn, SrcLoc)
      (f PatternType)
      (ExpBase f vn, f (StructType, Maybe VName))
      (ExpBase f vn, f (StructType, Maybe VName))
      SrcLoc
  | LetWith
      (IdentBase f vn)
      (IdentBase f vn)
      (SliceBase f vn)
      (ExpBase f vn)
      (ExpBase f vn)
      SrcLoc
  | Index (ExpBase f vn) (SliceBase f vn) SrcLoc
  | -- | A match expression.
    Match (ExpBase f vn) (NE.NonEmpty (CaseBase f vn)) SrcLoc

deriving instance Showable f vn => Show (AppExpBase f vn)

deriving instance Eq (AppExpBase NoInfo VName)

deriving instance Ord (AppExpBase NoInfo VName)

instance Located (AppExpBase f vn) where
  locOf :: AppExpBase f vn -> Loc
locOf (Range ExpBase f vn
_ Maybe (ExpBase f vn)
_ Inclusiveness (ExpBase f vn)
_ 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))
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (If ExpBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Coerce ExpBase f vn
_ TypeDeclBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Apply ExpBase f vn
_ ExpBase f vn
_ f (Diet, Maybe VName)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetPat [SizeBinder vn]
_ PatternBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ 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
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetWith IdentBase f vn
_ IdentBase f vn
_ SliceBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Index ExpBase f vn
_ SliceBase f vn
_ 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
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Match ExpBase f vn
_ NonEmpty (CaseBase f vn)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | An annotation inserted by the type checker on constructs that are
-- "function calls" (either literally or conceptually).  This
-- annotation encodes the result type, as well as any existential
-- sizes that are generated here.
data AppRes = AppRes
  { AppRes -> PatternType
appResType :: PatternType,
    AppRes -> [VName]
appResExt :: [VName]
  }
  deriving (AppRes -> AppRes -> Bool
(AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool) -> Eq AppRes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppRes -> AppRes -> Bool
$c/= :: AppRes -> AppRes -> Bool
== :: AppRes -> AppRes -> Bool
$c== :: AppRes -> AppRes -> Bool
Eq, Eq AppRes
Eq AppRes
-> (AppRes -> AppRes -> Ordering)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> AppRes)
-> (AppRes -> AppRes -> AppRes)
-> Ord AppRes
AppRes -> AppRes -> Bool
AppRes -> AppRes -> Ordering
AppRes -> AppRes -> AppRes
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 :: AppRes -> AppRes -> AppRes
$cmin :: AppRes -> AppRes -> AppRes
max :: AppRes -> AppRes -> AppRes
$cmax :: AppRes -> AppRes -> AppRes
>= :: AppRes -> AppRes -> Bool
$c>= :: AppRes -> AppRes -> Bool
> :: AppRes -> AppRes -> Bool
$c> :: AppRes -> AppRes -> Bool
<= :: AppRes -> AppRes -> Bool
$c<= :: AppRes -> AppRes -> Bool
< :: AppRes -> AppRes -> Bool
$c< :: AppRes -> AppRes -> Bool
compare :: AppRes -> AppRes -> Ordering
$ccompare :: AppRes -> AppRes -> Ordering
Ord, Int -> AppRes -> ShowS
[AppRes] -> ShowS
AppRes -> String
(Int -> AppRes -> ShowS)
-> (AppRes -> String) -> ([AppRes] -> ShowS) -> Show AppRes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppRes] -> ShowS
$cshowList :: [AppRes] -> ShowS
show :: AppRes -> String
$cshow :: AppRes -> String
showsPrec :: Int -> AppRes -> ShowS
$cshowsPrec :: Int -> AppRes -> ShowS
Show)

-- | The Futhark expression language.
--
-- 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
  | -- | A polymorphic integral literal.
    IntLit Integer (f PatternType) SrcLoc
  | -- | A polymorphic decimal literal.
    FloatLit Double (f PatternType) SrcLoc
  | -- | A string literal is just a fancy syntax for an array
    -- of bytes.
    StringLit [Word8] SrcLoc
  | Var (QualName vn) (f PatternType) SrcLoc
  | -- | A parenthesized expression.
    Parens (ExpBase f vn) SrcLoc
  | QualParens (QualName vn, SrcLoc) (ExpBase f vn) SrcLoc
  | -- | Tuple literals, e.g., @{1+3, {x, y+z}}@.
    TupLit [ExpBase f vn] SrcLoc
  | -- | Record literals, e.g. @{x=2,y=3,z}@.
    RecordLit [FieldBase f vn] SrcLoc
  | -- | Array literals, e.g., @[ [1+x, 3], [2, 1+4] ]@.
    -- Second arg is the row type of the rows of the array.
    ArrayLit [ExpBase f vn] (f PatternType) SrcLoc
  | -- | An attribute applied to the following expression.
    Attr AttrInfo (ExpBase f vn) SrcLoc
  | Project Name (ExpBase f vn) (f PatternType) SrcLoc
  | -- | Numeric negation (ugly special case; Haskell did it first).
    Negate (ExpBase f vn) SrcLoc
  | -- | Fail if the first expression does not return true,
    -- and return the value of the second expression if it
    -- does.
    Assert (ExpBase f vn) (ExpBase f vn) (f String) SrcLoc
  | -- | An n-ary value constructor.
    Constr Name [ExpBase f vn] (f PatternType) SrcLoc
  | Update (ExpBase f vn) (SliceBase f vn) (ExpBase f vn) SrcLoc
  | RecordUpdate (ExpBase f vn) [Name] (ExpBase f vn) (f PatternType) SrcLoc
  | Lambda
      [PatternBase f vn]
      (ExpBase f vn)
      (Maybe (TypeExp vn))
      (f (Aliasing, StructType))
      SrcLoc
  | -- | @+@; first two types are operands, third is result.
    OpSection (QualName vn) (f PatternType) SrcLoc
  | -- | @2+@; first type is operand, second is result.
    OpSectionLeft
      (QualName vn)
      (f PatternType)
      (ExpBase f vn)
      (f (PName, StructType, Maybe VName), f (PName, StructType))
      (f PatternType, f [VName])
      SrcLoc
  | -- | @+2@; first type is operand, second is result.
    OpSectionRight
      (QualName vn)
      (f PatternType)
      (ExpBase f vn)
      (f (PName, StructType), f (PName, StructType, Maybe VName))
      (f PatternType)
      SrcLoc
  | -- | Field projection as a section: @(.x.y.z)@.
    ProjectSection [Name] (f PatternType) SrcLoc
  | -- | Array indexing as a section: @(.[i,j])@.
    IndexSection (SliceBase f vn) (f PatternType) SrcLoc
  | -- | Type ascription: @e : t@.
    Ascript (ExpBase f vn) (TypeDeclBase f vn) SrcLoc
  | AppExp (AppExpBase f vn) (f AppRes)

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 (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 (Negate ExpBase f vn
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Update ExpBase f vn
_ SliceBase 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 (PName, StructType, Maybe VName), f (PName, 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 (PName, StructType), f (PName, 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 SliceBase f vn
_ f PatternType
_ 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 (Attr AttrInfo
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (AppExp AppExpBase f vn
e f AppRes
_) = AppExpBase f vn -> Loc
forall a. Located a => a -> Loc
locOf AppExpBase f vn
e

-- | 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 literal in a pattern.
data PatLit
  = PatLitInt Integer
  | PatLitFloat Double
  | PatLitPrim PrimValue
  deriving (PatLit -> PatLit -> Bool
(PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool) -> Eq PatLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatLit -> PatLit -> Bool
$c/= :: PatLit -> PatLit -> Bool
== :: PatLit -> PatLit -> Bool
$c== :: PatLit -> PatLit -> Bool
Eq, Eq PatLit
Eq PatLit
-> (PatLit -> PatLit -> Ordering)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> PatLit)
-> (PatLit -> PatLit -> PatLit)
-> Ord PatLit
PatLit -> PatLit -> Bool
PatLit -> PatLit -> Ordering
PatLit -> PatLit -> PatLit
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 :: PatLit -> PatLit -> PatLit
$cmin :: PatLit -> PatLit -> PatLit
max :: PatLit -> PatLit -> PatLit
$cmax :: PatLit -> PatLit -> PatLit
>= :: PatLit -> PatLit -> Bool
$c>= :: PatLit -> PatLit -> Bool
> :: PatLit -> PatLit -> Bool
$c> :: PatLit -> PatLit -> Bool
<= :: PatLit -> PatLit -> Bool
$c<= :: PatLit -> PatLit -> Bool
< :: PatLit -> PatLit -> Bool
$c< :: PatLit -> PatLit -> Bool
compare :: PatLit -> PatLit -> Ordering
$ccompare :: PatLit -> PatLit -> Ordering
Ord, Int -> PatLit -> ShowS
[PatLit] -> ShowS
PatLit -> String
(Int -> PatLit -> ShowS)
-> (PatLit -> String) -> ([PatLit] -> ShowS) -> Show PatLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatLit] -> ShowS
$cshowList :: [PatLit] -> ShowS
show :: PatLit -> String
$cshow :: PatLit -> String
showsPrec :: Int -> PatLit -> ShowS
$cshowsPrec :: Int -> PatLit -> ShowS
Show)

-- | 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 PatLit (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 PatLit
_ 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
  { -- | 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.
    forall (f :: * -> *) vn. ValBindBase f vn -> Maybe (f EntryPoint)
valBindEntryPoint :: Maybe (f EntryPoint),
    forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName :: vn,
    forall (f :: * -> *) vn. ValBindBase f vn -> Maybe (TypeExp vn)
valBindRetDecl :: Maybe (TypeExp vn),
    forall (f :: * -> *) vn.
ValBindBase f vn -> f (StructType, [VName])
valBindRetType :: f (StructType, [VName]),
    forall (f :: * -> *) vn. ValBindBase f vn -> [TypeParamBase vn]
valBindTypeParams :: [TypeParamBase vn],
    forall (f :: * -> *) vn. ValBindBase f vn -> [PatternBase f vn]
valBindParams :: [PatternBase f vn],
    forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody :: ExpBase f vn,
    forall (f :: * -> *) vn. ValBindBase f vn -> Maybe DocComment
valBindDoc :: Maybe DocComment,
    forall (f :: * -> *) vn. ValBindBase f vn -> [AttrInfo]
valBindAttrs :: [AttrInfo],
    forall (f :: * -> *) vn. 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
  { forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias :: vn,
    forall (f :: * -> *) vn. TypeBindBase f vn -> Liftedness
typeLiftedness :: Liftedness,
    forall (f :: * -> *) vn. TypeBindBase f vn -> [TypeParamBase vn]
typeParams :: [TypeParamBase vn],
    forall (f :: * -> *) vn. TypeBindBase f vn -> TypeDeclBase f vn
typeExp :: TypeDeclBase f vn,
    forall (f :: * -> *) vn. TypeBindBase f vn -> Maybe DocComment
typeDoc :: Maybe DocComment,
    forall (f :: * -> *) vn. 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
  = -- | May only be instantiated with a zero-order type of (possibly
    -- symbolically) known size.
    Unlifted
  | -- | May only be instantiated with a zero-order type, but the size
    -- can be varying.
    SizeLifted
  | -- | May be instantiated with a functional type.
    Lifted
  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
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
  = -- | A type parameter that must be a size.
    TypeParamDim vn SrcLoc
  | -- | A type parameter that must be a type.
    TypeParamType Liftedness vn SrcLoc
  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
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 :: forall a b. (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 :: forall m a. Monoid m => (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 :: forall (f :: * -> *) a b.
Applicative f =>
(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 :: forall vn. 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
      { forall (f :: * -> *) vn. SpecBase f vn -> vn
specName :: vn,
        forall (f :: * -> *) vn. SpecBase f vn -> [TypeParamBase vn]
specTypeParams :: [TypeParamBase vn],
        forall (f :: * -> *) vn. SpecBase f vn -> TypeDeclBase f vn
specType :: TypeDeclBase f vn,
        forall (f :: * -> *) vn. SpecBase f vn -> Maybe DocComment
specDoc :: Maybe DocComment,
        forall (f :: * -> *) vn. SpecBase f vn -> SrcLoc
specLocation :: SrcLoc
      }
  | TypeAbbrSpec (TypeBindBase f vn)
  | -- | Abstract type.
    TypeSpec Liftedness vn [TypeParamBase vn] (Maybe DocComment) SrcLoc
  | 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
  { forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName :: vn,
    forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp :: SigExpBase f vn,
    forall (f :: * -> *) vn. SigBindBase f vn -> Maybe DocComment
sigDoc :: Maybe DocComment,
    forall (f :: * -> *) vn. 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
  | -- | The contents of another file as a module.
    ModImport FilePath (f FilePath) SrcLoc
  | ModDecs [DecBase f vn] 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.
    ModApply
      (ModExpBase f vn)
      (ModExpBase f vn)
      (f (M.Map VName VName))
      (f (M.Map VName VName))
      SrcLoc
  | 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
  { forall (f :: * -> *) vn. ModBindBase f vn -> vn
modName :: vn,
    forall (f :: * -> *) vn. ModBindBase f vn -> [ModParamBase f vn]
modParams :: [ModParamBase f vn],
    forall (f :: * -> *) vn.
ModBindBase f vn -> Maybe (SigExpBase f vn, f (Map VName VName))
modSignature :: Maybe (SigExpBase f vn, f (M.Map VName VName)),
    forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp :: ModExpBase f vn,
    forall (f :: * -> *) vn. ModBindBase f vn -> Maybe DocComment
modDoc :: Maybe DocComment,
    forall (f :: * -> *) vn. 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
  { forall (f :: * -> *) vn. ModParamBase f vn -> vn
modParamName :: vn,
    forall (f :: * -> *) vn. ModParamBase f vn -> SigExpBase f vn
modParamType :: SigExpBase f vn,
    forall (f :: * -> *) vn. ModParamBase f vn -> f [VName]
modParamAbs :: f [VName],
    forall (f :: * -> *) vn. 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
  { forall (f :: * -> *) vn. ProgBase f vn -> Maybe DocComment
progDoc :: Maybe DocComment,
    forall (f :: * -> *) vn. 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
"|>"