{-# 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 (..),
    StructType,
    ParamType,
    ResType,
    StructRetType,
    ResRetType,
    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
    ImportName (..),
    SpecBase (..),
    SigExpBase (..),
    TypeRefBase (..),
    SigBindBase (..),
    ModExpBase (..),
    ModBindBase (..),
    ModParamBase (..),

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

    -- * Miscellaneous
    NoInfo (..),
    Info (..),
    QualName (..),
    mkApply,
    mkApplyUT,
    sizeFromName,
    sizeFromInteger,
  )
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.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 System.FilePath.Posix qualified as Posix
import Prelude

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

instance Functor NoInfo where
  fmap :: forall a b. (a -> b) -> NoInfo a -> NoInfo b
fmap a -> b
_ NoInfo a
NoInfo = NoInfo b
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 = NoInfo b -> f (NoInfo b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo b
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
(Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool) -> Eq (Info a)
forall a. Eq a => Info a -> Info a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Info a -> Info a -> Bool
Eq, Eq (Info a)
Eq (Info a)
-> (Info a -> Info a -> Ordering)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Bool)
-> (Info a -> Info a -> Info a)
-> (Info a -> Info a -> Info a)
-> Ord (Info a)
Info a -> Info a -> Bool
Info a -> Info a -> Ordering
Info a -> Info a -> Info a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Info a)
forall a. Ord a => Info a -> Info a -> Bool
forall a. Ord a => Info a -> Info a -> Ordering
forall a. Ord a => Info a -> Info a -> Info a
$ccompare :: forall a. Ord a => Info a -> Info a -> Ordering
compare :: Info a -> Info a -> Ordering
$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
>= :: Info a -> Info a -> Bool
$cmax :: forall a. Ord a => Info a -> Info a -> Info a
max :: Info a -> Info a -> Info a
$cmin :: forall a. Ord a => Info a -> Info a -> Info a
min :: Info a -> Info a -> Info a
Ord, Int -> Info a -> ShowS
[Info a] -> ShowS
Info a -> String
(Int -> Info a -> ShowS)
-> (Info a -> String) -> ([Info a] -> ShowS) -> Show (Info a)
forall a. Show a => Int -> Info a -> ShowS
forall a. Show a => [Info a] -> ShowS
forall a. Show a => Info a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Info a -> ShowS
showsPrec :: Int -> Info a -> ShowS
$cshow :: forall a. Show a => Info a -> String
show :: Info a -> String
$cshowList :: forall a. Show a => [Info a] -> ShowS
showList :: [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) = b -> Info b
forall a. a -> Info a
Info (b -> Info b) -> b -> Info b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Foldable Info where
  foldr :: forall a b. (a -> b -> b) -> b -> Info a -> b
foldr a -> b -> b
f b
b (Info a
x) = a -> b -> b
f a
x b
b

instance Traversable Info where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse a -> f b
f (Info a
x) = b -> Info b
forall a. a -> Info a
Info (b -> Info b) -> f b -> f (Info b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | The elaborated size of a dimension is just an expression.
type Size = ExpBase Info VName

-- | Create a 'Size' from a name.
sizeFromName :: QualName VName -> SrcLoc -> Size
sizeFromName :: QualName VName -> SrcLoc -> Size
sizeFromName QualName VName
name = QualName VName -> Info StructType -> SrcLoc -> Size
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var QualName VName
name (StructType -> Info StructType
forall a. a -> Info a
Info (StructType -> Info StructType) -> StructType -> Info StructType
forall a b. (a -> b) -> a -> b
$ ScalarTypeBase Size NoUniqueness -> StructType
forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (ScalarTypeBase Size NoUniqueness -> StructType)
-> ScalarTypeBase Size NoUniqueness -> StructType
forall a b. (a -> b) -> a -> b
$ PrimType -> ScalarTypeBase Size NoUniqueness
forall dim u. PrimType -> ScalarTypeBase dim u
Prim (PrimType -> ScalarTypeBase Size NoUniqueness)
-> PrimType -> ScalarTypeBase Size NoUniqueness
forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64)

-- | Create a 'Size' from a constant integer.
sizeFromInteger :: Integer -> SrcLoc -> Size
sizeFromInteger :: Integer -> SrcLoc -> Size
sizeFromInteger Integer
x = Integer -> Info StructType -> SrcLoc -> Size
forall (f :: * -> *) vn.
Integer -> f StructType -> SrcLoc -> ExpBase f vn
IntLit Integer
x (StructType -> Info StructType
forall a. a -> Info a
Info (StructType -> Info StructType)
-> (ScalarTypeBase Size NoUniqueness -> StructType)
-> ScalarTypeBase Size NoUniqueness
-> Info StructType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScalarTypeBase Size NoUniqueness -> StructType
forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (ScalarTypeBase Size NoUniqueness -> Info StructType)
-> ScalarTypeBase Size NoUniqueness -> Info StructType
forall a b. (a -> b) -> a -> b
$ PrimType -> ScalarTypeBase Size NoUniqueness
forall dim u. PrimType -> ScalarTypeBase dim u
Prim (PrimType -> ScalarTypeBase Size NoUniqueness)
-> PrimType -> ScalarTypeBase Size NoUniqueness
forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64)

-- | 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
(Shape dim -> Shape dim -> Bool)
-> (Shape dim -> Shape dim -> Bool) -> Eq (Shape dim)
forall dim. Eq dim => Shape dim -> Shape dim -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Shape dim -> Shape dim -> Bool
Eq, Eq (Shape dim)
Eq (Shape dim)
-> (Shape dim -> Shape dim -> Ordering)
-> (Shape dim -> Shape dim -> Bool)
-> (Shape dim -> Shape dim -> Bool)
-> (Shape dim -> Shape dim -> Bool)
-> (Shape dim -> Shape dim -> Bool)
-> (Shape dim -> Shape dim -> Shape dim)
-> (Shape dim -> Shape dim -> Shape dim)
-> Ord (Shape dim)
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
$ccompare :: forall dim. Ord dim => Shape dim -> Shape dim -> Ordering
compare :: Shape dim -> Shape dim -> Ordering
$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
>= :: Shape dim -> Shape dim -> Bool
$cmax :: forall dim. Ord dim => Shape dim -> Shape dim -> Shape dim
max :: Shape dim -> Shape dim -> Shape dim
$cmin :: forall dim. Ord dim => Shape dim -> Shape dim -> Shape dim
min :: Shape dim -> Shape dim -> Shape dim
Ord, Int -> Shape dim -> ShowS
[Shape dim] -> ShowS
Shape dim -> String
(Int -> Shape dim -> ShowS)
-> (Shape dim -> String)
-> ([Shape dim] -> ShowS)
-> Show (Shape dim)
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
$cshowsPrec :: forall dim. Show dim => Int -> Shape dim -> ShowS
showsPrec :: Int -> Shape dim -> ShowS
$cshow :: forall dim. Show dim => Shape dim -> String
show :: Shape dim -> String
$cshowList :: forall dim. Show dim => [Shape dim] -> ShowS
showList :: [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) = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
x [a]
ds

instance Traversable 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) = [b] -> Shape b
forall dim. [dim] -> Shape dim
Shape ([b] -> Shape b) -> f [b] -> f (Shape b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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) = [b] -> Shape b
forall dim. [dim] -> Shape dim
Shape ([b] -> Shape b) -> [b] -> Shape b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
ds

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

instance Monoid (Shape dim) where
  mempty :: Shape dim
mempty = [dim] -> Shape dim
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 = [dim] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([dim] -> Int) -> (Shape dim -> [dim]) -> Shape dim -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shape dim -> [dim]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [dim] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [dim]
l = Shape dim -> Maybe (Shape dim)
forall a. a -> Maybe a
Just (Shape dim -> Maybe (Shape dim)) -> Shape dim -> Maybe (Shape dim)
forall a b. (a -> b) -> a -> b
$ [dim] -> Shape dim
forall dim. [dim] -> Shape dim
Shape ([dim] -> Shape dim) -> [dim] -> Shape dim
forall a b. (a -> b) -> a -> b
$ Int -> [dim] -> [dim]
forall a. Int -> [a] -> [a]
drop Int
i [dim]
l
  | Bool
otherwise = Maybe (Shape dim)
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
(Int -> PName -> ShowS)
-> (PName -> String) -> ([PName] -> ShowS) -> Show PName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PName -> ShowS
showsPrec :: Int -> PName -> ShowS
$cshow :: PName -> String
show :: PName -> String
$cshowList :: [PName] -> ShowS
showList :: [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
(RetTypeBase dim as -> RetTypeBase dim as -> Bool)
-> (RetTypeBase dim as -> RetTypeBase dim as -> Bool)
-> Eq (RetTypeBase dim as)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall dim as.
(Eq as, Eq dim) =>
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
/= :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
Eq, Eq (RetTypeBase dim as)
Eq (RetTypeBase dim as)
-> (RetTypeBase dim as -> RetTypeBase dim as -> Ordering)
-> (RetTypeBase dim as -> RetTypeBase dim as -> Bool)
-> (RetTypeBase dim as -> RetTypeBase dim as -> Bool)
-> (RetTypeBase dim as -> RetTypeBase dim as -> Bool)
-> (RetTypeBase dim as -> RetTypeBase dim as -> Bool)
-> (RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as)
-> (RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as)
-> Ord (RetTypeBase dim as)
RetTypeBase dim as -> RetTypeBase dim as -> Bool
RetTypeBase dim as -> RetTypeBase dim as -> Ordering
RetTypeBase dim as -> RetTypeBase dim as -> RetTypeBase dim as
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {dim} {as}. (Ord as, Ord dim) => Eq (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
$ccompare :: forall dim as.
(Ord as, Ord dim) =>
RetTypeBase dim as -> RetTypeBase dim as -> Ordering
compare :: RetTypeBase dim as -> RetTypeBase dim as -> Ordering
$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
>= :: RetTypeBase dim as -> RetTypeBase dim as -> Bool
$cmax :: 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
$cmin :: 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
Ord, Int -> RetTypeBase dim as -> ShowS
[RetTypeBase dim as] -> ShowS
RetTypeBase dim as -> String
(Int -> RetTypeBase dim as -> ShowS)
-> (RetTypeBase dim as -> String)
-> ([RetTypeBase dim as] -> ShowS)
-> Show (RetTypeBase dim as)
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
$cshowsPrec :: forall dim as.
(Show as, Show dim) =>
Int -> RetTypeBase dim as -> ShowS
showsPrec :: Int -> RetTypeBase dim as -> ShowS
$cshow :: forall dim as. (Show as, Show dim) => RetTypeBase dim as -> String
show :: RetTypeBase dim as -> String
$cshowList :: forall dim as. (Show as, Show dim) => [RetTypeBase dim as] -> ShowS
showList :: [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) = [VName] -> TypeBase c d -> RetTypeBase c d
forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
dims (TypeBase c d -> RetTypeBase c d)
-> f (TypeBase c d) -> f (RetTypeBase c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g TypeBase a b
t

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

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

instance Traversable (RetTypeBase dim) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RetTypeBase dim a -> f (RetTypeBase dim b)
traverse = (dim -> f dim)
-> (a -> f b) -> RetTypeBase dim a -> f (RetTypeBase dim b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> RetTypeBase a b -> f (RetTypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse dim -> f dim
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Bifunctor RetTypeBase where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> RetTypeBase a c -> RetTypeBase b d
bimap = (a -> b) -> (c -> d) -> RetTypeBase a c -> RetTypeBase b d
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 = (a -> m) -> (b -> m) -> RetTypeBase a b -> m
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 u
  = Prim PrimType
  | TypeVar u (QualName VName) [TypeArg dim]
  | Record (M.Map Name (TypeBase dim u))
  | Sum (M.Map Name [TypeBase dim u])
  | -- | The aliasing corresponds to the lexical
    -- closure of the function.
    Arrow u PName Diet (TypeBase dim NoUniqueness) (RetTypeBase dim Uniqueness)
  deriving (ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
(ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool)
-> (ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool)
-> Eq (ScalarTypeBase dim u)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall dim u.
(Eq dim, Eq u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
$c== :: forall dim u.
(Eq dim, Eq u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
== :: ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
$c/= :: forall dim u.
(Eq dim, Eq u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
/= :: ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
Eq, Eq (ScalarTypeBase dim u)
Eq (ScalarTypeBase dim u)
-> (ScalarTypeBase dim u -> ScalarTypeBase dim u -> Ordering)
-> (ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool)
-> (ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool)
-> (ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool)
-> (ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool)
-> (ScalarTypeBase dim u
    -> ScalarTypeBase dim u -> ScalarTypeBase dim u)
-> (ScalarTypeBase dim u
    -> ScalarTypeBase dim u -> ScalarTypeBase dim u)
-> Ord (ScalarTypeBase dim u)
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Ordering
ScalarTypeBase dim u
-> ScalarTypeBase dim u -> ScalarTypeBase dim u
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {dim} {u}. (Ord dim, Ord u) => Eq (ScalarTypeBase dim u)
forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Ordering
forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u
-> ScalarTypeBase dim u -> ScalarTypeBase dim u
$ccompare :: forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Ordering
compare :: ScalarTypeBase dim u -> ScalarTypeBase dim u -> Ordering
$c< :: forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
< :: ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
$c<= :: forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
<= :: ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
$c> :: forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
> :: ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
$c>= :: forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
>= :: ScalarTypeBase dim u -> ScalarTypeBase dim u -> Bool
$cmax :: forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u
-> ScalarTypeBase dim u -> ScalarTypeBase dim u
max :: ScalarTypeBase dim u
-> ScalarTypeBase dim u -> ScalarTypeBase dim u
$cmin :: forall dim u.
(Ord dim, Ord u) =>
ScalarTypeBase dim u
-> ScalarTypeBase dim u -> ScalarTypeBase dim u
min :: ScalarTypeBase dim u
-> ScalarTypeBase dim u -> ScalarTypeBase dim u
Ord, Int -> ScalarTypeBase dim u -> ShowS
[ScalarTypeBase dim u] -> ShowS
ScalarTypeBase dim u -> String
(Int -> ScalarTypeBase dim u -> ShowS)
-> (ScalarTypeBase dim u -> String)
-> ([ScalarTypeBase dim u] -> ShowS)
-> Show (ScalarTypeBase dim u)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall dim u.
(Show dim, Show u) =>
Int -> ScalarTypeBase dim u -> ShowS
forall dim u. (Show dim, Show u) => [ScalarTypeBase dim u] -> ShowS
forall dim u. (Show dim, Show u) => ScalarTypeBase dim u -> String
$cshowsPrec :: forall dim u.
(Show dim, Show u) =>
Int -> ScalarTypeBase dim u -> ShowS
showsPrec :: Int -> ScalarTypeBase dim u -> ShowS
$cshow :: forall dim u. (Show dim, Show u) => ScalarTypeBase dim u -> String
show :: ScalarTypeBase dim u -> String
$cshowList :: forall dim u. (Show dim, Show u) => [ScalarTypeBase dim u] -> ShowS
showList :: [ScalarTypeBase dim u] -> ShowS
Show)

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

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

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

instance Traversable (ScalarTypeBase dim) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ScalarTypeBase dim a -> f (ScalarTypeBase dim b)
traverse = (dim -> f dim)
-> (a -> f b) -> ScalarTypeBase dim a -> f (ScalarTypeBase dim b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> ScalarTypeBase a b -> f (ScalarTypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse dim -> f dim
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

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

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

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

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

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

instance Traversable (TypeBase dim) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TypeBase dim a -> f (TypeBase dim b)
traverse = (dim -> f dim)
-> (a -> f b) -> TypeBase dim a -> f (TypeBase dim b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse dim -> f dim
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

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

-- | An argument passed to a type constructor.
data TypeArg dim
  = TypeArgDim dim
  | TypeArgType (TypeBase dim NoUniqueness)
  deriving (TypeArg dim -> TypeArg dim -> Bool
(TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool) -> Eq (TypeArg dim)
forall dim. Eq dim => TypeArg dim -> TypeArg dim -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: TypeArg dim -> TypeArg dim -> Bool
Eq, Eq (TypeArg dim)
Eq (TypeArg dim)
-> (TypeArg dim -> TypeArg dim -> Ordering)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> Bool)
-> (TypeArg dim -> TypeArg dim -> TypeArg dim)
-> (TypeArg dim -> TypeArg dim -> TypeArg dim)
-> Ord (TypeArg dim)
TypeArg dim -> TypeArg dim -> Bool
TypeArg dim -> TypeArg dim -> Ordering
TypeArg dim -> TypeArg dim -> TypeArg dim
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {dim}. Ord dim => Eq (TypeArg dim)
forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Bool
forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Ordering
forall dim. Ord dim => TypeArg dim -> TypeArg dim -> TypeArg dim
$ccompare :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> Ordering
compare :: TypeArg dim -> TypeArg dim -> Ordering
$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
>= :: TypeArg dim -> TypeArg dim -> Bool
$cmax :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> TypeArg dim
max :: TypeArg dim -> TypeArg dim -> TypeArg dim
$cmin :: forall dim. Ord dim => TypeArg dim -> TypeArg dim -> TypeArg dim
min :: TypeArg dim -> TypeArg dim -> TypeArg dim
Ord, Int -> TypeArg dim -> ShowS
[TypeArg dim] -> ShowS
TypeArg dim -> String
(Int -> TypeArg dim -> ShowS)
-> (TypeArg dim -> String)
-> ([TypeArg dim] -> ShowS)
-> Show (TypeArg dim)
forall dim. Show dim => Int -> TypeArg dim -> ShowS
forall dim. Show dim => [TypeArg dim] -> ShowS
forall dim. Show dim => TypeArg dim -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall dim. Show dim => Int -> TypeArg dim -> ShowS
showsPrec :: Int -> TypeArg dim -> ShowS
$cshow :: forall dim. Show dim => TypeArg dim -> String
show :: TypeArg dim -> String
$cshowList :: forall dim. Show dim => [TypeArg dim] -> ShowS
showList :: [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) = b -> TypeArg b
forall dim. dim -> TypeArg dim
TypeArgDim (b -> TypeArg b) -> f b -> f (TypeArg b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v
  traverse a -> f b
f (TypeArgType TypeBase a NoUniqueness
t) = TypeBase b NoUniqueness -> TypeArg b
forall dim. TypeBase dim NoUniqueness -> TypeArg dim
TypeArgType (TypeBase b NoUniqueness -> TypeArg b)
-> f (TypeBase b NoUniqueness) -> f (TypeArg b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b)
-> (NoUniqueness -> f NoUniqueness)
-> TypeBase a NoUniqueness
-> f (TypeBase b NoUniqueness)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TypeBase a b -> f (TypeBase c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f NoUniqueness -> f NoUniqueness
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase a NoUniqueness
t

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

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

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

-- | A type with consumption information, used for function parameters
-- (but not in function types).
type ParamType = TypeBase Size Diet

-- | A type with uniqueness information, used for function return types
type ResType = TypeBase Size Uniqueness

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

-- | The return type version of a 'ResType'.
type StructRetType = RetTypeBase Size NoUniqueness

-- | The return type version of a 'StructType'.
type ResRetType = RetTypeBase Size Uniqueness

-- | A dimension declaration expression for use in a 'TypeExp'.
-- Syntactically includes the brackets.
data SizeExp f vn
  = -- | The size of the dimension is this expression, all of which
    -- free variables must be in scope.
    SizeExp (ExpBase f vn) SrcLoc
  | -- | No dimension declaration.
    SizeExpAny SrcLoc

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

deriving instance Show (SizeExp Info VName)

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

deriving instance Eq (SizeExp NoInfo VName)

deriving instance Eq (SizeExp Info VName)

deriving instance Ord (SizeExp NoInfo VName)

deriving instance Ord (SizeExp Info VName)

-- | An unstructured syntactic 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 f vn
  = TEVar (QualName vn) SrcLoc
  | TEParens (TypeExp f vn) SrcLoc
  | TETuple [TypeExp f vn] SrcLoc
  | TERecord [(Name, TypeExp f vn)] SrcLoc
  | TEArray (SizeExp f vn) (TypeExp f vn) SrcLoc
  | TEUnique (TypeExp f vn) SrcLoc
  | TEApply (TypeExp f vn) (TypeArgExp f vn) SrcLoc
  | TEArrow (Maybe vn) (TypeExp f vn) (TypeExp f vn) SrcLoc
  | TESum [(Name, [TypeExp f vn])] SrcLoc
  | TEDim [vn] (TypeExp f vn) SrcLoc

deriving instance Show (TypeExp Info VName)

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

deriving instance Eq (TypeExp NoInfo VName)

deriving instance Eq (TypeExp Info VName)

deriving instance Ord (TypeExp NoInfo VName)

deriving instance Ord (TypeExp Info VName)

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

-- | A type argument expression passed to a type constructor.
data TypeArgExp f vn
  = TypeArgExpSize (SizeExp f vn)
  | TypeArgExpType (TypeExp f vn)

deriving instance Show (TypeArgExp Info VName)

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

deriving instance Eq (TypeArgExp NoInfo VName)

deriving instance Eq (TypeArgExp Info VName)

deriving instance Ord (TypeArgExp NoInfo VName)

deriving instance Ord (TypeArgExp Info VName)

instance Located (TypeArgExp f vn) where
  locOf :: TypeArgExp f vn -> Loc
locOf (TypeArgExpSize SizeExp f vn
e) = SizeExp f vn -> Loc
forall a. Located a => a -> Loc
locOf SizeExp f vn
e
  locOf (TypeArgExpType TypeExp f vn
t) = TypeExp f vn -> Loc
forall a. Located a => a -> Loc
locOf TypeExp f vn
t

-- | Information about which parts of a parameter are consumed.  This
-- can be considered kind of an effect on the function.
data Diet
  = -- | Does not consume the parameter.
    Observe
  | -- | Consumes the parameter.
    Consume
  deriving (Diet -> Diet -> Bool
(Diet -> Diet -> Bool) -> (Diet -> Diet -> Bool) -> Eq Diet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Diet -> Diet -> Bool
== :: Diet -> Diet -> Bool
$c/= :: Diet -> Diet -> Bool
/= :: Diet -> Diet -> Bool
Eq, Eq Diet
Eq Diet
-> (Diet -> Diet -> Ordering)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Bool)
-> (Diet -> Diet -> Diet)
-> (Diet -> Diet -> Diet)
-> Ord Diet
Diet -> Diet -> Bool
Diet -> Diet -> Ordering
Diet -> Diet -> Diet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Diet -> Diet -> Ordering
compare :: Diet -> Diet -> Ordering
$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
>= :: Diet -> Diet -> Bool
$cmax :: Diet -> Diet -> Diet
max :: Diet -> Diet -> Diet
$cmin :: Diet -> Diet -> Diet
min :: Diet -> Diet -> Diet
Ord, Int -> Diet -> ShowS
[Diet] -> ShowS
Diet -> String
(Int -> Diet -> ShowS)
-> (Diet -> String) -> ([Diet] -> ShowS) -> Show Diet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Diet -> ShowS
showsPrec :: Int -> Diet -> ShowS
$cshow :: Diet -> String
show :: Diet -> String
$cshowList :: [Diet] -> ShowS
showList :: [Diet] -> ShowS
Show)

instance Semigroup Diet where
  <> :: Diet -> Diet -> Diet
(<>) = Diet -> Diet -> Diet
forall a. Ord a => a -> a -> a
max

instance Monoid Diet where
  mempty :: Diet
mempty = Diet
Observe

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

deriving instance (Show (Info t)) => Show (IdentBase Info VName t)

deriving instance (Show (Info t), Show vn) => Show (IdentBase NoInfo vn t)

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

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

instance Located (IdentBase ty vn t) where
  locOf :: IdentBase ty vn t -> Loc
locOf = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (IdentBase ty vn t -> SrcLoc) -> IdentBase ty vn t -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentBase ty vn t -> SrcLoc
forall {k} (f :: k -> *) vn (t :: k). IdentBase f vn t -> 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
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
/= :: BinOp -> BinOp -> Bool
Eq, Eq BinOp
Eq BinOp
-> (BinOp -> BinOp -> Ordering)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> BinOp)
-> (BinOp -> BinOp -> BinOp)
-> Ord BinOp
BinOp -> BinOp -> Bool
BinOp -> BinOp -> Ordering
BinOp -> BinOp -> BinOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BinOp -> BinOp -> Ordering
compare :: BinOp -> BinOp -> Ordering
$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
>= :: BinOp -> BinOp -> Bool
$cmax :: BinOp -> BinOp -> BinOp
max :: BinOp -> BinOp -> BinOp
$cmin :: BinOp -> BinOp -> BinOp
min :: BinOp -> BinOp -> BinOp
Ord, Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinOp -> ShowS
showsPrec :: Int -> BinOp -> ShowS
$cshow :: BinOp -> String
show :: BinOp -> String
$cshowList :: [BinOp] -> ShowS
showList :: [BinOp] -> ShowS
Show, Int -> BinOp
BinOp -> Int
BinOp -> [BinOp]
BinOp -> BinOp
BinOp -> BinOp -> [BinOp]
BinOp -> BinOp -> BinOp -> [BinOp]
(BinOp -> BinOp)
-> (BinOp -> BinOp)
-> (Int -> BinOp)
-> (BinOp -> Int)
-> (BinOp -> [BinOp])
-> (BinOp -> BinOp -> [BinOp])
-> (BinOp -> BinOp -> [BinOp])
-> (BinOp -> BinOp -> BinOp -> [BinOp])
-> Enum BinOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BinOp -> BinOp
succ :: BinOp -> BinOp
$cpred :: BinOp -> BinOp
pred :: BinOp -> BinOp
$ctoEnum :: Int -> BinOp
toEnum :: Int -> BinOp
$cfromEnum :: BinOp -> Int
fromEnum :: BinOp -> Int
$cenumFrom :: BinOp -> [BinOp]
enumFrom :: BinOp -> [BinOp]
$cenumFromThen :: BinOp -> BinOp -> [BinOp]
enumFromThen :: BinOp -> BinOp -> [BinOp]
$cenumFromTo :: BinOp -> BinOp -> [BinOp]
enumFromTo :: BinOp -> BinOp -> [BinOp]
$cenumFromThenTo :: BinOp -> BinOp -> BinOp -> [BinOp]
enumFromThenTo :: BinOp -> BinOp -> BinOp -> [BinOp]
Enum, BinOp
BinOp -> BinOp -> Bounded BinOp
forall a. a -> a -> Bounded a
$cminBound :: BinOp
minBound :: BinOp
$cmaxBound :: BinOp
maxBound :: BinOp
Bounded)

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

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

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

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

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

-- | An indexing of a single dimension.
data DimIndexBase f vn
  = DimFix (ExpBase f vn)
  | DimSlice
      (Maybe (ExpBase f vn))
      (Maybe (ExpBase f vn))
      (Maybe (ExpBase f vn))

deriving instance 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
[QualName vn] -> ShowS
QualName vn -> String
(Int -> QualName vn -> ShowS)
-> (QualName vn -> String)
-> ([QualName vn] -> ShowS)
-> Show (QualName vn)
forall vn. Show vn => Int -> QualName vn -> ShowS
forall vn. Show vn => [QualName vn] -> ShowS
forall vn. Show vn => QualName vn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall vn. Show vn => Int -> QualName vn -> ShowS
showsPrec :: Int -> QualName vn -> ShowS
$cshow :: forall vn. Show vn => QualName vn -> String
show :: QualName vn -> String
$cshowList :: forall vn. Show vn => [QualName vn] -> ShowS
showList :: [QualName vn] -> ShowS
Show)

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

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

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

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

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

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

instance Traversable QualName where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QualName a -> f (QualName b)
traverse a -> f b
f (QualName [a]
qs a
v) = [b] -> b -> QualName b
forall vn. [vn] -> vn -> QualName vn
QualName ([b] -> b -> QualName b) -> f [b] -> f (b -> QualName b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> f b
f [a]
qs f (b -> QualName b) -> f b -> f (QualName b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
v

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

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

-- | An "application expression" is a semantic (not syntactic)
-- grouping of expressions that have "funcall-like" semantics, mostly
-- meaning that they can return existential sizes.  In our type
-- theory, these are all thought to be bound to names (*Administrative
-- Normal Form*), but as this is not practical in a real language, we
-- instead use an annotation ('AppRes') that stores the information we
-- need, so we can pretend that an application expression was really
-- bound to a name.
data AppExpBase f vn
  = -- | Function application.  Parts of the compiler expects that the
    -- function expression is never itself an 'Apply'.  Use the
    -- 'mkApply' function to maintain this invariant, rather than
    -- constructing 'Apply' directly.
    --
    -- The @Maybe VNames@ are existential sizes generated 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)
      (NE.NonEmpty (f (Diet, Maybe VName), ExpBase f vn))
      SrcLoc
  | Range
      (ExpBase f vn)
      (Maybe (ExpBase f vn))
      (Inclusiveness (ExpBase f vn))
      SrcLoc
  | LetPat
      [SizeBinder vn]
      (PatBase f vn StructType)
      (ExpBase f vn)
      (ExpBase f vn)
      SrcLoc
  | LetFun
      vn
      ( [TypeParamBase vn],
        [PatBase f vn ParamType],
        Maybe (TypeExp f vn),
        f ResRetType,
        ExpBase f vn
      )
      (ExpBase f vn)
      SrcLoc
  | If (ExpBase f vn) (ExpBase f vn) (ExpBase f vn) SrcLoc
  | Loop
      [VName] -- Size parameters.
      (PatBase f vn ParamType) -- 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 StructType)
      (ExpBase f vn, f (Maybe VName))
      (ExpBase f vn, f (Maybe VName))
      SrcLoc
  | LetWith
      (IdentBase f vn StructType)
      (IdentBase f vn StructType)
      (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) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (BinOp (QualName vn, SrcLoc)
_ f StructType
_ (ExpBase f vn, f (Maybe VName))
_ (ExpBase f vn, f (Maybe VName))
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (If ExpBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Apply ExpBase f vn
_ NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetPat [SizeBinder vn]
_ PatBase f vn StructType
_ ExpBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetFun vn
_ ([TypeParamBase vn], [PatBase f vn ParamType],
 Maybe (TypeExp f vn), f ResRetType, ExpBase f vn)
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LetWith IdentBase f vn StructType
_ IdentBase f vn StructType
_ SliceBase f vn
_ ExpBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Index ExpBase f vn
_ SliceBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Loop [VName]
_ PatBase f vn ParamType
_ ExpBase f vn
_ LoopFormBase f vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Match ExpBase f vn
_ NonEmpty (CaseBase f vn)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | An annotation inserted by the type checker on constructs that are
-- "function calls" (either literally or conceptually).  This
-- annotation encodes the result type, as well as any existential
-- sizes that are generated here.
data AppRes = AppRes
  { AppRes -> StructType
appResType :: StructType,
    AppRes -> [VName]
appResExt :: [VName]
  }
  deriving (AppRes -> AppRes -> Bool
(AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool) -> Eq AppRes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AppRes -> AppRes -> Bool
== :: AppRes -> AppRes -> Bool
$c/= :: AppRes -> AppRes -> Bool
/= :: AppRes -> AppRes -> Bool
Eq, Eq AppRes
Eq AppRes
-> (AppRes -> AppRes -> Ordering)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> Bool)
-> (AppRes -> AppRes -> AppRes)
-> (AppRes -> AppRes -> AppRes)
-> Ord AppRes
AppRes -> AppRes -> Bool
AppRes -> AppRes -> Ordering
AppRes -> AppRes -> AppRes
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AppRes -> AppRes -> Ordering
compare :: AppRes -> AppRes -> Ordering
$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
>= :: AppRes -> AppRes -> Bool
$cmax :: AppRes -> AppRes -> AppRes
max :: AppRes -> AppRes -> AppRes
$cmin :: AppRes -> AppRes -> AppRes
min :: AppRes -> AppRes -> AppRes
Ord, Int -> AppRes -> ShowS
[AppRes] -> ShowS
AppRes -> String
(Int -> AppRes -> ShowS)
-> (AppRes -> String) -> ([AppRes] -> ShowS) -> Show AppRes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppRes -> ShowS
showsPrec :: Int -> AppRes -> ShowS
$cshow :: AppRes -> String
show :: AppRes -> String
$cshowList :: [AppRes] -> ShowS
showList :: [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 StructType) SrcLoc
  | -- | A polymorphic decimal literal.
    FloatLit Double (f StructType) SrcLoc
  | -- | A string literal is just a fancy syntax for an array
    -- of bytes.
    StringLit [Word8] SrcLoc
  | Hole (f StructType) SrcLoc
  | Var (QualName vn) (f StructType) 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 StructType) SrcLoc
  | -- | An attribute applied to the following expression.
    Attr (AttrInfo vn) (ExpBase f vn) SrcLoc
  | Project Name (ExpBase f vn) (f StructType) 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 StructType) SrcLoc
  | Update (ExpBase f vn) (SliceBase f vn) (ExpBase f vn) SrcLoc
  | RecordUpdate (ExpBase f vn) [Name] (ExpBase f vn) (f StructType) SrcLoc
  | Lambda
      [PatBase f vn ParamType]
      (ExpBase f vn)
      (Maybe (TypeExp f vn))
      (f ResRetType)
      SrcLoc
  | -- | @+@; first two types are operands, third is result.
    OpSection (QualName vn) (f StructType) SrcLoc
  | -- | @2+@; first type is operand, second is result.
    OpSectionLeft
      (QualName vn)
      (f StructType)
      (ExpBase f vn)
      (f (PName, ParamType, Maybe VName), f (PName, ParamType))
      (f ResRetType, f [VName])
      SrcLoc
  | -- | @+2@; first type is operand, second is result.
    OpSectionRight
      (QualName vn)
      (f StructType)
      (ExpBase f vn)
      (f (PName, ParamType), f (PName, ParamType, Maybe VName))
      (f ResRetType)
      SrcLoc
  | -- | Field projection as a section: @(.x.y.z)@.
    ProjectSection [Name] (f StructType) SrcLoc
  | -- | Array indexing as a section: @(.[i,j])@.
    IndexSection (SliceBase f vn) (f StructType) SrcLoc
  | -- | Type ascription: @e : t@.
    Ascript (ExpBase f vn) (TypeExp f vn) SrcLoc
  | -- | Size coercion: @e :> t@.
    Coerce (ExpBase f vn) (TypeExp f vn) (f StructType) 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) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IntLit Integer
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (FloatLit Double
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Parens ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (QualParens (QualName vn, SrcLoc)
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TupLit [ExpBase f vn]
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (RecordLit [FieldBase f vn]
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Project Name
_ ExpBase f vn
_ f StructType
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (ArrayLit [ExpBase f vn]
_ f StructType
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (StringLit [Word8]
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Var QualName vn
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Ascript ExpBase f vn
_ TypeExp f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Coerce ExpBase f vn
_ TypeExp f vn
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Negate ExpBase f vn
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Not ExpBase f vn
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Update ExpBase f vn
_ SliceBase f vn
_ ExpBase f vn
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (RecordUpdate ExpBase f vn
_ [Name]
_ ExpBase f vn
_ f StructType
_ SrcLoc
pos) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
pos
  locOf (Lambda [PatBase f vn ParamType]
_ ExpBase f vn
_ Maybe (TypeExp f vn)
_ f ResRetType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Hole f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSection QualName vn
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSectionLeft QualName vn
_ f StructType
_ ExpBase f vn
_ (f (PName, ParamType, Maybe VName), f (PName, ParamType))
_ (f ResRetType, f [VName])
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (OpSectionRight QualName vn
_ f StructType
_ ExpBase f vn
_ (f (PName, ParamType), f (PName, ParamType, Maybe VName))
_ f ResRetType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ProjectSection [Name]
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IndexSection SliceBase f vn
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Assert ExpBase f vn
_ ExpBase f vn
_ f Text
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Constr Name
_ [ExpBase f vn]
_ f StructType
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (Attr AttrInfo vn
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (AppExp AppExpBase f vn
e f AppRes
_) = AppExpBase f vn -> Loc
forall a. Located a => a -> Loc
locOf AppExpBase f vn
e

-- | An entry in a record literal.
data FieldBase f vn
  = RecordFieldExplicit Name (ExpBase f vn) SrcLoc
  | RecordFieldImplicit vn (f StructType) 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) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (RecordFieldImplicit vn
_ f StructType
_ SrcLoc
loc) = 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 StructType) (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 StructType
_ ExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

-- | Whether the loop is a @for@-loop or a @while@-loop.
data LoopFormBase f vn
  = For (IdentBase f vn StructType) (ExpBase f vn)
  | ForIn (PatBase f vn StructType) (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
(PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool) -> Eq PatLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatLit -> PatLit -> Bool
== :: PatLit -> PatLit -> Bool
$c/= :: PatLit -> PatLit -> Bool
/= :: PatLit -> PatLit -> Bool
Eq, Eq PatLit
Eq PatLit
-> (PatLit -> PatLit -> Ordering)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> Bool)
-> (PatLit -> PatLit -> PatLit)
-> (PatLit -> PatLit -> PatLit)
-> Ord PatLit
PatLit -> PatLit -> Bool
PatLit -> PatLit -> Ordering
PatLit -> PatLit -> PatLit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PatLit -> PatLit -> Ordering
compare :: PatLit -> PatLit -> Ordering
$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
>= :: PatLit -> PatLit -> Bool
$cmax :: PatLit -> PatLit -> PatLit
max :: PatLit -> PatLit -> PatLit
$cmin :: PatLit -> PatLit -> PatLit
min :: PatLit -> PatLit -> PatLit
Ord, Int -> PatLit -> ShowS
[PatLit] -> ShowS
PatLit -> String
(Int -> PatLit -> ShowS)
-> (PatLit -> String) -> ([PatLit] -> ShowS) -> Show PatLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatLit -> ShowS
showsPrec :: Int -> PatLit -> ShowS
$cshow :: PatLit -> String
show :: PatLit -> String
$cshowList :: [PatLit] -> ShowS
showList :: [PatLit] -> ShowS
Show)

-- | A pattern as used most places where variables are bound (function
-- parameters, @let@ expressions, etc).
data PatBase f vn t
  = TuplePat [PatBase f vn t] SrcLoc
  | RecordPat [(Name, PatBase f vn t)] SrcLoc
  | PatParens (PatBase f vn t) SrcLoc
  | Id vn (f t) SrcLoc
  | Wildcard (f t) SrcLoc -- Nothing, i.e. underscore.
  | PatAscription (PatBase f vn t) (TypeExp f vn) SrcLoc
  | PatLit PatLit (f t) SrcLoc
  | PatConstr Name (f t) [PatBase f vn t] SrcLoc
  | PatAttr (AttrInfo vn) (PatBase f vn t) SrcLoc

deriving instance (Show (Info t)) => Show (PatBase Info VName t)

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

deriving instance (Eq (NoInfo t)) => Eq (PatBase NoInfo VName t)

deriving instance (Eq (Info t)) => Eq (PatBase Info VName t)

deriving instance (Ord (NoInfo t)) => Ord (PatBase NoInfo VName t)

deriving instance (Ord (Info t)) => Ord (PatBase Info VName t)

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

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

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

instance (Traversable f) => Traversable (PatBase f vn) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
traverse a -> f b
f (Id vn
v f a
t SrcLoc
loc) = vn -> f b -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t. vn -> f t -> SrcLoc -> PatBase f vn t
Id vn
v (f b -> SrcLoc -> PatBase f vn b)
-> f (f b) -> f (SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse a -> f b
f f a
t f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (TuplePat [PatBase f vn a]
ps SrcLoc
loc) = [PatBase f vn b] -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t.
[PatBase f vn t] -> SrcLoc -> PatBase f vn t
TuplePat ([PatBase f vn b] -> SrcLoc -> PatBase f vn b)
-> f [PatBase f vn b] -> f (SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PatBase f vn a -> f (PatBase f vn b))
-> [PatBase f vn a] -> f [PatBase f vn b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
traverse a -> f b
f) [PatBase f vn a]
ps f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (RecordPat [(Name, PatBase f vn a)]
ps SrcLoc
loc) = [(Name, PatBase f vn b)] -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t.
[(Name, PatBase f vn t)] -> SrcLoc -> PatBase f vn t
RecordPat ([(Name, PatBase f vn b)] -> SrcLoc -> PatBase f vn b)
-> f [(Name, PatBase f vn b)] -> f (SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, PatBase f vn a) -> f (Name, PatBase f vn b))
-> [(Name, PatBase f vn a)] -> f [(Name, PatBase f vn b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((PatBase f vn a -> f (PatBase f vn b))
-> (Name, PatBase f vn a) -> f (Name, PatBase f vn b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Name, a) -> f (Name, b)
traverse ((PatBase f vn a -> f (PatBase f vn b))
 -> (Name, PatBase f vn a) -> f (Name, PatBase f vn b))
-> (PatBase f vn a -> f (PatBase f vn b))
-> (Name, PatBase f vn a)
-> f (Name, PatBase f vn b)
forall a b. (a -> b) -> a -> b
$ (a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
traverse a -> f b
f) [(Name, PatBase f vn a)]
ps f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (PatParens PatBase f vn a
p SrcLoc
loc) = PatBase f vn b -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t.
PatBase f vn t -> SrcLoc -> PatBase f vn t
PatParens (PatBase f vn b -> SrcLoc -> PatBase f vn b)
-> f (PatBase f vn b) -> f (SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
traverse a -> f b
f PatBase f vn a
p f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (Wildcard f a
t SrcLoc
loc) = f b -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t. f t -> SrcLoc -> PatBase f vn t
Wildcard (f b -> SrcLoc -> PatBase f vn b)
-> f (f b) -> f (SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse a -> f b
f f a
t f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (PatAscription PatBase f vn a
p TypeExp f vn
te SrcLoc
loc) = PatBase f vn b -> TypeExp f vn -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t.
PatBase f vn t -> TypeExp f vn -> SrcLoc -> PatBase f vn t
PatAscription (PatBase f vn b -> TypeExp f vn -> SrcLoc -> PatBase f vn b)
-> f (PatBase f vn b)
-> f (TypeExp f vn -> SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
traverse a -> f b
f PatBase f vn a
p f (TypeExp f vn -> SrcLoc -> PatBase f vn b)
-> f (TypeExp f vn) -> f (SrcLoc -> PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp f vn -> f (TypeExp f vn)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeExp f vn
te f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (PatLit PatLit
l f a
t SrcLoc
loc) = PatLit -> f b -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t.
PatLit -> f t -> SrcLoc -> PatBase f vn t
PatLit PatLit
l (f b -> SrcLoc -> PatBase f vn b)
-> f (f b) -> f (SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse a -> f b
f f a
t f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (PatConstr Name
c f a
t [PatBase f vn a]
ps SrcLoc
loc) = Name -> f b -> [PatBase f vn b] -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t.
Name -> f t -> [PatBase f vn t] -> SrcLoc -> PatBase f vn t
PatConstr Name
c (f b -> [PatBase f vn b] -> SrcLoc -> PatBase f vn b)
-> f (f b) -> f ([PatBase f vn b] -> SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse a -> f b
f f a
t f ([PatBase f vn b] -> SrcLoc -> PatBase f vn b)
-> f [PatBase f vn b] -> f (SrcLoc -> PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PatBase f vn a -> f (PatBase f vn b))
-> [PatBase f vn a] -> f [PatBase f vn b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
traverse a -> f b
f) [PatBase f vn a]
ps f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  traverse a -> f b
f (PatAttr AttrInfo vn
attr PatBase f vn a
p SrcLoc
loc) = AttrInfo vn -> PatBase f vn b -> SrcLoc -> PatBase f vn b
forall (f :: * -> *) vn t.
AttrInfo vn -> PatBase f vn t -> SrcLoc -> PatBase f vn t
PatAttr AttrInfo vn
attr (PatBase f vn b -> SrcLoc -> PatBase f vn b)
-> f (PatBase f vn b) -> f (SrcLoc -> PatBase f vn b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatBase f vn a -> f (PatBase f vn b)
traverse a -> f b
f PatBase f vn a
p f (SrcLoc -> PatBase f vn b) -> f SrcLoc -> f (PatBase f vn b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> f SrcLoc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

-- | Documentation strings, including source location.  The string may
-- contain newline characters, but it does not contain comment prefix
-- markers.
data DocComment = DocComment T.Text SrcLoc
  deriving (Int -> DocComment -> ShowS
[DocComment] -> ShowS
DocComment -> String
(Int -> DocComment -> ShowS)
-> (DocComment -> String)
-> ([DocComment] -> ShowS)
-> Show DocComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocComment -> ShowS
showsPrec :: Int -> DocComment -> ShowS
$cshow :: DocComment -> String
show :: DocComment -> String
$cshowList :: [DocComment] -> ShowS
showList :: [DocComment] -> ShowS
Show)

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

-- | Part of the type of an entry point.  Has an actual type, and
-- maybe also an ascribed type expression.  Note that although size
-- expressions in the elaborated type can contain variables, they are
-- no longer in scope, and are considered more like equivalence
-- classes.
data EntryType = EntryType
  { EntryType -> StructType
entryType :: StructType,
    EntryType -> Maybe (TypeExp Info VName)
entryAscribed :: Maybe (TypeExp Info VName)
  }
  deriving (Int -> EntryType -> ShowS
[EntryType] -> ShowS
EntryType -> String
(Int -> EntryType -> ShowS)
-> (EntryType -> String)
-> ([EntryType] -> ShowS)
-> Show EntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryType -> ShowS
showsPrec :: Int -> EntryType -> ShowS
$cshow :: EntryType -> String
show :: EntryType -> String
$cshowList :: [EntryType] -> ShowS
showList :: [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
(Int -> EntryParam -> ShowS)
-> (EntryParam -> String)
-> ([EntryParam] -> ShowS)
-> Show EntryParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryParam -> ShowS
showsPrec :: Int -> EntryParam -> ShowS
$cshow :: EntryParam -> String
show :: EntryParam -> String
$cshowList :: [EntryParam] -> ShowS
showList :: [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
(Int -> EntryPoint -> ShowS)
-> (EntryPoint -> String)
-> ([EntryPoint] -> ShowS)
-> Show EntryPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryPoint -> ShowS
showsPrec :: Int -> EntryPoint -> ShowS
$cshow :: EntryPoint -> String
show :: EntryPoint -> String
$cshowList :: [EntryPoint] -> ShowS
showList :: [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 f vn)
valBindRetDecl :: Maybe (TypeExp f vn),
    -- | If 'valBindParams' is null, then the 'retDims' are brought
    -- into scope at this point.
    forall (f :: * -> *) vn. ValBindBase f vn -> f ResRetType
valBindRetType :: f ResRetType,
    forall (f :: * -> *) vn. ValBindBase f vn -> [TypeParamBase vn]
valBindTypeParams :: [TypeParamBase vn],
    forall (f :: * -> *) vn.
ValBindBase f vn -> [PatBase f vn ParamType]
valBindParams :: [PatBase f vn ParamType],
    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 = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (ValBindBase f vn -> SrcLoc) -> ValBindBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValBindBase f vn -> SrcLoc
forall (f :: * -> *) vn. ValBindBase f vn -> SrcLoc
valBindLocation

-- | Type Declarations
data TypeBindBase f vn = TypeBind
  { forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias :: vn,
    forall (f :: * -> *) vn. TypeBindBase f vn -> Liftedness
typeLiftedness :: Liftedness,
    forall (f :: * -> *) vn. TypeBindBase f vn -> [TypeParamBase vn]
typeParams :: [TypeParamBase vn],
    forall (f :: * -> *) vn. TypeBindBase f vn -> TypeExp f vn
typeExp :: TypeExp f 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 = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> (TypeBindBase f vn -> SrcLoc) -> TypeBindBase f vn -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeBindBase f vn -> SrcLoc
forall (f :: * -> *) vn. TypeBindBase f vn -> SrcLoc
typeBindLocation

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

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

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

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

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

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

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

-- | A spec is a component of a module type.
data SpecBase f vn
  = ValSpec
      { forall (f :: * -> *) vn. SpecBase f vn -> vn
specName :: vn,
        forall (f :: * -> *) vn. SpecBase f vn -> [TypeParamBase vn]
specTypeParams :: [TypeParamBase vn],
        forall (f :: * -> *) vn. SpecBase f vn -> TypeExp f vn
specTypeExp :: TypeExp f 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 f vn
_ f StructType
_ Maybe DocComment
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (TypeAbbrSpec TypeBindBase f vn
tbind) = TypeBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf TypeBindBase f vn
tbind
  locOf (TypeSpec Liftedness
_ vn
_ [TypeParamBase vn]
_ Maybe DocComment
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModSpec vn
_ SigExpBase f vn
_ Maybe DocComment
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (IncludeSpec SigExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

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

deriving instance Show (SigExpBase Info VName)

deriving instance Show (SigExpBase NoInfo Name)

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

deriving instance Show (TypeRefBase Info VName)

deriving instance Show (TypeRefBase NoInfo Name)

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

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

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

deriving instance Show (SigBindBase Info VName)

deriving instance Show (SigBindBase NoInfo Name)

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

-- | Canonical reference to a Futhark code file.  Does not include the
-- @.fut@ extension.  This is most often a path relative to the
-- working directory of the compiler.  In a multi-file program, a file
-- is known by exactly one import name, even if it is referenced
-- relatively by different names by files in different subdirectories.
newtype ImportName = ImportName Posix.FilePath
  deriving (ImportName -> ImportName -> Bool
(ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool) -> Eq ImportName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportName -> ImportName -> Bool
== :: ImportName -> ImportName -> Bool
$c/= :: ImportName -> ImportName -> Bool
/= :: ImportName -> ImportName -> Bool
Eq, Eq ImportName
Eq ImportName
-> (ImportName -> ImportName -> Ordering)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> ImportName)
-> (ImportName -> ImportName -> ImportName)
-> Ord ImportName
ImportName -> ImportName -> Bool
ImportName -> ImportName -> Ordering
ImportName -> ImportName -> ImportName
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
$ccompare :: ImportName -> ImportName -> Ordering
compare :: ImportName -> ImportName -> Ordering
$c< :: ImportName -> ImportName -> Bool
< :: ImportName -> ImportName -> Bool
$c<= :: ImportName -> ImportName -> Bool
<= :: ImportName -> ImportName -> Bool
$c> :: ImportName -> ImportName -> Bool
> :: ImportName -> ImportName -> Bool
$c>= :: ImportName -> ImportName -> Bool
>= :: ImportName -> ImportName -> Bool
$cmax :: ImportName -> ImportName -> ImportName
max :: ImportName -> ImportName -> ImportName
$cmin :: ImportName -> ImportName -> ImportName
min :: ImportName -> ImportName -> ImportName
Ord, Int -> ImportName -> ShowS
[ImportName] -> ShowS
ImportName -> String
(Int -> ImportName -> ShowS)
-> (ImportName -> String)
-> ([ImportName] -> ShowS)
-> Show ImportName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportName -> ShowS
showsPrec :: Int -> ImportName -> ShowS
$cshow :: ImportName -> String
show :: ImportName -> String
$cshowList :: [ImportName] -> ShowS
showList :: [ImportName] -> ShowS
Show)

-- | 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 ImportName) 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) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModParens ModExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModImport String
_ f ImportName
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModDecs [DecBase f vn]
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModApply ModExpBase f vn
_ ModExpBase f vn
_ f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModAscript ModExpBase f vn
_ SigExpBase f vn
_ f (Map VName VName)
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ModLambda ModParamBase f vn
_ Maybe (SigExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

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

deriving instance Show (ModBindBase Info VName)

deriving instance Show (ModBindBase NoInfo Name)

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

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

deriving instance Show (ModParamBase Info VName)

deriving instance Show (ModParamBase NoInfo Name)

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

-- | A top-level binding.
data DecBase f vn
  = ValDec (ValBindBase f vn)
  | TypeDec (TypeBindBase f vn)
  | SigDec (SigBindBase f vn)
  | ModDec (ModBindBase f vn)
  | OpenDec (ModExpBase f vn) SrcLoc
  | LocalDec (DecBase f vn) SrcLoc
  | ImportDec FilePath (f ImportName) 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) = ValBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf ValBindBase f vn
d
  locOf (TypeDec TypeBindBase f vn
d) = TypeBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf TypeBindBase f vn
d
  locOf (SigDec SigBindBase f vn
d) = SigBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf SigBindBase f vn
d
  locOf (ModDec ModBindBase f vn
d) = ModBindBase f vn -> Loc
forall a. Located a => a -> Loc
locOf ModBindBase f vn
d
  locOf (OpenDec ModExpBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (LocalDec DecBase f vn
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
  locOf (ImportDec String
_ f ImportName
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

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

deriving instance Show (ProgBase Info VName)

deriving instance Show (ProgBase NoInfo Name)

-- | Construct an 'Apply' node, with type information.
mkApply :: ExpBase Info vn -> [(Diet, Maybe VName, ExpBase Info vn)] -> AppRes -> ExpBase Info vn
mkApply :: forall vn.
ExpBase Info vn
-> [(Diet, Maybe VName, ExpBase Info vn)]
-> AppRes
-> ExpBase Info vn
mkApply ExpBase Info vn
f [(Diet, Maybe VName, ExpBase Info vn)]
args (AppRes StructType
t [VName]
ext)
  | Just NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
args' <- [(Info (Diet, Maybe VName), ExpBase Info vn)]
-> Maybe (NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([(Info (Diet, Maybe VName), ExpBase Info vn)]
 -> Maybe (NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)))
-> [(Info (Diet, Maybe VName), ExpBase Info vn)]
-> Maybe (NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn))
forall a b. (a -> b) -> a -> b
$ ((Diet, Maybe VName, ExpBase Info vn)
 -> (Info (Diet, Maybe VName), ExpBase Info vn))
-> [(Diet, Maybe VName, ExpBase Info vn)]
-> [(Info (Diet, Maybe VName), ExpBase Info vn)]
forall a b. (a -> b) -> [a] -> [b]
map (Diet, Maybe VName, ExpBase Info vn)
-> (Info (Diet, Maybe VName), ExpBase Info vn)
forall {a} {b} {b}. (a, b, b) -> (Info (a, b), b)
onArg [(Diet, Maybe VName, ExpBase Info vn)]
args =
      case ExpBase Info vn
f of
        (AppExp (Apply ExpBase Info vn
f' NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
f_args SrcLoc
loc) (Info (AppRes StructType
_ [VName]
f_ext))) ->
          AppExpBase Info vn -> Info AppRes -> ExpBase Info vn
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp
            (ExpBase Info vn
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
-> SrcLoc
-> AppExpBase Info vn
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply ExpBase Info vn
f' (NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
f_args NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
args') (SrcLoc -> ExpBase Info vn -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
srcspan SrcLoc
loc (ExpBase Info vn -> SrcLoc) -> ExpBase Info vn -> SrcLoc
forall a b. (a -> b) -> a -> b
$ (Info (Diet, Maybe VName), ExpBase Info vn) -> ExpBase Info vn
forall a b. (a, b) -> b
snd ((Info (Diet, Maybe VName), ExpBase Info vn) -> ExpBase Info vn)
-> (Info (Diet, Maybe VName), ExpBase Info vn) -> ExpBase Info vn
forall a b. (a -> b) -> a -> b
$ NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
-> (Info (Diet, Maybe VName), ExpBase Info vn)
forall a. NonEmpty a -> a
NE.last NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
args'))
            (AppRes -> Info AppRes
forall a. a -> Info a
Info (AppRes -> Info AppRes) -> AppRes -> Info AppRes
forall a b. (a -> b) -> a -> b
$ StructType -> [VName] -> AppRes
AppRes StructType
t ([VName] -> AppRes) -> [VName] -> AppRes
forall a b. (a -> b) -> a -> b
$ [VName]
f_ext [VName] -> [VName] -> [VName]
forall a. Semigroup a => a -> a -> a
<> [VName]
ext)
        ExpBase Info vn
_ ->
          AppExpBase Info vn -> Info AppRes -> ExpBase Info vn
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp (ExpBase Info vn
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
-> SrcLoc
-> AppExpBase Info vn
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply ExpBase Info vn
f NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
args' (ExpBase Info vn -> ExpBase Info vn -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
srcspan ExpBase Info vn
f (ExpBase Info vn -> SrcLoc) -> ExpBase Info vn -> SrcLoc
forall a b. (a -> b) -> a -> b
$ (Info (Diet, Maybe VName), ExpBase Info vn) -> ExpBase Info vn
forall a b. (a, b) -> b
snd ((Info (Diet, Maybe VName), ExpBase Info vn) -> ExpBase Info vn)
-> (Info (Diet, Maybe VName), ExpBase Info vn) -> ExpBase Info vn
forall a b. (a -> b) -> a -> b
$ NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
-> (Info (Diet, Maybe VName), ExpBase Info vn)
forall a. NonEmpty a -> a
NE.last NonEmpty (Info (Diet, Maybe VName), ExpBase Info vn)
args')) (AppRes -> Info AppRes
forall a. a -> Info a
Info (StructType -> [VName] -> AppRes
AppRes StructType
t [VName]
ext))
  | Bool
otherwise = ExpBase Info vn
f
  where
    onArg :: (a, b, b) -> (Info (a, b), b)
onArg (a
d, b
v, b
x) = ((a, b) -> Info (a, b)
forall a. a -> Info a
Info (a
d, b
v), b
x)

-- | Construct an 'Apply' node, without type information.
mkApplyUT :: ExpBase NoInfo vn -> ExpBase NoInfo vn -> ExpBase NoInfo vn
mkApplyUT :: forall vn.
ExpBase NoInfo vn -> ExpBase NoInfo vn -> ExpBase NoInfo vn
mkApplyUT (AppExp (Apply ExpBase NoInfo vn
f NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
args SrcLoc
loc) NoInfo AppRes
_) ExpBase NoInfo vn
x =
  AppExpBase NoInfo vn -> NoInfo AppRes -> ExpBase NoInfo vn
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp (ExpBase NoInfo vn
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
-> SrcLoc
-> AppExpBase NoInfo vn
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply ExpBase NoInfo vn
f (NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
args NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
forall a. Semigroup a => a -> a -> a
<> (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
forall a. a -> NonEmpty a
NE.singleton (NoInfo (Diet, Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo, ExpBase NoInfo vn
x)) (SrcLoc -> ExpBase NoInfo vn -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
srcspan SrcLoc
loc ExpBase NoInfo vn
x)) NoInfo AppRes
forall {k} (a :: k). NoInfo a
NoInfo
mkApplyUT ExpBase NoInfo vn
f ExpBase NoInfo vn
x =
  AppExpBase NoInfo vn -> NoInfo AppRes -> ExpBase NoInfo vn
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp (ExpBase NoInfo vn
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
-> SrcLoc
-> AppExpBase NoInfo vn
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply ExpBase NoInfo vn
f ((NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo vn)
forall a. a -> NonEmpty a
NE.singleton (NoInfo (Diet, Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo, ExpBase NoInfo vn
x)) (ExpBase NoInfo vn -> ExpBase NoInfo vn -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
srcspan ExpBase NoInfo vn
f ExpBase NoInfo vn
x)) NoInfo AppRes
forall {k} (a :: k). NoInfo a
NoInfo

--- 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) = IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
  pretty (FloatType FloatType
t) = FloatType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FloatType -> 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
"|>"