{-# 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
-- https://futhark.readthedocs.org for a language reference, or this
-- module may be a little hard to understand.
--
-- The system of primitive types is interesting in itself.  See
-- "Language.Futhark.Primitive".
module Language.Futhark.Syntax
  ( module Language.Futhark.Core,
    prettyString,
    prettyText,

    -- * Types
    Uniqueness (..),
    IntType (..),
    FloatType (..),
    PrimType (..),
    Size (..),
    Shape (..),
    shapeRank,
    stripDims,
    TypeBase (..),
    TypeArg (..),
    SizeExp (..),
    TypeExp (..),
    TypeArgExp (..),
    PName (..),
    ScalarTypeBase (..),
    RetTypeBase (..),
    PatType,
    StructType,
    StructRetType,
    PatRetType,
    ValueType,
    Diet (..),

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

    -- * Abstract syntax tree
    AttrInfo (..),
    AttrAtom (..),
    BinOp (..),
    IdentBase (..),
    Inclusiveness (..),
    DimIndexBase (..),
    SliceBase,
    SizeBinder (..),
    AppExpBase (..),
    AppRes (..),
    ExpBase (..),
    FieldBase (..),
    CaseBase (..),
    LoopFormBase (..),
    PatLit (..),
    PatBase (..),

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

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

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

import Control.Applicative
import Control.Monad
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Foldable
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as M
import Data.Monoid hiding (Sum)
import Data.Ord
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Traversable
import Futhark.Util.Loc
import Futhark.Util.Pretty
import Language.Futhark.Core
import Language.Futhark.Primitive
  ( FloatType (..),
    FloatValue (..),
    IntType (..),
    IntValue (..),
  )
import Prelude

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

instance Functor NoInfo where
  fmap :: forall a b. (a -> b) -> NoInfo a -> NoInfo b
fmap a -> b
_ NoInfo a
NoInfo = forall {k} (a :: k). 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (a :: k). 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
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, 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
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 Functor Info where
  fmap :: forall a b. (a -> b) -> Info a -> Info b
fmap a -> b
f (Info a
x) = forall a. a -> Info a
Info 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) = forall a. a -> Info a
Info 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
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
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
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
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
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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsPrimValue Int8 where
  primValue :: Int8 -> PrimValue
primValue = IntValue -> PrimValue
SignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value

instance IsPrimValue Int16 where
  primValue :: Int16 -> PrimValue
primValue = IntValue -> PrimValue
SignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value

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

instance IsPrimValue Int64 where
  primValue :: Int64 -> PrimValue
primValue = IntValue -> PrimValue
SignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value

instance IsPrimValue Word8 where
  primValue :: Word8 -> PrimValue
primValue = IntValue -> PrimValue
UnsignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsPrimValue Word16 where
  primValue :: Word16 -> PrimValue
primValue = IntValue -> PrimValue
UnsignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

instance IsPrimValue Word64 where
  primValue :: Word64 -> PrimValue
primValue = IntValue -> PrimValue
UnsignedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

instance IsPrimValue Double where
  primValue :: Double -> PrimValue
primValue = FloatValue -> PrimValue
FloatValue 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 value of an v'AttrAtom'.
data AttrAtom vn
  = AtomName Name
  | AtomInt Integer
  deriving (AttrAtom vn -> AttrAtom vn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
/= :: AttrAtom vn -> AttrAtom vn -> Bool
$c/= :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
== :: AttrAtom vn -> AttrAtom vn -> Bool
$c== :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
Eq, AttrAtom vn -> AttrAtom vn -> Bool
AttrAtom vn -> AttrAtom vn -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (vn :: k). Eq (AttrAtom vn)
forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Ordering
forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> AttrAtom vn
min :: AttrAtom vn -> AttrAtom vn -> AttrAtom vn
$cmin :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> AttrAtom vn
max :: AttrAtom vn -> AttrAtom vn -> AttrAtom vn
$cmax :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> AttrAtom vn
>= :: AttrAtom vn -> AttrAtom vn -> Bool
$c>= :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
> :: AttrAtom vn -> AttrAtom vn -> Bool
$c> :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
<= :: AttrAtom vn -> AttrAtom vn -> Bool
$c<= :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
< :: AttrAtom vn -> AttrAtom vn -> Bool
$c< :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Bool
compare :: AttrAtom vn -> AttrAtom vn -> Ordering
$ccompare :: forall k (vn :: k). AttrAtom vn -> AttrAtom vn -> Ordering
Ord, Int -> AttrAtom vn -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (vn :: k). Int -> AttrAtom vn -> ShowS
forall k (vn :: k). [AttrAtom vn] -> ShowS
forall k (vn :: k). AttrAtom vn -> String
showList :: [AttrAtom vn] -> ShowS
$cshowList :: forall k (vn :: k). [AttrAtom vn] -> ShowS
show :: AttrAtom vn -> String
$cshow :: forall k (vn :: k). AttrAtom vn -> String
showsPrec :: Int -> AttrAtom vn -> ShowS
$cshowsPrec :: forall k (vn :: k). Int -> AttrAtom vn -> ShowS
Show)

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

-- | The elaborated size of a dimension.
data Size
  = -- | The size of the dimension is this name, which
    -- must be in scope.  In a return type, this will
    -- give rise to an assertion.
    NamedSize (QualName VName)
  | -- | The size is a constant.
    ConstSize Int
  | -- | No known size.  If @Nothing@, then this is a name distinct
    -- from any other.  The type checker should _never_ produce these
    -- - they are a (hopefully temporary) thing introduced by
    -- defunctorisation and monomorphisation.
    AnySize (Maybe VName)
  deriving (Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
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 :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord, Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
Show)

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

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

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

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

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

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

-- | The number of dimensions contained in a shape.
shapeRank :: Shape dim -> Int
shapeRank :: forall a. Shape a -> Int
shapeRank = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim. Shape 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 -> Shape dim -> Maybe (Shape dim)
stripDims :: forall dim. Int -> Shape dim -> Maybe (Shape dim)
stripDims Int
i (Shape [dim]
l)
  | Int
i forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [dim]
l = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall dim. [dim] -> Shape dim
Shape forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
i [dim]
l
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | 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
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 appear to the right of a function arrow.  This
-- just means they can be existentially quantified.
data RetTypeBase dim as = RetType
  { forall dim as. RetTypeBase dim as -> [VName]
retDims :: [VName],
    forall dim as. RetTypeBase dim as -> TypeBase dim as
retType :: TypeBase dim as
  }
  deriving (RetTypeBase dim as -> RetTypeBase dim as -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall dim as.
(Eq as, Eq dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
/= :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
$c/= :: forall dim as.
(Eq as, Eq dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
== :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
$c== :: forall dim as.
(Eq as, Eq dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
Eq, RetTypeBase dim as -> RetTypeBase dim as -> Bool
RetTypeBase dim as -> RetTypeBase dim as -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {dim} {as}. (Ord as, Ord dim) => Eq (RetTypeBase dim as)
forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Ordering
forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as
min :: RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as
$cmin :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as
max :: RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as
$cmax :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as
>= :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
$c>= :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
> :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
$c> :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
<= :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
$c<= :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
< :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
$c< :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Bool
compare :: RetTypeBase dim as -> RetTypeBase dim as -> Ordering
$ccompare :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Ordering
Ord, Int -> RetTypeBase dim as -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall dim as.
(Show as, Show dim) =>
Int -> RetTypeBase dim as -> ShowS
forall dim as. (Show as, Show dim) => [RetTypeBase dim as] -> ShowS
forall dim as. (Show as, Show dim) => RetTypeBase dim as -> String
showList :: [RetTypeBase dim as] -> ShowS
$cshowList :: forall dim as. (Show as, Show dim) => [RetTypeBase dim as] -> ShowS
show :: RetTypeBase dim as -> String
$cshow :: forall dim as. (Show as, Show dim) => RetTypeBase dim as -> String
showsPrec :: Int -> RetTypeBase dim as -> ShowS
$cshowsPrec :: forall dim as.
(Show as, Show dim) =>
Int -> RetTypeBase dim as -> ShowS
Show)

instance Bitraversable RetTypeBase where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> RetTypeBase a b -> f (RetTypeBase c d)
bitraverse a -> f c
f b -> f d
g (RetType [VName]
dims TypeBase a b
t) = forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
dims forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 c
f b -> f d
g TypeBase a b
t

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

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

-- | 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 (QualName VName) [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 ()) (RetTypeBase dim as)
  deriving (ScalarTypeBase dim as -> ScalarTypeBase dim as -> Bool
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, ScalarTypeBase dim as -> ScalarTypeBase dim as -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {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
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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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) = forall dim as. Map Name (TypeBase dim as) -> ScalarTypeBase dim as
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> * -> *) (f :: * -> *) a 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 QualName VName
t [TypeArg a]
args) =
    forall dim as.
as
-> Uniqueness
-> QualName VName
-> [TypeArg dim]
-> ScalarTypeBase dim as
TypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
als forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Uniqueness
u forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure QualName VName
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f) [TypeArg a]
args
  bitraverse a -> f c
f b -> f d
g (Arrow b
als PName
v TypeBase a ()
t1 RetTypeBase a b
t2) =
    forall dim as.
as
-> PName
-> TypeBase dim ()
-> RetTypeBase dim as
-> ScalarTypeBase dim as
Arrow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
als forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure PName
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 c
f forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase a ()
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 c
f b -> f d
g RetTypeBase a b
t2
  bitraverse a -> f c
f b -> f d
g (Sum Map Name [TypeBase a b]
cs) = forall dim as. Map Name [TypeBase dim as] -> ScalarTypeBase dim as
Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (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 = 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 = 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 (Shape dim) (ScalarTypeBase dim ())
  deriving (TypeBase dim as -> TypeBase dim as -> Bool
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, TypeBase dim as -> TypeBase dim as -> Bool
TypeBase dim as -> TypeBase dim as -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {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
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) = forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 c
f b -> f d
g ScalarTypeBase a b
t
  bitraverse a -> f c
f b -> f d
g (Array b
a Uniqueness
u Shape a
shape ScalarTypeBase a ()
t) =
    forall dim as.
as
-> Uniqueness
-> Shape dim
-> ScalarTypeBase dim ()
-> TypeBase dim as
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Uniqueness
u forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f Shape a
shape forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 c
f forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarTypeBase a ()
t

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

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

-- | An argument passed to a type constructor.
data TypeArg dim
  = TypeArgDim dim SrcLoc
  | TypeArgType (TypeBase dim ()) SrcLoc
  deriving (TypeArg dim -> TypeArg dim -> Bool
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, TypeArg dim -> TypeArg dim -> Bool
TypeArg dim -> TypeArg dim -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {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
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) = forall dim. dim -> SrcLoc -> TypeArg dim
TypeArgDim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (TypeArgType TypeBase a ()
t SrcLoc
loc) = forall dim. TypeBase dim () -> SrcLoc -> TypeArg dim
TypeArgType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase a ()
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = 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 = 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
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
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
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 PatType = TypeBase Size Aliasing

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

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

-- | The return type version of 'StructType'.
type StructRetType = RetTypeBase Size ()

-- | The return type version of 'PatType'.
type PatRetType = RetTypeBase Size Aliasing

-- | A size expression for use in a 'TypeExp'.
data SizeExp vn
  = -- | The size of the dimension is this name, which
    -- must be in scope.
    SizeExpNamed (QualName vn) SrcLoc
  | -- | The size is a constant.
    SizeExpConst Int SrcLoc
  | -- | No dimension declaration.
    SizeExpAny
  deriving (Int -> SizeExp vn -> ShowS
forall vn. Show vn => Int -> SizeExp vn -> ShowS
forall vn. Show vn => [SizeExp vn] -> ShowS
forall vn. Show vn => SizeExp vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SizeExp vn] -> ShowS
$cshowList :: forall vn. Show vn => [SizeExp vn] -> ShowS
show :: SizeExp vn -> String
$cshow :: forall vn. Show vn => SizeExp vn -> String
showsPrec :: Int -> SizeExp vn -> ShowS
$cshowsPrec :: forall vn. Show vn => Int -> SizeExp vn -> ShowS
Show)

deriving instance Eq (SizeExp Name)

deriving instance Eq (SizeExp VName)

deriving instance Ord (SizeExp Name)

deriving instance Ord (SizeExp 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 (SizeExp vn) (TypeExp 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
  | TEDim [vn] (TypeExp vn) SrcLoc
  deriving (Int -> TypeExp vn -> ShowS
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 SizeExp vn
_ TypeExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TETuple [TypeExp vn]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TERecord [(Name, TypeExp vn)]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEVar QualName vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEUnique TypeExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEApply TypeExp vn
_ TypeArgExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEArrow Maybe vn
_ TypeExp vn
_ TypeExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TESum [(Name, [TypeExp vn])]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TEDim [vn]
_ TypeExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | A type argument expression passed to a type constructor.
data TypeArgExp vn
  = TypeArgExpDim (SizeExp vn) SrcLoc
  | TypeArgExpType (TypeExp vn)
  deriving (Int -> TypeArgExp vn -> ShowS
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 SizeExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TypeArgExpType TypeExp vn
t) = forall a. Located a => a -> Loc
locOf TypeExp vn
t

-- | Information about which parts of a value/type are consumed.
data Diet
  = -- | Consumes these fields in the record.
    RecordDiet (M.Map Name Diet)
  | -- | Consume these parts of the constructors.
    SumDiet (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diet -> Diet -> Bool
$c/= :: Diet -> Diet -> Bool
== :: Diet -> Diet -> Bool
$c== :: Diet -> Diet -> Bool
Eq, Eq Diet
Diet -> Diet -> Bool
Diet -> Diet -> Ordering
Diet -> Diet -> Diet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Diet -> Diet -> Diet
$cmin :: Diet -> Diet -> Diet
max :: Diet -> Diet -> Diet
$cmax :: Diet -> Diet -> Diet
>= :: Diet -> Diet -> Bool
$c>= :: Diet -> Diet -> Bool
> :: Diet -> Diet -> Bool
$c> :: Diet -> Diet -> Bool
<= :: Diet -> Diet -> Bool
$c<= :: Diet -> Diet -> Bool
< :: Diet -> Diet -> Bool
$c< :: Diet -> Diet -> Bool
compare :: Diet -> Diet -> Ordering
$ccompare :: Diet -> Diet -> Ordering
Ord, Int -> Diet -> ShowS
[Diet] -> ShowS
Diet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diet] -> ShowS
$cshowList :: [Diet] -> ShowS
show :: Diet -> String
$cshow :: Diet -> String
showsPrec :: Int -> Diet -> ShowS
$cshowsPrec :: Int -> Diet -> ShowS
Show)

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

deriving instance Show (IdentBase Info VName)

deriving instance Show vn => Show (IdentBase NoInfo vn)

instance Eq vn => Eq (IdentBase ty vn) where
  IdentBase ty vn
x == :: IdentBase ty vn -> IdentBase ty vn -> Bool
== IdentBase ty vn
y = forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase ty vn
x forall a. Eq a => a -> a -> Bool
== 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 = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (f :: * -> *) vn. IdentBase f vn -> vn
identName

instance Located (IdentBase ty vn) where
  locOf :: IdentBase ty vn -> Loc
locOf = forall a. Located a => a -> Loc
locOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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).
    Backtick
  | -- | Not a real operator, but operator with this as a prefix may
    -- be defined by the user.
    Bang
  | -- | Not a real operator, but operator with this as a prefix
    -- may be defined by the user.
    Equ
  | 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
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
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
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]
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
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
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, Inclusiveness a -> Inclusiveness a -> Bool
Inclusiveness a -> Inclusiveness a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (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
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) = forall a. Located a => a -> Loc
locOf a
x
  locOf (ToInclusive a
x) = forall a. Located a => a -> Loc
locOf a
x
  locOf (UpToExclusive a
x) = forall a. Located a => a -> Loc
locOf a
x

instance Functor Inclusiveness where
  fmap :: forall a b. (a -> b) -> Inclusiveness a -> Inclusiveness b
fmap = 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 = 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) = forall a. a -> Inclusiveness a
DownToExclusive 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) = forall a. a -> Inclusiveness a
ToInclusive 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) = forall a. a -> Inclusiveness a
UpToExclusive 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 Show (DimIndexBase Info VName)

deriving instance Show vn => Show (DimIndexBase NoInfo vn)

deriving instance Eq (DimIndexBase NoInfo VName)

deriving instance Eq (DimIndexBase Info VName)

deriving instance Ord (DimIndexBase NoInfo VName)

deriving instance Ord (DimIndexBase Info 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
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 forall a. Eq a => a -> a -> Bool
== [Name]
qs2 Bool -> Bool -> Bool
&& Name
v1 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 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 = 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 = 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 = 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 = 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) = forall vn. [vn] -> vn -> QualName vn
QualName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
qs 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
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, SizeBinder vn -> SizeBinder vn -> Bool
SizeBinder vn -> SizeBinder vn -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {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
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 = forall a. Located a => a -> Loc
locOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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.  May have duplicates across the
    -- program, but they will all produce the same value (the
    -- expressions will be identical).
    Apply
      (ExpBase f vn)
      (ExpBase f vn)
      (f (Diet, Maybe VName))
      SrcLoc
  | -- | Size coercion: @e :> t@.
    Coerce (ExpBase f vn) (TypeExp vn) SrcLoc
  | Range
      (ExpBase f vn)
      (Maybe (ExpBase f vn))
      (Inclusiveness (ExpBase f vn))
      SrcLoc
  | LetPat
      [SizeBinder vn]
      (PatBase f vn)
      (ExpBase f vn)
      (ExpBase f vn)
      SrcLoc
  | LetFun
      vn
      ( [TypeParamBase vn],
        [PatBase f vn],
        Maybe (TypeExp vn),
        f StructRetType,
        ExpBase f vn
      )
      (ExpBase f vn)
      SrcLoc
  | If (ExpBase f vn) (ExpBase f vn) (ExpBase f vn) SrcLoc
  | DoLoop
      [VName] -- Size parameters.
      (PatBase 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 PatType)
      (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 Show (AppExpBase Info VName)

deriving instance Show vn => Show (AppExpBase NoInfo vn)

deriving instance Eq (AppExpBase NoInfo VName)

deriving instance Eq (AppExpBase Info VName)

deriving instance Ord (AppExpBase NoInfo VName)

deriving instance Ord (AppExpBase Info 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) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (BinOp (QualName vn, SrcLoc)
_ f PatType
_ (ExpBase f vn, f (StructType, Maybe VName))
_ (ExpBase f vn, f (StructType, Maybe VName))
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (If ExpBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Coerce ExpBase f vn
_ TypeExp vn
_ 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) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetPat [SizeBinder vn]
_ PatBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetFun vn
_ ([TypeParamBase vn], [PatBase f vn], Maybe (TypeExp vn),
 f StructRetType, ExpBase f vn)
_ ExpBase f vn
_ 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) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Index ExpBase f vn
_ SliceBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (DoLoop [VName]
_ PatBase f vn
_ ExpBase f vn
_ LoopFormBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Match ExpBase f vn
_ NonEmpty (CaseBase f vn)
_ 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 -> PatType
appResType :: PatType,
    AppRes -> [VName]
appResExt :: [VName]
  }
  deriving (AppRes -> AppRes -> Bool
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
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
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 PatType) SrcLoc
  | -- | A polymorphic decimal literal.
    FloatLit Double (f PatType) SrcLoc
  | -- | A string literal is just a fancy syntax for an array
    -- of bytes.
    StringLit [Word8] SrcLoc
  | Hole (f PatType) SrcLoc
  | Var (QualName vn) (f PatType) 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 PatType) SrcLoc
  | -- | An attribute applied to the following expression.
    Attr (AttrInfo vn) (ExpBase f vn) SrcLoc
  | Project Name (ExpBase f vn) (f PatType) SrcLoc
  | -- | Numeric negation (ugly special case; Haskell did it first).
    Negate (ExpBase f vn) SrcLoc
  | -- | Logical and bitwise negation.
    Not (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 T.Text) SrcLoc
  | -- | An n-ary value constructor.
    Constr Name [ExpBase f vn] (f PatType) SrcLoc
  | Update (ExpBase f vn) (SliceBase f vn) (ExpBase f vn) SrcLoc
  | RecordUpdate (ExpBase f vn) [Name] (ExpBase f vn) (f PatType) SrcLoc
  | Lambda
      [PatBase f vn]
      (ExpBase f vn)
      (Maybe (TypeExp vn))
      (f (Aliasing, StructRetType))
      SrcLoc
  | -- | @+@; first two types are operands, third is result.
    OpSection (QualName vn) (f PatType) SrcLoc
  | -- | @2+@; first type is operand, second is result.
    OpSectionLeft
      (QualName vn)
      (f PatType)
      (ExpBase f vn)
      (f (PName, StructType, Maybe VName), f (PName, StructType))
      (f PatRetType, f [VName])
      SrcLoc
  | -- | @+2@; first type is operand, second is result.
    OpSectionRight
      (QualName vn)
      (f PatType)
      (ExpBase f vn)
      (f (PName, StructType), f (PName, StructType, Maybe VName))
      (f PatRetType)
      SrcLoc
  | -- | Field projection as a section: @(.x.y.z)@.
    ProjectSection [Name] (f PatType) SrcLoc
  | -- | Array indexing as a section: @(.[i,j])@.
    IndexSection (SliceBase f vn) (f PatType) SrcLoc
  | -- | Type ascription: @e : t@.
    Ascript (ExpBase f vn) (TypeExp vn) SrcLoc
  | AppExp (AppExpBase f vn) (f AppRes)

deriving instance Show (ExpBase Info VName)

deriving instance Show vn => Show (ExpBase NoInfo vn)

deriving instance Eq (ExpBase NoInfo VName)

deriving instance Ord (ExpBase NoInfo VName)

deriving instance Eq (ExpBase Info VName)

deriving instance Ord (ExpBase Info VName)

instance Located (ExpBase f vn) where
  locOf :: ExpBase f vn -> Loc
locOf (Literal PrimValue
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IntLit Integer
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (FloatLit Double
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Parens ExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (QualParens (QualName vn, SrcLoc)
_ ExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TupLit [ExpBase f vn]
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (RecordLit [FieldBase f vn]
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Project Name
_ ExpBase f vn
_ f PatType
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (ArrayLit [ExpBase f vn]
_ f PatType
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (StringLit [Word8]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Var QualName vn
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Ascript ExpBase f vn
_ TypeExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Negate ExpBase f vn
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Not ExpBase f vn
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Update ExpBase f vn
_ SliceBase f vn
_ ExpBase f vn
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (RecordUpdate ExpBase f vn
_ [Name]
_ ExpBase f vn
_ f PatType
_ SrcLoc
pos) = forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Lambda [PatBase f vn]
_ ExpBase f vn
_ Maybe (TypeExp vn)
_ f (Set Alias, StructRetType)
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Hole f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSection QualName vn
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSectionLeft QualName vn
_ f PatType
_ ExpBase f vn
_ (f (PName, StructType, Maybe VName), f (PName, StructType))
_ (f PatRetType, f [VName])
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSectionRight QualName vn
_ f PatType
_ ExpBase f vn
_ (f (PName, StructType), f (PName, StructType, Maybe VName))
_ f PatRetType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ProjectSection [Name]
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IndexSection SliceBase f vn
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Assert ExpBase f vn
_ ExpBase f vn
_ f Text
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Constr Name
_ [ExpBase f vn]
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Attr AttrInfo vn
_ ExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (AppExp AppExpBase f vn
e f AppRes
_) = 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 PatType) SrcLoc

deriving instance Show (FieldBase Info VName)

deriving instance Show vn => Show (FieldBase NoInfo vn)

deriving instance Eq (FieldBase NoInfo VName)

deriving instance Eq (FieldBase Info VName)

deriving instance Ord (FieldBase NoInfo VName)

deriving instance Ord (FieldBase Info VName)

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

-- | A case in a match expression.
data CaseBase f vn = CasePat (PatBase f vn) (ExpBase f vn) SrcLoc

deriving instance Show (CaseBase Info VName)

deriving instance Show vn => Show (CaseBase NoInfo vn)

deriving instance Eq (CaseBase NoInfo VName)

deriving instance Eq (CaseBase Info VName)

deriving instance Ord (CaseBase NoInfo VName)

deriving instance Ord (CaseBase Info VName)

instance Located (CaseBase f vn) where
  locOf :: CaseBase f vn -> Loc
locOf (CasePat PatBase f vn
_ ExpBase f vn
_ 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 (PatBase f vn) (ExpBase f vn)
  | While (ExpBase f vn)

deriving instance Show (LoopFormBase Info VName)

deriving instance Show vn => Show (LoopFormBase NoInfo vn)

deriving instance Eq (LoopFormBase NoInfo VName)

deriving instance Eq (LoopFormBase Info VName)

deriving instance Ord (LoopFormBase NoInfo VName)

deriving instance Ord (LoopFormBase Info VName)

-- | A literal in a pattern.
data PatLit
  = PatLitInt Integer
  | PatLitFloat Double
  | PatLitPrim PrimValue
  deriving (PatLit -> PatLit -> Bool
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
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
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 PatBase f vn
  = TuplePat [PatBase f vn] SrcLoc
  | RecordPat [(Name, PatBase f vn)] SrcLoc
  | PatParens (PatBase f vn) SrcLoc
  | Id vn (f PatType) SrcLoc
  | Wildcard (f PatType) SrcLoc -- Nothing, i.e. underscore.
  | PatAscription (PatBase f vn) (TypeExp vn) SrcLoc
  | PatLit PatLit (f PatType) SrcLoc
  | PatConstr Name (f PatType) [PatBase f vn] SrcLoc
  | PatAttr (AttrInfo vn) (PatBase f vn) SrcLoc

deriving instance Show (PatBase Info VName)

deriving instance Show vn => Show (PatBase NoInfo vn)

deriving instance Eq (PatBase NoInfo VName)

deriving instance Eq (PatBase Info VName)

deriving instance Ord (PatBase NoInfo VName)

deriving instance Ord (PatBase Info VName)

instance Located (PatBase f vn) where
  locOf :: PatBase f vn -> Loc
locOf (TuplePat [PatBase f vn]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (RecordPat [(Name, PatBase f vn)]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatParens PatBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Id vn
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Wildcard f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatAscription PatBase f vn
_ TypeExp vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatLit PatLit
_ f PatType
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatConstr Name
_ f PatType
_ [PatBase f vn]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (PatAttr AttrInfo vn
_ PatBase f vn
_ 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
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) = 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
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)

-- | A parameter of an entry point.
data EntryParam = EntryParam
  { EntryParam -> Name
entryParamName :: Name,
    EntryParam -> EntryType
entryParamType :: EntryType
  }
  deriving (Int -> EntryParam -> ShowS
[EntryParam] -> ShowS
EntryParam -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryParam] -> ShowS
$cshowList :: [EntryParam] -> ShowS
show :: EntryParam -> String
$cshow :: EntryParam -> String
showsPrec :: Int -> EntryParam -> ShowS
$cshowsPrec :: Int -> EntryParam -> 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 -> [EntryParam]
entryParams :: [EntryParam],
    EntryPoint -> EntryType
entryReturn :: EntryType
  }
  deriving (Int -> EntryPoint -> ShowS
[EntryPoint] -> ShowS
EntryPoint -> String
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),
    -- | If 'valBindParams' is null, then the 'retDims' are brought
    -- into scope at this point.
    forall (f :: * -> *) vn. ValBindBase f vn -> f StructRetType
valBindRetType :: f StructRetType,
    forall (f :: * -> *) vn. ValBindBase f vn -> [TypeParamBase vn]
valBindTypeParams :: [TypeParamBase vn],
    forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams :: [PatBase 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 vn]
valBindAttrs :: [AttrInfo vn],
    forall (f :: * -> *) vn. ValBindBase f vn -> SrcLoc
valBindLocation :: SrcLoc
  }

deriving instance Show (ValBindBase Info VName)

deriving instance Show (ValBindBase NoInfo Name)

instance Located (ValBindBase f vn) where
  locOf :: ValBindBase f vn -> Loc
locOf = forall a. Located a => a -> Loc
locOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> TypeExp vn
typeExp :: TypeExp vn,
    forall (f :: * -> *) vn. TypeBindBase f vn -> f StructRetType
typeElab :: f StructRetType,
    forall (f :: * -> *) vn. TypeBindBase f vn -> Maybe DocComment
typeDoc :: Maybe DocComment,
    forall (f :: * -> *) vn. TypeBindBase f vn -> SrcLoc
typeBindLocation :: SrcLoc
  }

deriving instance Show (TypeBindBase Info VName)

deriving instance Show (TypeBindBase NoInfo Name)

instance Located (TypeBindBase f vn) where
  locOf :: TypeBindBase f vn -> Loc
locOf = forall a. Located a => a -> Loc
locOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
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
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
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
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, TypeParamBase vn -> TypeParamBase vn -> Bool
TypeParamBase vn -> TypeParamBase vn -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {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
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 = 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 = 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) = forall vn. vn -> SrcLoc -> TypeParamBase vn
TypeParamDim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (TypeParamType Liftedness
l a
v SrcLoc
loc) = forall vn. Liftedness -> vn -> SrcLoc -> TypeParamBase vn
TypeParamType Liftedness
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TypeParamType Liftedness
_ vn
_ 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 -> TypeExp vn
specTypeExp :: TypeExp vn,
        forall (f :: * -> *) vn. SpecBase f vn -> f StructType
specType :: f StructType,
        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 Show (SpecBase Info VName)

deriving instance Show (SpecBase NoInfo Name)

instance Located (SpecBase f vn) where
  locOf :: SpecBase f vn -> Loc
locOf (ValSpec vn
_ [TypeParamBase vn]
_ TypeExp vn
_ f StructType
_ Maybe DocComment
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TypeAbbrSpec TypeBindBase f vn
tbind) = forall a. Located a => a -> Loc
locOf TypeBindBase f vn
tbind
  locOf (TypeSpec Liftedness
_ vn
_ [TypeParamBase vn]
_ Maybe DocComment
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModSpec vn
_ SigExpBase f vn
_ Maybe DocComment
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IncludeSpec SigExpBase f vn
_ 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 vn) SrcLoc
  | SigArrow (Maybe vn) (SigExpBase f vn) (SigExpBase f vn) SrcLoc

deriving instance Show (SigExpBase Info VName)

deriving instance Show (SigExpBase NoInfo Name)

-- | A type refinement.
data TypeRefBase vn = TypeRef (QualName vn) [TypeParamBase vn] (TypeExp vn) SrcLoc

deriving instance Show (TypeRefBase VName)

deriving instance Show (TypeRefBase Name)

instance Located (TypeRefBase vn) where
  locOf :: TypeRefBase vn -> Loc
locOf (TypeRef QualName vn
_ [TypeParamBase vn]
_ TypeExp vn
_ 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) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigParens SigExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigSpecs [SpecBase f vn]
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigWith SigExpBase f vn
_ TypeRefBase vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (SigArrow Maybe vn
_ SigExpBase f vn
_ SigExpBase f vn
_ 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 Show (SigBindBase Info VName)

deriving instance Show (SigBindBase NoInfo Name)

instance Located (SigBindBase f vn) where
  locOf :: SigBindBase f vn -> Loc
locOf = forall a. Located a => a -> Loc
locOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Show (ModExpBase Info VName)

deriving instance Show (ModExpBase NoInfo Name)

instance Located (ModExpBase f vn) where
  locOf :: ModExpBase f vn -> Loc
locOf (ModVar QualName vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModParens ModExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModImport String
_ f String
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModDecs [DecBase f vn]
_ 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) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModAscript ModExpBase f vn
_ SigExpBase f vn
_ f (Map VName VName)
_ 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) = 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 Show (ModBindBase Info VName)

deriving instance Show (ModBindBase NoInfo Name)

instance Located (ModBindBase f vn) where
  locOf :: ModBindBase f vn -> Loc
locOf = forall a. Located a => a -> Loc
locOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Show (ModParamBase Info VName)

deriving instance Show (ModParamBase NoInfo Name)

instance Located (ModParamBase f vn) where
  locOf :: ModParamBase f vn -> Loc
locOf = forall a. Located a => a -> Loc
locOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Show (DecBase Info VName)

deriving instance Show (DecBase NoInfo Name)

instance Located (DecBase f vn) where
  locOf :: DecBase f vn -> Loc
locOf (ValDec ValBindBase f vn
d) = forall a. Located a => a -> Loc
locOf ValBindBase f vn
d
  locOf (TypeDec TypeBindBase f vn
d) = forall a. Located a => a -> Loc
locOf TypeBindBase f vn
d
  locOf (SigDec SigBindBase f vn
d) = forall a. Located a => a -> Loc
locOf SigBindBase f vn
d
  locOf (ModDec ModBindBase f vn
d) = forall a. Located a => a -> Loc
locOf ModBindBase f vn
d
  locOf (OpenDec ModExpBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LocalDec DecBase f vn
_ SrcLoc
loc) = forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ImportDec String
_ f String
_ 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 Show (ProgBase Info VName)

deriving instance Show (ProgBase NoInfo Name)

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

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

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