-- | This module provides various simple ways to query and manipulate
-- fundamental Futhark terms, such as types and values.  The intent is to
-- keep "Futhark.Language.Syntax" simple, and put whatever embellishments
-- we need here.
module Language.Futhark.Prop
  ( -- * Various
    Intrinsic (..),
    intrinsics,
    intrinsicVar,
    isBuiltin,
    isBuiltinLoc,
    maxIntrinsicTag,
    namesToPrimTypes,
    qualName,
    qualify,
    primValueType,
    leadingOperator,
    progImports,
    decImports,
    progModuleTypes,
    identifierReference,
    prettyStacktrace,
    progHoles,
    defaultEntryPoint,
    paramName,
    anySize,

    -- * Queries on expressions
    typeOf,
    valBindTypeScheme,
    valBindBound,
    funType,
    stripExp,
    similarExps,

    -- * Queries on patterns and params
    patIdents,
    patNames,
    patternMap,
    patternType,
    patternStructType,
    patternParam,
    patternOrderZero,

    -- * Queries on types
    uniqueness,
    unique,
    diet,
    arrayRank,
    arrayShape,
    orderZero,
    unfoldFunType,
    foldFunType,
    typeVars,
    isAccType,

    -- * Operations on types
    peelArray,
    stripArray,
    arrayOf,
    arrayOfWithAliases,
    toStructural,
    toStruct,
    toRes,
    toParam,
    resToParam,
    paramToRes,
    toResRet,
    setUniqueness,
    noSizes,
    traverseDims,
    DimPos (..),
    tupleRecord,
    isTupleRecord,
    areTupleFields,
    tupleFields,
    tupleFieldNames,
    sortFields,
    sortConstrs,
    isTypeParam,
    isSizeParam,
    matchDims,

    -- * Un-typechecked ASTs
    UncheckedType,
    UncheckedTypeExp,
    UncheckedIdent,
    UncheckedDimIndex,
    UncheckedSlice,
    UncheckedExp,
    UncheckedModExp,
    UncheckedSigExp,
    UncheckedTypeParam,
    UncheckedPat,
    UncheckedValBind,
    UncheckedTypeBind,
    UncheckedSigBind,
    UncheckedModBind,
    UncheckedDec,
    UncheckedSpec,
    UncheckedProg,
    UncheckedCase,

    -- * Type-checked ASTs
    Ident,
    DimIndex,
    Slice,
    AppExp,
    Exp,
    Pat,
    ModExp,
    ModParam,
    SigExp,
    ModBind,
    SigBind,
    ValBind,
    Dec,
    Spec,
    Prog,
    TypeBind,
    StructTypeArg,
    ScalarType,
    TypeParam,
    Case,
  )
where

import Control.Monad
import Control.Monad.State
import Data.Bifunctor
import Data.Bitraversable (bitraverse)
import Data.Char
import Data.Foldable
import Data.List (genericLength, isPrefixOf, sortOn)
import Data.List.NonEmpty qualified as NE
import Data.Loc (Loc (..), posFile)
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Ord
import Data.Set qualified as S
import Futhark.Util (maxinum)
import Futhark.Util.Pretty
import Language.Futhark.Primitive qualified as Primitive
import Language.Futhark.Syntax
import Language.Futhark.Traversals
import Language.Futhark.Tuple
import System.FilePath (takeDirectory)

-- | The name of the default program entry point (@main@).
defaultEntryPoint :: Name
defaultEntryPoint :: Name
defaultEntryPoint = FilePath -> Name
nameFromString FilePath
"main"

-- | Return the dimensionality of a type.  For non-arrays, this is
-- zero.  For a one-dimensional array it is one, for a two-dimensional
-- it is two, and so forth.
arrayRank :: TypeBase dim as -> Int
arrayRank :: forall dim as. TypeBase dim as -> Int
arrayRank = forall dim. Shape dim -> Int
shapeRank forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim as. TypeBase dim as -> Shape dim
arrayShape

-- | Return the shape of a type - for non-arrays, this is 'mempty'.
arrayShape :: TypeBase dim as -> Shape dim
arrayShape :: forall dim as. TypeBase dim as -> Shape dim
arrayShape (Array as
_ Shape dim
ds ScalarTypeBase dim NoUniqueness
_) = Shape dim
ds
arrayShape TypeBase dim as
_ = forall a. Monoid a => a
mempty

-- | Change the shape of a type to be just the rank.
noSizes :: TypeBase Size as -> TypeBase () as
noSizes :: forall as. TypeBase (ExpBase Info VName) as -> TypeBase () as
noSizes = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ()

-- | Where does this dimension occur?
data DimPos
  = -- | Immediately in the argument to 'traverseDims'.
    PosImmediate
  | -- | In a function parameter type.
    PosParam
  | -- | In a function return type.
    PosReturn
  deriving (DimPos -> DimPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DimPos -> DimPos -> Bool
$c/= :: DimPos -> DimPos -> Bool
== :: DimPos -> DimPos -> Bool
$c== :: DimPos -> DimPos -> Bool
Eq, Eq DimPos
DimPos -> DimPos -> Bool
DimPos -> DimPos -> Ordering
DimPos -> DimPos -> DimPos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DimPos -> DimPos -> DimPos
$cmin :: DimPos -> DimPos -> DimPos
max :: DimPos -> DimPos -> DimPos
$cmax :: DimPos -> DimPos -> DimPos
>= :: DimPos -> DimPos -> Bool
$c>= :: DimPos -> DimPos -> Bool
> :: DimPos -> DimPos -> Bool
$c> :: DimPos -> DimPos -> Bool
<= :: DimPos -> DimPos -> Bool
$c<= :: DimPos -> DimPos -> Bool
< :: DimPos -> DimPos -> Bool
$c< :: DimPos -> DimPos -> Bool
compare :: DimPos -> DimPos -> Ordering
$ccompare :: DimPos -> DimPos -> Ordering
Ord, Int -> DimPos -> ShowS
[DimPos] -> ShowS
DimPos -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DimPos] -> ShowS
$cshowList :: [DimPos] -> ShowS
show :: DimPos -> FilePath
$cshow :: DimPos -> FilePath
showsPrec :: Int -> DimPos -> ShowS
$cshowsPrec :: Int -> DimPos -> ShowS
Show)

-- | Perform a traversal (possibly including replacement) on sizes
-- that are parameters in a function type, but also including the type
-- immediately passed to the function.  Also passes along a set of the
-- parameter names inside the type that have come in scope at the
-- occurrence of the dimension.
traverseDims ::
  forall f fdim tdim als.
  Applicative f =>
  (S.Set VName -> DimPos -> fdim -> f tdim) ->
  TypeBase fdim als ->
  f (TypeBase tdim als)
traverseDims :: forall (f :: * -> *) fdim tdim als.
Applicative f =>
(Set VName -> DimPos -> fdim -> f tdim)
-> TypeBase fdim als -> f (TypeBase tdim als)
traverseDims Set VName -> DimPos -> fdim -> f tdim
f = forall als'.
Set VName -> DimPos -> TypeBase fdim als' -> f (TypeBase tdim als')
go forall a. Monoid a => a
mempty DimPos
PosImmediate
  where
    go ::
      forall als'.
      S.Set VName ->
      DimPos ->
      TypeBase fdim als' ->
      f (TypeBase tdim als')
    go :: forall als'.
Set VName -> DimPos -> TypeBase fdim als' -> f (TypeBase tdim als')
go Set VName
bound DimPos
b t :: TypeBase fdim als'
t@Array {} =
      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 (Set VName -> DimPos -> fdim -> f tdim
f Set VName
bound DimPos
b) forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase fdim als'
t
    go Set VName
bound DimPos
b (Scalar (Record Map Name (TypeBase fdim als')
fields)) =
      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall als'.
Set VName -> DimPos -> TypeBase fdim als' -> f (TypeBase tdim als')
go Set VName
bound DimPos
b) Map Name (TypeBase fdim als')
fields
    go Set VName
bound DimPos
b (Scalar (TypeVar als'
as QualName VName
tn [TypeArg fdim]
targs)) =
      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar als'
as QualName VName
tn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Set VName -> DimPos -> TypeArg fdim -> f (TypeArg tdim)
onTypeArg Set VName
bound DimPos
b) [TypeArg fdim]
targs)
    go Set VName
bound DimPos
b (Scalar (Sum Map Name [TypeBase fdim als']
cs)) =
      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u. Map Name [TypeBase dim u] -> ScalarTypeBase dim u
Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall als'.
Set VName -> DimPos -> TypeBase fdim als' -> f (TypeBase tdim als')
go Set VName
bound DimPos
b)) Map Name [TypeBase fdim als']
cs
    go Set VName
_ DimPos
_ (Scalar (Prim PrimType
t)) =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim PrimType
t
    go Set VName
bound DimPos
_ (Scalar (Arrow als'
als PName
p Diet
u TypeBase fdim NoUniqueness
t1 (RetType [VName]
dims TypeBase fdim Uniqueness
t2))) =
      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow als'
als PName
p Diet
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall als'.
Set VName -> DimPos -> TypeBase fdim als' -> f (TypeBase tdim als')
go Set VName
bound' DimPos
PosParam TypeBase fdim NoUniqueness
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
dims forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall als'.
Set VName -> DimPos -> TypeBase fdim als' -> f (TypeBase tdim als')
go Set VName
bound' DimPos
PosReturn TypeBase fdim Uniqueness
t2))
      where
        bound' :: Set VName
bound' =
          forall a. Ord a => [a] -> Set a
S.fromList [VName]
dims
            forall a. Semigroup a => a -> a -> a
<> case PName
p of
              Named VName
p' -> forall a. Ord a => a -> Set a -> Set a
S.insert VName
p' Set VName
bound
              PName
Unnamed -> Set VName
bound

    onTypeArg :: Set VName -> DimPos -> TypeArg fdim -> f (TypeArg tdim)
onTypeArg Set VName
bound DimPos
b (TypeArgDim fdim
d) =
      forall dim. dim -> TypeArg dim
TypeArgDim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set VName -> DimPos -> fdim -> f tdim
f Set VName
bound DimPos
b fdim
d
    onTypeArg Set VName
bound DimPos
b (TypeArgType TypeBase fdim NoUniqueness
t) =
      forall dim. TypeBase dim NoUniqueness -> TypeArg dim
TypeArgType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall als'.
Set VName -> DimPos -> TypeBase fdim als' -> f (TypeBase tdim als')
go Set VName
bound DimPos
b TypeBase fdim NoUniqueness
t

-- | Return the uniqueness of a type.
uniqueness :: TypeBase shape Uniqueness -> Uniqueness
uniqueness :: forall shape. TypeBase shape Uniqueness -> Uniqueness
uniqueness (Array Uniqueness
u Shape shape
_ ScalarTypeBase shape NoUniqueness
_) = Uniqueness
u
uniqueness (Scalar (TypeVar Uniqueness
u QualName VName
_ [TypeArg shape]
_)) = Uniqueness
u
uniqueness (Scalar (Sum Map Name [TypeBase shape Uniqueness]
ts))
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall shape. TypeBase shape Uniqueness -> Bool
unique) Map Name [TypeBase shape Uniqueness]
ts = Uniqueness
Unique
uniqueness (Scalar (Record Map Name (TypeBase shape Uniqueness)
fs))
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall shape. TypeBase shape Uniqueness -> Bool
unique Map Name (TypeBase shape Uniqueness)
fs = Uniqueness
Unique
uniqueness TypeBase shape Uniqueness
_ = Uniqueness
Nonunique

-- | @unique t@ is 'True' if the type of the argument is unique.
unique :: TypeBase shape Uniqueness -> Bool
unique :: forall shape. TypeBase shape Uniqueness -> Bool
unique = (forall a. Eq a => a -> a -> Bool
== Uniqueness
Unique) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall shape. TypeBase shape Uniqueness -> Uniqueness
uniqueness

-- | @diet t@ returns a description of how a function parameter of
-- type @t@ consumes its argument.
diet :: TypeBase shape Diet -> Diet
diet :: forall shape. TypeBase shape Diet -> Diet
diet (Scalar (Record Map Name (TypeBase shape Diet)
ets)) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
max Diet
Observe forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall shape. TypeBase shape Diet -> Diet
diet Map Name (TypeBase shape Diet)
ets
diet (Scalar (Prim PrimType
_)) = Diet
Observe
diet (Scalar (Arrow {})) = Diet
Observe
diet (Array Diet
d Shape shape
_ ScalarTypeBase shape NoUniqueness
_) = Diet
d
diet (Scalar (TypeVar Diet
d QualName VName
_ [TypeArg shape]
_)) = Diet
d
diet (Scalar (Sum Map Name [TypeBase shape Diet]
cs)) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
max Diet
Observe forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b. (a -> b) -> [a] -> [b]
map forall shape. TypeBase shape Diet -> Diet
diet) Map Name [TypeBase shape Diet]
cs

-- | Convert any type to one that has rank information, no alias
-- information, and no embedded names.
toStructural ::
  TypeBase dim as ->
  TypeBase () ()
toStructural :: forall dim as. TypeBase dim as -> TypeBase () ()
toStructural = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a b. a -> b -> a
const ()) (forall a b. a -> b -> a
const ())

-- | Remove uniquenss information from a type.
toStruct :: TypeBase dim u -> TypeBase dim NoUniqueness
toStruct :: forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const NoUniqueness
NoUniqueness)

-- | Uses 'Observe'.
toParam :: Diet -> TypeBase Size u -> ParamType
toParam :: forall u. Diet -> TypeBase (ExpBase Info VName) u -> ParamType
toParam Diet
d = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Diet
d)

-- | Convert to 'ResType'
toRes :: Uniqueness -> TypeBase Size u -> ResType
toRes :: forall u. Uniqueness -> TypeBase (ExpBase Info VName) u -> ResType
toRes Uniqueness
u = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Uniqueness
u)

-- | Convert to 'ResRetType'
toResRet :: Uniqueness -> RetTypeBase Size u -> ResRetType
toResRet :: forall u.
Uniqueness -> RetTypeBase (ExpBase Info VName) u -> ResRetType
toResRet Uniqueness
u = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const Uniqueness
u)

-- | Preserves relation between 'Diet' and 'Uniqueness'.
resToParam :: ResType -> ParamType
resToParam :: ResType -> ParamType
resToParam = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Uniqueness -> Diet
f
  where
    f :: Uniqueness -> Diet
f Uniqueness
Unique = Diet
Consume
    f Uniqueness
Nonunique = Diet
Observe

-- | Preserves relation between 'Diet' and 'Uniqueness'.
paramToRes :: ParamType -> ResType
paramToRes :: ParamType -> ResType
paramToRes = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Diet -> Uniqueness
f
  where
    f :: Diet -> Uniqueness
f Diet
Consume = Uniqueness
Unique
    f Diet
Observe = Uniqueness
Nonunique

-- | @peelArray n t@ returns the type resulting from peeling the first
-- @n@ array dimensions from @t@.  Returns @Nothing@ if @t@ has less
-- than @n@ dimensions.
peelArray :: Int -> TypeBase dim u -> Maybe (TypeBase dim u)
peelArray :: forall dim u. Int -> TypeBase dim u -> Maybe (TypeBase dim u)
peelArray Int
n (Array u
u Shape dim
shape ScalarTypeBase dim NoUniqueness
t)
  | forall dim. Shape dim -> Int
shapeRank Shape dim
shape forall a. Eq a => a -> a -> Bool
== Int
n =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const u
u) (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar ScalarTypeBase dim NoUniqueness
t)
  | Bool
otherwise =
      forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array u
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall dim. Int -> Shape dim -> Maybe (Shape dim)
stripDims Int
n Shape dim
shape forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarTypeBase dim NoUniqueness
t
peelArray Int
_ TypeBase dim u
_ = forall a. Maybe a
Nothing

-- | @arrayOf u s t@ constructs an array type.  The convenience
-- compared to using the 'Array' constructor directly is that @t@ can
-- itself be an array.  If @t@ is an @n@-dimensional array, and @s@ is
-- a list of length @n@, the resulting type is of an @n+m@ dimensions.
arrayOf ::
  Shape dim ->
  TypeBase dim NoUniqueness ->
  TypeBase dim NoUniqueness
arrayOf :: forall dim.
Shape dim -> TypeBase dim NoUniqueness -> TypeBase dim NoUniqueness
arrayOf = forall u dim. u -> Shape dim -> TypeBase dim u -> TypeBase dim u
arrayOfWithAliases forall a. Monoid a => a
mempty

-- | Like 'arrayOf', but you can pass in uniqueness info of the
-- resulting array.
arrayOfWithAliases ::
  u ->
  Shape dim ->
  TypeBase dim u ->
  TypeBase dim u
arrayOfWithAliases :: forall u dim. u -> Shape dim -> TypeBase dim u -> TypeBase dim u
arrayOfWithAliases u
u Shape dim
shape2 (Array u
_ Shape dim
shape1 ScalarTypeBase dim NoUniqueness
et) =
  forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array u
u (Shape dim
shape2 forall a. Semigroup a => a -> a -> a
<> Shape dim
shape1) ScalarTypeBase dim NoUniqueness
et
arrayOfWithAliases u
u Shape dim
shape (Scalar ScalarTypeBase dim u
t) =
  forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array u
u Shape dim
shape (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) ScalarTypeBase dim u
t)

-- | @stripArray n t@ removes the @n@ outermost layers of the array.
-- Essentially, it is the type of indexing an array of type @t@ with
-- @n@ indexes.
stripArray :: Int -> TypeBase dim as -> TypeBase dim as
stripArray :: forall dim as. Int -> TypeBase dim as -> TypeBase dim as
stripArray Int
n (Array as
u Shape dim
shape ScalarTypeBase dim NoUniqueness
et)
  | Just Shape dim
shape' <- forall dim. Int -> Shape dim -> Maybe (Shape dim)
stripDims Int
n Shape dim
shape =
      forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array as
u Shape dim
shape' ScalarTypeBase dim NoUniqueness
et
  | Bool
otherwise =
      forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const as
u) (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar ScalarTypeBase dim NoUniqueness
et)
stripArray Int
_ TypeBase dim as
t = TypeBase dim as
t

-- | Create a record type corresponding to a tuple with the given
-- element types.
tupleRecord :: [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord :: forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord = forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
tupleFieldNames

-- | Does this type corespond to a tuple?  If so, return the elements
-- of that tuple.
isTupleRecord :: TypeBase dim as -> Maybe [TypeBase dim as]
isTupleRecord :: forall dim as. TypeBase dim as -> Maybe [TypeBase dim as]
isTupleRecord (Scalar (Record Map Name (TypeBase dim as)
fs)) = forall a. Map Name a -> Maybe [a]
areTupleFields Map Name (TypeBase dim as)
fs
isTupleRecord TypeBase dim as
_ = forall a. Maybe a
Nothing

-- | Sort the constructors of a sum type in some well-defined (but not
-- otherwise significant) manner.
sortConstrs :: M.Map Name a -> [(Name, a)]
sortConstrs :: forall a. Map Name a -> [(Name, a)]
sortConstrs Map Name a
cs = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Name a
cs

-- | Is this a 'TypeParamType'?
isTypeParam :: TypeParamBase vn -> Bool
isTypeParam :: forall vn. TypeParamBase vn -> Bool
isTypeParam TypeParamType {} = Bool
True
isTypeParam TypeParamDim {} = Bool
False

-- | Is this a 'TypeParamDim'?
isSizeParam :: TypeParamBase vn -> Bool
isSizeParam :: forall vn. TypeParamBase vn -> Bool
isSizeParam = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall vn. TypeParamBase vn -> Bool
isTypeParam

-- | The name, if any.
paramName :: PName -> Maybe VName
paramName :: PName -> Maybe VName
paramName (Named VName
v) = forall a. a -> Maybe a
Just VName
v
paramName PName
Unnamed = forall a. Maybe a
Nothing

-- | A special expression representing no known size.  When present in
-- a type, each instance represents a distinct size.  The type checker
-- should _never_ produce these - they are a (hopefully temporary)
-- thing introduced by defunctorisation and monomorphisation.  They
-- represent a flaw in our implementation.  When they occur in a
-- return type, they can be replaced with freshly created existential
-- sizes.  When they occur in parameter types, they can be replaced
-- with size parameters.
anySize :: Size
anySize :: ExpBase Info VName
anySize =
  -- The definition here is weird to avoid seeing this as a free
  -- variable.
  forall (f :: * -> *) vn. [Word8] -> SrcLoc -> ExpBase f vn
StringLit [Word8
65, Word8
78, Word8
89] forall a. Monoid a => a
mempty

-- | Match the dimensions of otherwise assumed-equal types.  The
-- combining function is also passed the names bound within the type
-- (from named parameters or return types).
matchDims ::
  forall as m d1 d2.
  (Monoid as, Monad m) =>
  ([VName] -> d1 -> d2 -> m d1) ->
  TypeBase d1 as ->
  TypeBase d2 as ->
  m (TypeBase d1 as)
matchDims :: forall as (m :: * -> *) d1 d2.
(Monoid as, Monad m) =>
([VName] -> d1 -> d2 -> m d1)
-> TypeBase d1 as -> TypeBase d2 as -> m (TypeBase d1 as)
matchDims [VName] -> d1 -> d2 -> m d1
onDims = forall u'.
Monoid u' =>
[VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
matchDims' forall a. Monoid a => a
mempty
  where
    matchDims' ::
      forall u'. Monoid u' => [VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
    matchDims' :: forall u'.
Monoid u' =>
[VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
matchDims' [VName]
bound TypeBase d1 u'
t1 TypeBase d2 u'
t2 =
      case (TypeBase d1 u'
t1, TypeBase d2 u'
t2) of
        (Array u'
u1 Shape d1
shape1 ScalarTypeBase d1 NoUniqueness
et1, Array u'
u2 Shape d2
shape2 ScalarTypeBase d2 NoUniqueness
et2) ->
          forall u dim. u -> Shape dim -> TypeBase dim u -> TypeBase dim u
arrayOfWithAliases u'
u1
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VName] -> Shape d1 -> Shape d2 -> m (Shape d1)
onShapes [VName]
bound Shape d1
shape1 Shape d2
shape2
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall u'.
Monoid u' =>
[VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
matchDims' [VName]
bound (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const u'
u2) (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar ScalarTypeBase d1 NoUniqueness
et1)) (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const u'
u2) (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar ScalarTypeBase d2 NoUniqueness
et2))
        (Scalar (Record Map Name (TypeBase d1 u')
f1), Scalar (Record Map Name (TypeBase d2 u')
f2)) ->
          forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall u'.
Monoid u' =>
[VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
matchDims' [VName]
bound)) (forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith (,) Map Name (TypeBase d1 u')
f1 Map Name (TypeBase d2 u')
f2)
        (Scalar (Sum Map Name [TypeBase d1 u']
cs1), Scalar (Sum Map Name [TypeBase d2 u']
cs2)) ->
          forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u. Map Name [TypeBase dim u] -> ScalarTypeBase dim u
Sum
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
              (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall u'.
Monoid u' =>
[VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
matchDims' [VName]
bound)))
              (forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith forall a b. [a] -> [b] -> [(a, b)]
zip Map Name [TypeBase d1 u']
cs1 Map Name [TypeBase d2 u']
cs2)
        ( Scalar (Arrow u'
als1 PName
p1 Diet
d1 TypeBase d1 NoUniqueness
a1 (RetType [VName]
dims1 TypeBase d1 Uniqueness
b1)),
          Scalar (Arrow u'
als2 PName
p2 Diet
_d2 TypeBase d2 NoUniqueness
a2 (RetType [VName]
dims2 TypeBase d2 Uniqueness
b2))
          ) ->
            let bound' :: [VName]
bound' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PName -> Maybe VName
paramName [PName
p1, PName
p2] forall a. Semigroup a => a -> a -> a
<> [VName]
dims1 forall a. Semigroup a => a -> a -> a
<> [VName]
dims2 forall a. Semigroup a => a -> a -> a
<> [VName]
bound
             in forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow (u'
als1 forall a. Semigroup a => a -> a -> a
<> u'
als2) PName
p1 Diet
d1
                          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall u'.
Monoid u' =>
[VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
matchDims' [VName]
bound' TypeBase d1 NoUniqueness
a1 TypeBase d2 NoUniqueness
a2
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
dims1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall u'.
Monoid u' =>
[VName] -> TypeBase d1 u' -> TypeBase d2 u' -> m (TypeBase d1 u')
matchDims' [VName]
bound' TypeBase d1 Uniqueness
b1 TypeBase d2 Uniqueness
b2)
                      )
        ( Scalar (TypeVar u'
als1 QualName VName
v [TypeArg d1]
targs1),
          Scalar (TypeVar u'
als2 QualName VName
_ [TypeArg d2]
targs2)
          ) ->
            forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar (u'
als1 forall a. Semigroup a => a -> a -> a
<> u'
als2) QualName VName
v
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ([VName] -> TypeArg d1 -> TypeArg d2 -> m (TypeArg d1)
matchTypeArg [VName]
bound) [TypeArg d1]
targs1 [TypeArg d2]
targs2
        (TypeBase d1 u', TypeBase d2 u')
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase d1 u'
t1

    matchTypeArg :: [VName] -> TypeArg d1 -> TypeArg d2 -> m (TypeArg d1)
matchTypeArg [VName]
_ ta :: TypeArg d1
ta@TypeArgType {} TypeArg d2
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeArg d1
ta
    matchTypeArg [VName]
bound (TypeArgDim d1
x) (TypeArgDim d2
y) =
      forall dim. dim -> TypeArg dim
TypeArgDim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VName] -> d1 -> d2 -> m d1
onDims [VName]
bound d1
x d2
y
    matchTypeArg [VName]
_ TypeArg d1
a TypeArg d2
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeArg d1
a

    onShapes :: [VName] -> Shape d1 -> Shape d2 -> m (Shape d1)
onShapes [VName]
bound Shape d1
shape1 Shape d2
shape2 =
      forall dim. [dim] -> Shape dim
Shape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ([VName] -> d1 -> d2 -> m d1
onDims [VName]
bound) (forall dim. Shape dim -> [dim]
shapeDims Shape d1
shape1) (forall dim. Shape dim -> [dim]
shapeDims Shape d2
shape2)

-- | Set the uniqueness attribute of a type.  If the type is a record
-- or sum type, the uniqueness of its components will be modified.
setUniqueness :: TypeBase dim u1 -> u2 -> TypeBase dim u2
setUniqueness :: forall dim u1 u2. TypeBase dim u1 -> u2 -> TypeBase dim u2
setUniqueness TypeBase dim u1
t u2
u = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const u2
u) TypeBase dim u1
t

intValueType :: IntValue -> IntType
intValueType :: IntValue -> IntType
intValueType Int8Value {} = IntType
Int8
intValueType Int16Value {} = IntType
Int16
intValueType Int32Value {} = IntType
Int32
intValueType Int64Value {} = IntType
Int64

floatValueType :: FloatValue -> FloatType
floatValueType :: FloatValue -> FloatType
floatValueType Float16Value {} = FloatType
Float16
floatValueType Float32Value {} = FloatType
Float32
floatValueType Float64Value {} = FloatType
Float64

-- | The type of a basic value.
primValueType :: PrimValue -> PrimType
primValueType :: PrimValue -> PrimType
primValueType (SignedValue IntValue
v) = IntType -> PrimType
Signed forall a b. (a -> b) -> a -> b
$ IntValue -> IntType
intValueType IntValue
v
primValueType (UnsignedValue IntValue
v) = IntType -> PrimType
Unsigned forall a b. (a -> b) -> a -> b
$ IntValue -> IntType
intValueType IntValue
v
primValueType (FloatValue FloatValue
v) = FloatType -> PrimType
FloatType forall a b. (a -> b) -> a -> b
$ FloatValue -> FloatType
floatValueType FloatValue
v
primValueType BoolValue {} = PrimType
Bool

-- | The type of an Futhark term.  The aliasing will refer to itself, if
-- the term is a non-tuple-typed variable.
typeOf :: ExpBase Info VName -> StructType
typeOf :: ExpBase Info VName -> StructType
typeOf (Literal PrimValue
val SrcLoc
_) = forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimType
primValueType PrimValue
val
typeOf (IntLit Integer
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (FloatLit Double
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Parens ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (QualParens (QualName VName, SrcLoc)
_ ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (TupLit [ExpBase Info VName]
es SrcLoc
_) = forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ExpBase Info VName -> StructType
typeOf [ExpBase Info VName]
es
typeOf (RecordLit [FieldBase Info VName]
fs SrcLoc
_) =
  forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FieldBase Info VName -> (Name, StructType)
record [FieldBase Info VName]
fs
  where
    record :: FieldBase Info VName -> (Name, StructType)
record (RecordFieldExplicit Name
name ExpBase Info VName
e SrcLoc
_) = (Name
name, ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e)
    record (RecordFieldImplicit VName
name (Info StructType
t) SrcLoc
_) = (VName -> Name
baseName VName
name, StructType
t)
typeOf (ArrayLit [ExpBase Info VName]
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (StringLit [Word8]
vs SrcLoc
loc) =
  forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array
    forall a. Monoid a => a
mempty
    (forall dim. [dim] -> Shape dim
Shape [Integer -> SrcLoc -> ExpBase Info VName
sizeFromInteger (forall i a. Num i => [a] -> i
genericLength [Word8]
vs) SrcLoc
loc])
    (forall dim u. PrimType -> ScalarTypeBase dim u
Prim (IntType -> PrimType
Unsigned IntType
Int8))
typeOf (Project Name
_ ExpBase Info VName
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Var QualName VName
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Hole (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Ascript ExpBase Info VName
e TypeExp Info VName
_ SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (Coerce ExpBase Info VName
_ TypeExp Info VName
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Negate ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (Not ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (Update ExpBase Info VName
e SliceBase Info VName
_ ExpBase Info VName
_ SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (RecordUpdate ExpBase Info VName
_ [Name]
_ ExpBase Info VName
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Assert ExpBase Info VName
_ ExpBase Info VName
e Info Text
_ SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (Lambda [PatBase Info VName ParamType]
params ExpBase Info VName
_ Maybe (TypeExp Info VName)
_ (Info ResRetType
t) SrcLoc
_) = [PatBase Info VName ParamType] -> ResRetType -> StructType
funType [PatBase Info VName ParamType]
params ResRetType
t
typeOf (OpSection QualName VName
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (OpSectionLeft QualName VName
_ Info StructType
_ ExpBase Info VName
_ (Info (PName, ParamType, Maybe VName)
_, Info (PName
pn, ParamType
pt2)) (Info ResRetType
ret, Info [VName]
_) SrcLoc
_) =
  forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow forall a. Monoid a => a
mempty PName
pn (forall shape. TypeBase shape Diet -> Diet
diet ParamType
pt2) (forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct ParamType
pt2) ResRetType
ret
typeOf (OpSectionRight QualName VName
_ Info StructType
_ ExpBase Info VName
_ (Info (PName
pn, ParamType
pt1), Info (PName, ParamType, Maybe VName)
_) (Info ResRetType
ret) SrcLoc
_) =
  forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow forall a. Monoid a => a
mempty PName
pn (forall shape. TypeBase shape Diet -> Diet
diet ParamType
pt1) (forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct ParamType
pt1) ResRetType
ret
typeOf (ProjectSection [Name]
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (IndexSection SliceBase Info VName
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Constr Name
_ [ExpBase Info VName]
_ (Info StructType
t) SrcLoc
_) = StructType
t
typeOf (Attr AttrInfo VName
_ ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> StructType
typeOf ExpBase Info VName
e
typeOf (AppExp AppExpBase Info VName
_ (Info AppRes
res)) = AppRes -> StructType
appResType AppRes
res

-- | The type of a function with the given parameters and return type.
funType :: [Pat ParamType] -> ResRetType -> StructType
funType :: [PatBase Info VName ParamType] -> ResRetType -> StructType
funType [PatBase Info VName ParamType]
params ResRetType
ret =
  let RetType [VName]
_ ResType
t = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {dim}.
(PName, Diet, TypeBase dim NoUniqueness)
-> RetTypeBase dim Uniqueness -> RetTypeBase dim Uniqueness
arrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatBase Info VName ParamType -> (PName, Diet, StructType)
patternParam) ResRetType
ret [PatBase Info VName ParamType]
params
   in forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct ResType
t
  where
    arrow :: (PName, Diet, TypeBase dim NoUniqueness)
-> RetTypeBase dim Uniqueness -> RetTypeBase dim Uniqueness
arrow (PName
xp, Diet
d, TypeBase dim NoUniqueness
xt) RetTypeBase dim Uniqueness
yt =
      forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow Uniqueness
Nonunique PName
xp Diet
d TypeBase dim NoUniqueness
xt RetTypeBase dim Uniqueness
yt

-- | @foldFunType ts ret@ creates a function type ('Arrow') that takes
-- @ts@ as parameters and returns @ret@.
foldFunType :: [ParamType] -> ResRetType -> StructType
foldFunType :: [ParamType] -> ResRetType -> StructType
foldFunType [ParamType]
ps ResRetType
ret =
  let RetType [VName]
_ ResType
t = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {dim}.
TypeBase dim Diet
-> RetTypeBase dim Uniqueness -> RetTypeBase dim Uniqueness
arrow ResRetType
ret [ParamType]
ps
   in forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct ResType
t
  where
    arrow :: TypeBase dim Diet
-> RetTypeBase dim Uniqueness -> RetTypeBase dim Uniqueness
arrow TypeBase dim Diet
t1 RetTypeBase dim Uniqueness
t2 =
      forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow Uniqueness
Nonunique PName
Unnamed (forall shape. TypeBase shape Diet -> Diet
diet TypeBase dim Diet
t1) (forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct TypeBase dim Diet
t1) RetTypeBase dim Uniqueness
t2

-- | Extract the parameter types and return type from a type.
-- If the type is not an arrow type, the list of parameter types is empty.
unfoldFunType :: TypeBase dim as -> ([TypeBase dim Diet], TypeBase dim NoUniqueness)
unfoldFunType :: forall dim as.
TypeBase dim as -> ([TypeBase dim Diet], TypeBase dim NoUniqueness)
unfoldFunType (Scalar (Arrow as
_ PName
_ Diet
d TypeBase dim NoUniqueness
t1 (RetType [VName]
_ TypeBase dim Uniqueness
t2))) =
  let ([TypeBase dim Diet]
ps, TypeBase dim NoUniqueness
r) = forall dim as.
TypeBase dim as -> ([TypeBase dim Diet], TypeBase dim NoUniqueness)
unfoldFunType TypeBase dim Uniqueness
t2
   in (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const Diet
d) TypeBase dim NoUniqueness
t1 forall a. a -> [a] -> [a]
: [TypeBase dim Diet]
ps, TypeBase dim NoUniqueness
r)
unfoldFunType TypeBase dim as
t = ([], forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct TypeBase dim as
t)

-- | The type scheme of a value binding, comprising the type
-- parameters and the actual type.
valBindTypeScheme :: ValBindBase Info VName -> ([TypeParamBase VName], StructType)
valBindTypeScheme :: ValBindBase Info VName -> ([TypeParamBase VName], StructType)
valBindTypeScheme ValBindBase Info VName
vb =
  ( forall (f :: * -> *) vn. ValBindBase f vn -> [TypeParamBase vn]
valBindTypeParams ValBindBase Info VName
vb,
    [PatBase Info VName ParamType] -> ResRetType -> StructType
funType (forall (f :: * -> *) vn.
ValBindBase f vn -> [PatBase f vn ParamType]
valBindParams ValBindBase Info VName
vb) (forall a. Info a -> a
unInfo (forall (f :: * -> *) vn. ValBindBase f vn -> f ResRetType
valBindRetType ValBindBase Info VName
vb))
  )

-- | The names that are brought into scope by this value binding (not
-- including its own parameter names, but including any existential
-- sizes).
valBindBound :: ValBindBase Info VName -> [VName]
valBindBound :: ValBindBase Info VName -> [VName]
valBindBound ValBindBase Info VName
vb =
  forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName ValBindBase Info VName
vb
    forall a. a -> [a] -> [a]
: case forall (f :: * -> *) vn.
ValBindBase f vn -> [PatBase f vn ParamType]
valBindParams ValBindBase Info VName
vb of
      [] -> forall dim as. RetTypeBase dim as -> [VName]
retDims (forall a. Info a -> a
unInfo (forall (f :: * -> *) vn. ValBindBase f vn -> f ResRetType
valBindRetType ValBindBase Info VName
vb))
      [PatBase Info VName ParamType]
_ -> []

-- | The type names mentioned in a type.
typeVars :: TypeBase dim as -> S.Set VName
typeVars :: forall dim as. TypeBase dim as -> Set VName
typeVars TypeBase dim as
t =
  case TypeBase dim as
t of
    Scalar Prim {} -> forall a. Monoid a => a
mempty
    Scalar (TypeVar as
_ QualName VName
tn [TypeArg dim]
targs) ->
      forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
S.singleton (forall vn. QualName vn -> vn
qualLeaf QualName VName
tn) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {dim}. TypeArg dim -> Set VName
typeArgFree [TypeArg dim]
targs
    Scalar (Arrow as
_ PName
_ Diet
_ TypeBase dim NoUniqueness
t1 (RetType [VName]
_ TypeBase dim Uniqueness
t2)) -> forall dim as. TypeBase dim as -> Set VName
typeVars TypeBase dim NoUniqueness
t1 forall a. Semigroup a => a -> a -> a
<> forall dim as. TypeBase dim as -> Set VName
typeVars TypeBase dim Uniqueness
t2
    Scalar (Record Map Name (TypeBase dim as)
fields) -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall dim as. TypeBase dim as -> Set VName
typeVars Map Name (TypeBase dim as)
fields
    Scalar (Sum Map Name [TypeBase dim as]
cs) -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall dim as. TypeBase dim as -> Set VName
typeVars Map Name [TypeBase dim as]
cs
    Array as
_ Shape dim
_ ScalarTypeBase dim NoUniqueness
rt -> forall dim as. TypeBase dim as -> Set VName
typeVars forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar ScalarTypeBase dim NoUniqueness
rt
  where
    typeArgFree :: TypeArg dim -> Set VName
typeArgFree (TypeArgType TypeBase dim NoUniqueness
ta) = forall dim as. TypeBase dim as -> Set VName
typeVars TypeBase dim NoUniqueness
ta
    typeArgFree TypeArgDim {} = forall a. Monoid a => a
mempty

-- | @orderZero t@ is 'True' if the argument type has order 0, i.e., it is not
-- a function type, does not contain a function type as a subcomponent, and may
-- not be instantiated with a function type.
orderZero :: TypeBase dim as -> Bool
orderZero :: forall dim as. TypeBase dim as -> Bool
orderZero Array {} = Bool
True
orderZero (Scalar (Prim PrimType
_)) = Bool
True
orderZero (Scalar (Record Map Name (TypeBase dim as)
fs)) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall dim as. TypeBase dim as -> Bool
orderZero forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map Name (TypeBase dim as)
fs
orderZero (Scalar TypeVar {}) = Bool
True
orderZero (Scalar Arrow {}) = Bool
False
orderZero (Scalar (Sum Map Name [TypeBase dim as]
cs)) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall dim as. TypeBase dim as -> Bool
orderZero) Map Name [TypeBase dim as]
cs

-- | @patternOrderZero pat@ is 'True' if all of the types in the given pattern
-- have order 0.
patternOrderZero :: Pat (TypeBase d u) -> Bool
patternOrderZero :: forall d u. Pat (TypeBase d u) -> Bool
patternOrderZero = forall dim as. TypeBase dim as -> Bool
orderZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType

-- | The set of identifiers bound in a pattern.
patIdents :: Pat t -> [Ident t]
patIdents :: forall t. Pat t -> [Ident t]
patIdents (Id VName
v Info t
t SrcLoc
loc) = [forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
v Info t
t SrcLoc
loc]
patIdents (PatParens PatBase Info VName t
p SrcLoc
_) = forall t. Pat t -> [Ident t]
patIdents PatBase Info VName t
p
patIdents (TuplePat [PatBase Info VName t]
pats SrcLoc
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall t. Pat t -> [Ident t]
patIdents [PatBase Info VName t]
pats
patIdents (RecordPat [(Name, PatBase Info VName t)]
fs SrcLoc
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall t. Pat t -> [Ident t]
patIdents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, PatBase Info VName t)]
fs
patIdents Wildcard {} = forall a. Monoid a => a
mempty
patIdents (PatAscription PatBase Info VName t
p TypeExp Info VName
_ SrcLoc
_) = forall t. Pat t -> [Ident t]
patIdents PatBase Info VName t
p
patIdents PatLit {} = forall a. Monoid a => a
mempty
patIdents (PatConstr Name
_ Info t
_ [PatBase Info VName t]
ps SrcLoc
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall t. Pat t -> [Ident t]
patIdents [PatBase Info VName t]
ps
patIdents (PatAttr AttrInfo VName
_ PatBase Info VName t
p SrcLoc
_) = forall t. Pat t -> [Ident t]
patIdents PatBase Info VName t
p

-- | The set of names bound in a pattern.
patNames :: Pat t -> [VName]
patNames :: forall t. Pat t -> [VName]
patNames = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Pat t -> [(VName, t)]
patternMap

-- | Each name bound in a pattern alongside its type.
patternMap :: Pat t -> [(VName, t)]
patternMap :: forall t. Pat t -> [(VName, t)]
patternMap = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. IdentBase Info a b -> (a, b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Pat t -> [Ident t]
patIdents
  where
    f :: IdentBase Info a b -> (a, b)
f (Ident a
v (Info b
t) SrcLoc
_) = (a
v, b
t)

-- | The type of values bound by the pattern.
patternType :: Pat (TypeBase d u) -> TypeBase d u
patternType :: forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType (Wildcard (Info TypeBase d u
t) SrcLoc
_) = TypeBase d u
t
patternType (PatParens PatBase Info VName (TypeBase d u)
p SrcLoc
_) = forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType PatBase Info VName (TypeBase d u)
p
patternType (Id VName
_ (Info TypeBase d u
t) SrcLoc
_) = TypeBase d u
t
patternType (TuplePat [PatBase Info VName (TypeBase d u)]
pats SrcLoc
_) = forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType [PatBase Info VName (TypeBase d u)]
pats
patternType (RecordPat [(Name, PatBase Info VName (TypeBase d u))]
fs SrcLoc
_) = forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record forall a b. (a -> b) -> a -> b
$ forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, PatBase Info VName (TypeBase d u))]
fs
patternType (PatAscription PatBase Info VName (TypeBase d u)
p TypeExp Info VName
_ SrcLoc
_) = forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType PatBase Info VName (TypeBase d u)
p
patternType (PatLit PatLit
_ (Info TypeBase d u
t) SrcLoc
_) = TypeBase d u
t
patternType (PatConstr Name
_ (Info TypeBase d u
t) [PatBase Info VName (TypeBase d u)]
_ SrcLoc
_) = TypeBase d u
t
patternType (PatAttr AttrInfo VName
_ PatBase Info VName (TypeBase d u)
p SrcLoc
_) = forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType PatBase Info VName (TypeBase d u)
p

-- | The type matched by the pattern, including shape declarations if present.
patternStructType :: Pat (TypeBase Size u) -> StructType
patternStructType :: forall u. Pat (TypeBase (ExpBase Info VName) u) -> StructType
patternStructType = forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType

-- | When viewed as a function parameter, does this pattern correspond
-- to a named parameter of some type?
patternParam :: Pat ParamType -> (PName, Diet, StructType)
patternParam :: PatBase Info VName ParamType -> (PName, Diet, StructType)
patternParam (PatParens PatBase Info VName ParamType
p SrcLoc
_) =
  PatBase Info VName ParamType -> (PName, Diet, StructType)
patternParam PatBase Info VName ParamType
p
patternParam (PatAttr AttrInfo VName
_ PatBase Info VName ParamType
p SrcLoc
_) =
  PatBase Info VName ParamType -> (PName, Diet, StructType)
patternParam PatBase Info VName ParamType
p
patternParam (PatAscription (Id VName
v (Info ParamType
t) SrcLoc
_) TypeExp Info VName
_ SrcLoc
_) =
  (VName -> PName
Named VName
v, forall shape. TypeBase shape Diet -> Diet
diet ParamType
t, forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct ParamType
t)
patternParam (Id VName
v (Info ParamType
t) SrcLoc
_) =
  (VName -> PName
Named VName
v, forall shape. TypeBase shape Diet -> Diet
diet ParamType
t, forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct ParamType
t)
patternParam PatBase Info VName ParamType
p =
  (PName
Unnamed, forall shape. TypeBase shape Diet -> Diet
diet ParamType
p_t, forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct ParamType
p_t)
  where
    p_t :: ParamType
p_t = forall d u. Pat (TypeBase d u) -> TypeBase d u
patternType PatBase Info VName ParamType
p

-- | Names of primitive types to types.  This is only valid if no
-- shadowing is going on, but useful for tools.
namesToPrimTypes :: M.Map Name PrimType
namesToPrimTypes :: Map Name PrimType
namesToPrimTypes =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (FilePath -> Name
nameFromString forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyString PrimType
t, PrimType
t)
      | PrimType
t <-
          PrimType
Bool
            forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Signed [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
            forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Unsigned [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
            forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FloatType -> PrimType
FloatType [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
    ]

-- | The nature of something predefined.  For functions, these can
-- either be monomorphic or overloaded.  An overloaded builtin is a
-- list valid types it can be instantiated with, to the parameter and
-- result type, with 'Nothing' representing the overloaded parameter
-- type.
data Intrinsic
  = IntrinsicMonoFun [PrimType] PrimType
  | IntrinsicOverloadedFun [PrimType] [Maybe PrimType] (Maybe PrimType)
  | IntrinsicPolyFun [TypeParamBase VName] [ParamType] (RetTypeBase Size Uniqueness)
  | IntrinsicType Liftedness [TypeParamBase VName] StructType
  | IntrinsicEquality -- Special cased.

intrinsicAcc :: (VName, Intrinsic)
intrinsicAcc :: (VName, Intrinsic)
intrinsicAcc =
  ( VName
acc_v,
    Liftedness -> [TypeParamBase VName] -> StructType -> Intrinsic
IntrinsicType Liftedness
SizeLifted [forall vn. Liftedness -> vn -> SrcLoc -> TypeParamBase vn
TypeParamType Liftedness
Unlifted VName
t_v forall a. Monoid a => a
mempty] forall a b. (a -> b) -> a -> b
$
      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$
        forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar forall a. Monoid a => a
mempty (forall v. v -> QualName v
qualName VName
acc_v) [forall {dim}. TypeArg dim
arg]
  )
  where
    acc_v :: VName
acc_v = Name -> Int -> VName
VName Name
"acc" Int
10
    t_v :: VName
t_v = Name -> Int -> VName
VName Name
"t" Int
11
    arg :: TypeArg dim
arg = forall dim. TypeBase dim NoUniqueness -> TypeArg dim
TypeArgType forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar forall a. Monoid a => a
mempty (forall v. v -> QualName v
qualName VName
t_v) [])

-- | If this type corresponds to the builtin "acc" type, return the
-- type of the underlying array.
isAccType :: TypeBase d u -> Maybe (TypeBase d NoUniqueness)
isAccType :: forall d u. TypeBase d u -> Maybe (TypeBase d NoUniqueness)
isAccType (Scalar (TypeVar u
_ (QualName [] VName
v) [TypeArgType TypeBase d NoUniqueness
t]))
  | VName
v forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (VName, Intrinsic)
intrinsicAcc =
      forall a. a -> Maybe a
Just TypeBase d NoUniqueness
t
isAccType TypeBase d u
_ = forall a. Maybe a
Nothing

-- | Find the 'VName' corresponding to a builtin.  Crashes if that
-- name cannot be found.
intrinsicVar :: Name -> VName
intrinsicVar :: Name -> VName
intrinsicVar Name
v =
  forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
bad forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Name
v ==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Name
baseName) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map VName Intrinsic
intrinsics
  where
    bad :: a
bad = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"findBuiltin: " forall a. Semigroup a => a -> a -> a
<> Name -> FilePath
nameToString Name
v

mkBinOp :: Name -> StructType -> Exp -> Exp -> Exp
mkBinOp :: Name
-> StructType
-> ExpBase Info VName
-> ExpBase Info VName
-> ExpBase Info VName
mkBinOp Name
op StructType
t ExpBase Info VName
x ExpBase Info VName
y =
  forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp
    ( forall (f :: * -> *) vn.
(QualName vn, SrcLoc)
-> f StructType
-> (ExpBase f vn, f (Maybe VName))
-> (ExpBase f vn, f (Maybe VName))
-> SrcLoc
-> AppExpBase f vn
BinOp
        (forall v. v -> QualName v
qualName (Name -> VName
intrinsicVar Name
op), forall a. Monoid a => a
mempty)
        (forall a. a -> Info a
Info StructType
t)
        (ExpBase Info VName
x, forall a. a -> Info a
Info forall a. Maybe a
Nothing)
        (ExpBase Info VName
y, forall a. a -> Info a
Info forall a. Maybe a
Nothing)
        forall a. Monoid a => a
mempty
    )
    (forall a. a -> Info a
Info forall a b. (a -> b) -> a -> b
$ StructType -> [VName] -> AppRes
AppRes StructType
t [])

mkAdd, mkMul :: Exp -> Exp -> Exp
mkAdd :: ExpBase Info VName -> ExpBase Info VName -> ExpBase Info VName
mkAdd = Name
-> StructType
-> ExpBase Info VName
-> ExpBase Info VName
-> ExpBase Info VName
mkBinOp Name
"+" forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64
mkMul :: ExpBase Info VName -> ExpBase Info VName -> ExpBase Info VName
mkMul = Name
-> StructType
-> ExpBase Info VName
-> ExpBase Info VName
-> ExpBase Info VName
mkBinOp Name
"*" forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64

-- | A map of all built-ins.
intrinsics :: M.Map VName Intrinsic
intrinsics :: Map VName Intrinsic
intrinsics =
  (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(VName, Intrinsic)
intrinsicAcc] <>) forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
      [(VName, Intrinsic)]
primOp
        forall a. [a] -> [a] -> [a]
++ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          forall {b}. Int -> (FilePath, b) -> (VName, b)
namify
          [Int
intrinsicStart ..]
          ( [ ( FilePath
"flatten",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m]
                  [forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n, VName
m]) forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array
                    Uniqueness
Nonunique
                    (forall dim. [dim] -> Shape dim
Shape [VName -> ExpBase Info VName
size VName
n ExpBase Info VName -> ExpBase Info VName -> ExpBase Info VName
`mkMul` VName -> ExpBase Info VName
size VName
m])
                    (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty)
              ),
              ( FilePath
"unflatten",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64,
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64,
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe (forall dim. [dim] -> Shape dim
Shape [VName -> ExpBase Info VName
size VName
n ExpBase Info VName -> ExpBase Info VName -> ExpBase Info VName
`mkMul` VName -> ExpBase Info VName
size VName
m]) forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Uniqueness
Nonunique ([VName] -> Shape (ExpBase Info VName)
shape [VName
n, VName
m]) (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty)
              ),
              ( FilePath
"concat",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m]
                  [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m]
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ forall dim. [dim] -> Shape dim
Shape [VName -> ExpBase Info VName
size VName
n ExpBase Info VName -> ExpBase Info VName -> ExpBase Info VName
`mkAdd` VName -> ExpBase Info VName
size VName
m]
              ),
              ( FilePath
"transpose",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m]
                  [forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n, VName
m]]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Nonunique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
n]
              ),
              ( FilePath
"scatter",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_l]
                  [ forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Consume ([VName] -> Shape (ExpBase Info VName)
shape [VName
n]) forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty,
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
l]) (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
l]) forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Uniqueness
Unique ([VName] -> Shape (ExpBase Info VName)
shape [VName
n]) (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty)
              ),
              ( FilePath
"scatter_2d",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m, TypeParamBase VName
sp_l]
                  [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n, VName
m],
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
l]) (forall {dim} {u}. Int -> ScalarTypeBase dim u
tupInt64 Int
2),
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
l]) forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n, VName
m]
              ),
              ( FilePath
"scatter_3d",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m, TypeParamBase VName
sp_k, TypeParamBase VName
sp_l]
                  [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n, VName
m, VName
k],
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
l]) (forall {dim} {u}. Int -> ScalarTypeBase dim u
tupInt64 Int
3),
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
l]) forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n, VName
m, VName
k]
              ),
              ( FilePath
"zip",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
tp_b, TypeParamBase VName
sp_n]
                  [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n]),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_b Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n])
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}.
u
-> TypeBase dim NoUniqueness
-> TypeBase dim NoUniqueness
-> Shape dim
-> TypeBase dim u
tuple_array Uniqueness
Unique (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_b forall a. Monoid a => a
mempty)
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
              ),
              ( FilePath
"unzip",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
tp_b, TypeParamBase VName
sp_n]
                  [forall {u} {dim}.
u
-> TypeBase dim NoUniqueness
-> TypeBase dim NoUniqueness
-> Shape dim
-> TypeBase dim u
tuple_array Diet
Observe (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_b forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                  forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
tupleFieldNames [forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n], forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_b Uniqueness
Unique forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]]
              ),
              ( FilePath
"hist_1d",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64,
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m],
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique)),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe,
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n]) (forall {dim} {u}. Int -> ScalarTypeBase dim u
tupInt64 Int
1),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n])
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m]
              ),
              ( FilePath
"hist_2d",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m, TypeParamBase VName
sp_k]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64,
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
k],
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique)),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe,
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n]) (forall {dim} {u}. Int -> ScalarTypeBase dim u
tupInt64 Int
2),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n])
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
k]
              ),
              ( FilePath
"hist_3d",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_m, TypeParamBase VName
sp_k, TypeParamBase VName
sp_l]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64,
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
k, VName
l],
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique)),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe,
                    forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n]) (forall {dim} {u}. Int -> ScalarTypeBase dim u
tupInt64 Int
3),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe ([VName] -> Shape (ExpBase Info VName)
shape [VName
n])
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
k, VName
l]
              ),
              ( FilePath
"map",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
tp_b, TypeParamBase VName
sp_n]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_b Uniqueness
Nonunique),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_b Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
              ),
              ( FilePath
"reduce",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique)),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe,
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Unique)
              ),
              ( FilePath
"reduce_comm",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique)),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe,
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Unique))
              ),
              ( FilePath
"scan",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique)),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe,
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] (forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n])
              ),
              ( FilePath
"partition",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int32),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                  ]
                  ( forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName
k] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$
                      forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord
                        [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                          forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array Uniqueness
Unique ([VName] -> Shape (ExpBase Info VName)
shape [VName
k]) (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64)
                        ]
                  )
              ),
              ( FilePath
"acc_write",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
sp_k, TypeParamBase VName
tp_a]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}.
u -> TypeBase dim NoUniqueness -> ScalarTypeBase dim u
accType Diet
Consume forall a b. (a -> b) -> a -> b
$ forall {u}. u -> TypeBase (ExpBase Info VName) u
array_ka forall a. Monoid a => a
mempty,
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}.
u -> TypeBase dim NoUniqueness -> ScalarTypeBase dim u
accType Uniqueness
Unique (forall {u}. u -> TypeBase (ExpBase Info VName) u
array_ka forall a. Monoid a => a
mempty)
              ),
              ( FilePath
"scatter_stream",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
tp_b, TypeParamBase VName
sp_k, TypeParamBase VName
sp_n]
                  [ forall {u}. u -> TypeBase (ExpBase Info VName) u
array_ka Diet
Consume,
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}.
u -> TypeBase dim NoUniqueness -> ScalarTypeBase dim u
accType forall a. Monoid a => a
mempty (forall {u}. u -> TypeBase (ExpBase Info VName) u
array_ka forall a. Monoid a => a
mempty))
                      forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`carr` ( forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_b forall a. Monoid a => a
mempty)
                                 forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}.
u -> TypeBase dim NoUniqueness -> ScalarTypeBase dim u
accType Uniqueness
Nonunique forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
k])
                             ),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_b Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u}. u -> TypeBase (ExpBase Info VName) u
array_ka Uniqueness
Unique
              ),
              ( FilePath
"hist_stream",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
tp_b, TypeParamBase VName
sp_k, TypeParamBase VName
sp_n]
                  [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
k],
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique)),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe,
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}.
u -> TypeBase dim NoUniqueness -> ScalarTypeBase dim u
accType forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall {u}. u -> TypeBase (ExpBase Info VName) u
array_ka forall a. Monoid a => a
mempty)
                      forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`carr` ( forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_b forall a. Monoid a => a
mempty)
                                 forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}.
u -> TypeBase dim NoUniqueness -> ScalarTypeBase dim u
accType Uniqueness
Nonunique forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
k])
                             ),
                    forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_b Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                  forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
k]
              ),
              ( FilePath
"jvp2",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
tp_b]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_b Uniqueness
Nonunique),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe)
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord [forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_b Uniqueness
Nonunique, forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_b Uniqueness
Nonunique]
              ),
              ( FilePath
"vjp2",
                [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                  [TypeParamBase VName
tp_a, TypeParamBase VName
tp_b]
                  [ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty) forall {u} {dim}.
Monoid u =>
TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
`arr` forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_b Uniqueness
Nonunique),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Diet
Observe),
                    forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall {u} {dim}. u -> ScalarTypeBase dim u
t_b Diet
Observe)
                  ]
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                  forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar
                  forall a b. (a -> b) -> a -> b
$ forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord [forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_b Uniqueness
Nonunique, forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a Uniqueness
Nonunique]
              )
            ]
              forall a. [a] -> [a] -> [a]
++
              -- Experimental LMAD ones.
              [ ( FilePath
"flat_index_2d",
                  [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                    [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n]
                    [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64)
                    ]
                    forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName
m, VName
k]
                    forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Nonunique
                    forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
k]
                ),
                ( FilePath
"flat_update_2d",
                  [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                    [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_k, TypeParamBase VName
sp_l]
                    [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
k, VName
l]
                    ]
                    forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                    forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                    forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                ),
                ( FilePath
"flat_index_3d",
                  [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                    [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n]
                    [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64)
                    ]
                    forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName
m, VName
k, VName
l]
                    forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Nonunique
                    forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
k, VName
l]
                ),
                ( FilePath
"flat_update_3d",
                  [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                    [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_k, TypeParamBase VName
sp_l, TypeParamBase VName
sp_p]
                    [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
k, VName
l, VName
p]
                    ]
                    forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                    forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                    forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                ),
                ( FilePath
"flat_index_4d",
                  [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                    [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n]
                    [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64)
                    ]
                    forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName
m, VName
k, VName
l, VName
p]
                    forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Nonunique
                    forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
m, VName
k, VName
l, VName
p]
                ),
                ( FilePath
"flat_update_4d",
                  [TypeParamBase VName] -> [ParamType] -> ResRetType -> Intrinsic
IntrinsicPolyFun
                    [TypeParamBase VName
tp_a, TypeParamBase VName
sp_n, TypeParamBase VName
sp_k, TypeParamBase VName
sp_l, TypeParamBase VName
sp_p, TypeParamBase VName
sp_q]
                    [ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Consume forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n],
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64),
                      forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Diet
Observe forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
k, VName
l, VName
p, VName
q]
                    ]
                    forall a b. (a -> b) -> a -> b
$ forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType []
                    forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> Shape dim -> TypeBase dim u
array_a Uniqueness
Unique
                    forall a b. (a -> b) -> a -> b
$ [VName] -> Shape (ExpBase Info VName)
shape [VName
n]
                )
              ]
          )
  where
    primOp :: [(VName, Intrinsic)]
primOp =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b}. Int -> (FilePath, b) -> (VName, b)
namify [Int
20 ..] forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map forall {a} {c}. (a, ([PrimType], PrimType, c)) -> (a, Intrinsic)
primFun (forall k a. Map k a -> [(k, a)]
M.toList Map FilePath ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
Primitive.primFuns)
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map UnOp -> (FilePath, Intrinsic)
unOpFun [UnOp]
Primitive.allUnOps
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map BinOp -> (FilePath, Intrinsic)
binOpFun [BinOp]
Primitive.allBinOps
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map CmpOp -> (FilePath, Intrinsic)
cmpOpFun [CmpOp]
Primitive.allCmpOps
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ConvOp -> (FilePath, Intrinsic)
convOpFun [ConvOp]
Primitive.allConvOps
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map IntType -> (FilePath, Intrinsic)
signFun [IntType]
Primitive.allIntTypes
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map IntType -> (FilePath, Intrinsic)
unsignFun [IntType]
Primitive.allIntTypes
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map
            PrimType -> (FilePath, Intrinsic)
intrinsicPrim
            ( forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Signed [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Unsigned [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FloatType -> PrimType
FloatType [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
                forall a. [a] -> [a] -> [a]
++ [PrimType
Bool]
            )
          forall a. [a] -> [a] -> [a]
++
          -- This overrides the ! from Primitive.

          -- This overrides the ! from Primitive.
          [ ( FilePath
"!",
              [PrimType] -> [Maybe PrimType] -> Maybe PrimType -> Intrinsic
IntrinsicOverloadedFun
                ( forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Signed [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
                    forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Unsigned [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
                    forall a. [a] -> [a] -> [a]
++ [PrimType
Bool]
                )
                [forall a. Maybe a
Nothing]
                forall a. Maybe a
Nothing
            )
          ]
          forall a. [a] -> [a] -> [a]
++
          -- The reason for the loop formulation is to ensure that we
          -- get a missing case warning if we forget a case.
          forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinOp -> Maybe (FilePath, Intrinsic)
mkIntrinsicBinOp [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

    intrinsicStart :: Int
intrinsicStart = Int
1 forall a. Num a => a -> a -> a
+ VName -> Int
baseTag (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [(VName, Intrinsic)]
primOp)

    [VName
a, VName
b, VName
n, VName
m, VName
k, VName
l, VName
p, VName
q] = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Name -> Int -> VName
VName (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Name
nameFromString [FilePath
"a", FilePath
"b", FilePath
"n", FilePath
"m", FilePath
"k", FilePath
"l", FilePath
"p", FilePath
"q"]) [Int
0 ..]

    t_a :: u -> ScalarTypeBase dim u
t_a u
u = forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar u
u (forall v. v -> QualName v
qualName VName
a) []
    array_a :: u -> Shape dim -> TypeBase dim u
array_a u
u Shape dim
s = forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array u
u Shape dim
s forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty
    tp_a :: TypeParamBase VName
tp_a = forall vn. Liftedness -> vn -> SrcLoc -> TypeParamBase vn
TypeParamType Liftedness
Unlifted VName
a forall a. Monoid a => a
mempty

    t_b :: u -> ScalarTypeBase dim u
t_b u
u = forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar u
u (forall v. v -> QualName v
qualName VName
b) []
    array_b :: u -> Shape dim -> TypeBase dim u
array_b u
u Shape dim
s = forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array u
u Shape dim
s forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_b forall a. Monoid a => a
mempty
    tp_b :: TypeParamBase VName
tp_b = forall vn. Liftedness -> vn -> SrcLoc -> TypeParamBase vn
TypeParamType Liftedness
Unlifted VName
b forall a. Monoid a => a
mempty

    [TypeParamBase VName
sp_n, TypeParamBase VName
sp_m, TypeParamBase VName
sp_k, TypeParamBase VName
sp_l, TypeParamBase VName
sp_p, TypeParamBase VName
sp_q] = forall a b. (a -> b) -> [a] -> [b]
map (forall vn. vn -> SrcLoc -> TypeParamBase vn
`TypeParamDim` forall a. Monoid a => a
mempty) [VName
n, VName
m, VName
k, VName
l, VName
p, VName
q]

    size :: VName -> ExpBase Info VName
size = forall a b c. (a -> b -> c) -> b -> a -> c
flip QualName VName -> SrcLoc -> ExpBase Info VName
sizeFromName forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. v -> QualName v
qualName
    shape :: [VName] -> Shape (ExpBase Info VName)
shape = forall dim. [dim] -> Shape dim
Shape forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map VName -> ExpBase Info VName
size

    tuple_array :: u
-> TypeBase dim NoUniqueness
-> TypeBase dim NoUniqueness
-> Shape dim
-> TypeBase dim u
tuple_array u
u TypeBase dim NoUniqueness
x TypeBase dim NoUniqueness
y Shape dim
s =
      forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array u
u Shape dim
s (forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
tupleFieldNames [TypeBase dim NoUniqueness
x, TypeBase dim NoUniqueness
y]))

    arr :: TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
arr TypeBase dim NoUniqueness
x TypeBase dim Uniqueness
y = forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow forall a. Monoid a => a
mempty PName
Unnamed Diet
Observe TypeBase dim NoUniqueness
x (forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] TypeBase dim Uniqueness
y)
    carr :: TypeBase dim NoUniqueness
-> TypeBase dim Uniqueness -> TypeBase dim u
carr TypeBase dim NoUniqueness
x TypeBase dim Uniqueness
y = forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow forall a. Monoid a => a
mempty PName
Unnamed Diet
Consume TypeBase dim NoUniqueness
x (forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] TypeBase dim Uniqueness
y)

    array_ka :: u -> TypeBase (ExpBase Info VName) u
array_ka u
u = forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array u
u (forall dim. [dim] -> Shape dim
Shape [QualName VName -> SrcLoc -> ExpBase Info VName
sizeFromName (forall v. v -> QualName v
qualName VName
k) forall a. Monoid a => a
mempty]) forall a b. (a -> b) -> a -> b
$ forall {u} {dim}. u -> ScalarTypeBase dim u
t_a forall a. Monoid a => a
mempty

    accType :: u -> TypeBase dim NoUniqueness -> ScalarTypeBase dim u
accType u
u TypeBase dim NoUniqueness
t =
      forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar u
u (forall v. v -> QualName v
qualName (forall a b. (a, b) -> a
fst (VName, Intrinsic)
intrinsicAcc)) [forall dim. TypeBase dim NoUniqueness -> TypeArg dim
TypeArgType TypeBase dim NoUniqueness
t]

    namify :: Int -> (FilePath, b) -> (VName, b)
namify Int
i (FilePath
x, b
y) = (Name -> Int -> VName
VName (FilePath -> Name
nameFromString FilePath
x) Int
i, b
y)

    primFun :: (a, ([PrimType], PrimType, c)) -> (a, Intrinsic)
primFun (a
name, ([PrimType]
ts, PrimType
t, c
_)) =
      (a
name, [PrimType] -> PrimType -> Intrinsic
IntrinsicMonoFun (forall a b. (a -> b) -> [a] -> [b]
map PrimType -> PrimType
unPrim [PrimType]
ts) forall a b. (a -> b) -> a -> b
$ PrimType -> PrimType
unPrim PrimType
t)

    unOpFun :: UnOp -> (FilePath, Intrinsic)
unOpFun UnOp
bop = (forall a. Pretty a => a -> FilePath
prettyString UnOp
bop, [PrimType] -> PrimType -> Intrinsic
IntrinsicMonoFun [PrimType
t] PrimType
t)
      where
        t :: PrimType
t = PrimType -> PrimType
unPrim forall a b. (a -> b) -> a -> b
$ UnOp -> PrimType
Primitive.unOpType UnOp
bop

    binOpFun :: BinOp -> (FilePath, Intrinsic)
binOpFun BinOp
bop = (forall a. Pretty a => a -> FilePath
prettyString BinOp
bop, [PrimType] -> PrimType -> Intrinsic
IntrinsicMonoFun [PrimType
t, PrimType
t] PrimType
t)
      where
        t :: PrimType
t = PrimType -> PrimType
unPrim forall a b. (a -> b) -> a -> b
$ BinOp -> PrimType
Primitive.binOpType BinOp
bop

    cmpOpFun :: CmpOp -> (FilePath, Intrinsic)
cmpOpFun CmpOp
bop = (forall a. Pretty a => a -> FilePath
prettyString CmpOp
bop, [PrimType] -> PrimType -> Intrinsic
IntrinsicMonoFun [PrimType
t, PrimType
t] PrimType
Bool)
      where
        t :: PrimType
t = PrimType -> PrimType
unPrim forall a b. (a -> b) -> a -> b
$ CmpOp -> PrimType
Primitive.cmpOpType CmpOp
bop

    convOpFun :: ConvOp -> (FilePath, Intrinsic)
convOpFun ConvOp
cop = (forall a. Pretty a => a -> FilePath
prettyString ConvOp
cop, [PrimType] -> PrimType -> Intrinsic
IntrinsicMonoFun [PrimType -> PrimType
unPrim PrimType
ft] forall a b. (a -> b) -> a -> b
$ PrimType -> PrimType
unPrim PrimType
tt)
      where
        (PrimType
ft, PrimType
tt) = ConvOp -> (PrimType, PrimType)
Primitive.convOpType ConvOp
cop

    signFun :: IntType -> (FilePath, Intrinsic)
signFun IntType
t = (FilePath
"sign_" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyString IntType
t, [PrimType] -> PrimType -> Intrinsic
IntrinsicMonoFun [IntType -> PrimType
Unsigned IntType
t] forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
t)

    unsignFun :: IntType -> (FilePath, Intrinsic)
unsignFun IntType
t = (FilePath
"unsign_" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyString IntType
t, [PrimType] -> PrimType -> Intrinsic
IntrinsicMonoFun [IntType -> PrimType
Signed IntType
t] forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Unsigned IntType
t)

    unPrim :: PrimType -> PrimType
unPrim (Primitive.IntType IntType
t) = IntType -> PrimType
Signed IntType
t
    unPrim (Primitive.FloatType FloatType
t) = FloatType -> PrimType
FloatType FloatType
t
    unPrim PrimType
Primitive.Bool = PrimType
Bool
    unPrim PrimType
Primitive.Unit = PrimType
Bool

    intrinsicPrim :: PrimType -> (FilePath, Intrinsic)
intrinsicPrim PrimType
t = (forall a. Pretty a => a -> FilePath
prettyString PrimType
t, Liftedness -> [TypeParamBase VName] -> StructType -> Intrinsic
IntrinsicType Liftedness
Unlifted [] forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim PrimType
t)

    anyIntType :: [PrimType]
anyIntType =
      forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Signed [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
Unsigned [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
    anyNumberType :: [PrimType]
anyNumberType =
      [PrimType]
anyIntType
        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FloatType -> PrimType
FloatType [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
    anyPrimType :: [PrimType]
anyPrimType = PrimType
Bool forall a. a -> [a] -> [a]
: [PrimType]
anyNumberType

    mkIntrinsicBinOp :: BinOp -> Maybe (String, Intrinsic)
    mkIntrinsicBinOp :: BinOp -> Maybe (FilePath, Intrinsic)
mkIntrinsicBinOp BinOp
op = do
      Intrinsic
op' <- BinOp -> Maybe Intrinsic
intrinsicBinOp BinOp
op
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Pretty a => a -> FilePath
prettyString BinOp
op, Intrinsic
op')

    binOp :: [PrimType] -> Maybe Intrinsic
binOp [PrimType]
ts = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [PrimType] -> [Maybe PrimType] -> Maybe PrimType -> Intrinsic
IntrinsicOverloadedFun [PrimType]
ts [forall a. Maybe a
Nothing, forall a. Maybe a
Nothing] forall a. Maybe a
Nothing
    ordering :: Maybe Intrinsic
ordering = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [PrimType] -> [Maybe PrimType] -> Maybe PrimType -> Intrinsic
IntrinsicOverloadedFun [PrimType]
anyPrimType [forall a. Maybe a
Nothing, forall a. Maybe a
Nothing] (forall a. a -> Maybe a
Just PrimType
Bool)

    intrinsicBinOp :: BinOp -> Maybe Intrinsic
intrinsicBinOp BinOp
Plus = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyNumberType
    intrinsicBinOp BinOp
Minus = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyNumberType
    intrinsicBinOp BinOp
Pow = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyNumberType
    intrinsicBinOp BinOp
Times = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyNumberType
    intrinsicBinOp BinOp
Divide = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyNumberType
    intrinsicBinOp BinOp
Mod = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyNumberType
    intrinsicBinOp BinOp
Quot = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyIntType
    intrinsicBinOp BinOp
Rem = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyIntType
    intrinsicBinOp BinOp
ShiftR = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyIntType
    intrinsicBinOp BinOp
ShiftL = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyIntType
    intrinsicBinOp BinOp
Band = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyIntType
    intrinsicBinOp BinOp
Xor = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyIntType
    intrinsicBinOp BinOp
Bor = [PrimType] -> Maybe Intrinsic
binOp [PrimType]
anyIntType
    intrinsicBinOp BinOp
LogAnd = [PrimType] -> Maybe Intrinsic
binOp [PrimType
Bool]
    intrinsicBinOp BinOp
LogOr = [PrimType] -> Maybe Intrinsic
binOp [PrimType
Bool]
    intrinsicBinOp BinOp
Equal = forall a. a -> Maybe a
Just Intrinsic
IntrinsicEquality
    intrinsicBinOp BinOp
NotEqual = forall a. a -> Maybe a
Just Intrinsic
IntrinsicEquality
    intrinsicBinOp BinOp
Less = Maybe Intrinsic
ordering
    intrinsicBinOp BinOp
Leq = Maybe Intrinsic
ordering
    intrinsicBinOp BinOp
Greater = Maybe Intrinsic
ordering
    intrinsicBinOp BinOp
Geq = Maybe Intrinsic
ordering
    intrinsicBinOp BinOp
_ = forall a. Maybe a
Nothing

    tupInt64 :: Int -> ScalarTypeBase dim u
tupInt64 Int
1 =
      forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64
    tupInt64 Int
x =
      forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
x forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall dim u. PrimType -> ScalarTypeBase dim u
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64

-- | Is this include part of the built-in prelude?
isBuiltin :: FilePath -> Bool
isBuiltin :: FilePath -> Bool
isBuiltin = (forall a. Eq a => a -> a -> Bool
== FilePath
"/prelude") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeDirectory

-- | Is the position of this thing builtin as per 'isBuiltin'?  Things
-- without location are considered not built-in.
isBuiltinLoc :: Located a => a -> Bool
isBuiltinLoc :: forall a. Located a => a -> Bool
isBuiltinLoc a
x =
  case forall a. Located a => a -> Loc
locOf a
x of
    Loc
NoLoc -> Bool
False
    Loc Pos
pos Pos
_ -> FilePath -> Bool
isBuiltin forall a b. (a -> b) -> a -> b
$ Pos -> FilePath
posFile Pos
pos

-- | The largest tag used by an intrinsic - this can be used to
-- determine whether a 'VName' refers to an intrinsic or a user-defined name.
maxIntrinsicTag :: Int
maxIntrinsicTag :: Int
maxIntrinsicTag = forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map VName -> Int
baseTag forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map VName Intrinsic
intrinsics

-- | Create a name with no qualifiers from a name.
qualName :: v -> QualName v
qualName :: forall v. v -> QualName v
qualName = forall vn. [vn] -> vn -> QualName vn
QualName []

-- | Add another qualifier (at the head) to a qualified name.
qualify :: v -> QualName v -> QualName v
qualify :: forall v. v -> QualName v -> QualName v
qualify v
k (QualName [v]
ks v
v) = forall vn. [vn] -> vn -> QualName vn
QualName (v
k forall a. a -> [a] -> [a]
: [v]
ks) v
v

-- | The modules imported by a Futhark program.
progImports :: ProgBase f vn -> [(String, Loc)]
progImports :: forall (f :: * -> *) vn. ProgBase f vn -> [(FilePath, Loc)]
progImports = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (f :: * -> *) vn. DecBase f vn -> [(FilePath, Loc)]
decImports forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs

-- | The modules imported by a single declaration.
decImports :: DecBase f vn -> [(String, Loc)]
decImports :: forall (f :: * -> *) vn. DecBase f vn -> [(FilePath, Loc)]
decImports (OpenDec ModExpBase f vn
x SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [(FilePath, Loc)]
modExpImports ModExpBase f vn
x
decImports (ModDec ModBindBase f vn
md) = forall (f :: * -> *) vn. ModExpBase f vn -> [(FilePath, Loc)]
modExpImports forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp ModBindBase f vn
md
decImports SigDec {} = []
decImports TypeDec {} = []
decImports ValDec {} = []
decImports (LocalDec DecBase f vn
d SrcLoc
_) = forall (f :: * -> *) vn. DecBase f vn -> [(FilePath, Loc)]
decImports DecBase f vn
d
decImports (ImportDec FilePath
x f ImportName
_ SrcLoc
loc) = [(FilePath
x, forall a. Located a => a -> Loc
locOf SrcLoc
loc)]

modExpImports :: ModExpBase f vn -> [(String, Loc)]
modExpImports :: forall (f :: * -> *) vn. ModExpBase f vn -> [(FilePath, Loc)]
modExpImports ModVar {} = []
modExpImports (ModParens ModExpBase f vn
p SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [(FilePath, Loc)]
modExpImports ModExpBase f vn
p
modExpImports (ModImport FilePath
f f ImportName
_ SrcLoc
loc) = [(FilePath
f, forall a. Located a => a -> Loc
locOf SrcLoc
loc)]
modExpImports (ModDecs [DecBase f vn]
ds SrcLoc
_) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (f :: * -> *) vn. DecBase f vn -> [(FilePath, Loc)]
decImports [DecBase f vn]
ds
modExpImports (ModApply ModExpBase f vn
_ ModExpBase f vn
me f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [(FilePath, Loc)]
modExpImports ModExpBase f vn
me
modExpImports (ModAscript ModExpBase f vn
me SigExpBase f vn
_ f (Map VName VName)
_ SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [(FilePath, Loc)]
modExpImports ModExpBase f vn
me
modExpImports ModLambda {} = []

-- | The set of module types used in any exported (non-local)
-- declaration.
progModuleTypes :: ProgBase Info VName -> S.Set VName
progModuleTypes :: ProgBase Info VName -> Set VName
progModuleTypes ProgBase Info VName
prog = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VName -> Set VName
reach Set VName
mtypes_used
  where
    -- Fixed point iteration.
    reach :: VName -> Set VName
reach VName
v = forall a. a -> Set a
S.singleton VName
v forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VName -> Set VName
reach) (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
v Map VName (Set VName)
reachable_from_mtype)

    reachable_from_mtype :: Map VName (Set VName)
reachable_from_mtype = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a} {f :: * -> *}. Ord a => DecBase f a -> Map a (Set a)
onDec forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs ProgBase Info VName
prog
      where
        onDec :: DecBase f a -> Map a (Set a)
onDec OpenDec {} = forall a. Monoid a => a
mempty
        onDec ModDec {} = forall a. Monoid a => a
mempty
        onDec (SigDec SigBindBase f a
sb) =
          forall k a. k -> a -> Map k a
M.singleton (forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBindBase f a
sb) (forall {a} {f :: * -> *}. Ord a => SigExpBase f a -> Set a
onSigExp (forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp SigBindBase f a
sb))
        onDec TypeDec {} = forall a. Monoid a => a
mempty
        onDec ValDec {} = forall a. Monoid a => a
mempty
        onDec (LocalDec DecBase f a
d SrcLoc
_) = DecBase f a -> Map a (Set a)
onDec DecBase f a
d
        onDec ImportDec {} = forall a. Monoid a => a
mempty

        onSigExp :: SigExpBase f a -> Set a
onSigExp (SigVar QualName a
v f (Map VName VName)
_ SrcLoc
_) = forall a. a -> Set a
S.singleton forall a b. (a -> b) -> a -> b
$ forall vn. QualName vn -> vn
qualLeaf QualName a
v
        onSigExp (SigParens SigExpBase f a
e SrcLoc
_) = SigExpBase f a -> Set a
onSigExp SigExpBase f a
e
        onSigExp (SigSpecs [SpecBase f a]
ss SrcLoc
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SpecBase f a -> Set a
onSpec [SpecBase f a]
ss
        onSigExp (SigWith SigExpBase f a
e TypeRefBase f a
_ SrcLoc
_) = SigExpBase f a -> Set a
onSigExp SigExpBase f a
e
        onSigExp (SigArrow Maybe a
_ SigExpBase f a
e1 SigExpBase f a
e2 SrcLoc
_) = SigExpBase f a -> Set a
onSigExp SigExpBase f a
e1 forall a. Semigroup a => a -> a -> a
<> SigExpBase f a -> Set a
onSigExp SigExpBase f a
e2

        onSpec :: SpecBase f a -> Set a
onSpec ValSpec {} = forall a. Monoid a => a
mempty
        onSpec TypeSpec {} = forall a. Monoid a => a
mempty
        onSpec TypeAbbrSpec {} = forall a. Monoid a => a
mempty
        onSpec (ModSpec a
vn SigExpBase f a
e Maybe DocComment
_ SrcLoc
_) = forall a. a -> Set a
S.singleton a
vn forall a. Semigroup a => a -> a -> a
<> SigExpBase f a -> Set a
onSigExp SigExpBase f a
e
        onSpec (IncludeSpec SigExpBase f a
e SrcLoc
_) = SigExpBase f a -> Set a
onSigExp SigExpBase f a
e

    mtypes_used :: Set VName
mtypes_used = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. DecBase f VName -> Set VName
onDec forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs ProgBase Info VName
prog
      where
        onDec :: DecBase f VName -> Set VName
onDec (OpenDec ModExpBase f VName
x SrcLoc
_) = ModExpBase f VName -> Set VName
onModExp ModExpBase f VName
x
        onDec (ModDec ModBindBase f VName
md) =
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall {a} {f :: * -> *}. Ord a => SigExpBase f a -> Set a
onSigExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall (f :: * -> *) vn.
ModBindBase f vn -> Maybe (SigExpBase f vn, f (Map VName VName))
modSignature ModBindBase f VName
md) forall a. Semigroup a => a -> a -> a
<> ModExpBase f VName -> Set VName
onModExp (forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp ModBindBase f VName
md)
        onDec SigDec {} = forall a. Monoid a => a
mempty
        onDec TypeDec {} = forall a. Monoid a => a
mempty
        onDec ValDec {} = forall a. Monoid a => a
mempty
        onDec LocalDec {} = forall a. Monoid a => a
mempty
        onDec ImportDec {} = forall a. Monoid a => a
mempty

        onModExp :: ModExpBase f VName -> Set VName
onModExp ModVar {} = forall a. Monoid a => a
mempty
        onModExp (ModParens ModExpBase f VName
p SrcLoc
_) = ModExpBase f VName -> Set VName
onModExp ModExpBase f VName
p
        onModExp ModImport {} = forall a. Monoid a => a
mempty
        onModExp (ModDecs [DecBase f VName]
ds SrcLoc
_) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DecBase f VName -> Set VName
onDec [DecBase f VName]
ds
        onModExp (ModApply ModExpBase f VName
me1 ModExpBase f VName
me2 f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
_) = ModExpBase f VName -> Set VName
onModExp ModExpBase f VName
me1 forall a. Semigroup a => a -> a -> a
<> ModExpBase f VName -> Set VName
onModExp ModExpBase f VName
me2
        onModExp (ModAscript ModExpBase f VName
me SigExpBase f VName
se f (Map VName VName)
_ SrcLoc
_) = ModExpBase f VName -> Set VName
onModExp ModExpBase f VName
me forall a. Semigroup a => a -> a -> a
<> forall {a} {f :: * -> *}. Ord a => SigExpBase f a -> Set a
onSigExp SigExpBase f VName
se
        onModExp (ModLambda ModParamBase f VName
p Maybe (SigExpBase f VName, f (Map VName VName))
r ModExpBase f VName
me SrcLoc
_) =
          forall {f :: * -> *}. ModParamBase f VName -> Set VName
onModParam ModParamBase f VName
p forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall {a} {f :: * -> *}. Ord a => SigExpBase f a -> Set a
onSigExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (SigExpBase f VName, f (Map VName VName))
r forall a. Semigroup a => a -> a -> a
<> ModExpBase f VName -> Set VName
onModExp ModExpBase f VName
me

        onModParam :: ModParamBase f VName -> Set VName
onModParam = forall {a} {f :: * -> *}. Ord a => SigExpBase f a -> Set a
onSigExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. ModParamBase f vn -> SigExpBase f vn
modParamType

        onSigExp :: SigExpBase f a -> Set a
onSigExp (SigVar QualName a
v f (Map VName VName)
_ SrcLoc
_) = forall a. a -> Set a
S.singleton forall a b. (a -> b) -> a -> b
$ forall vn. QualName vn -> vn
qualLeaf QualName a
v
        onSigExp (SigParens SigExpBase f a
e SrcLoc
_) = SigExpBase f a -> Set a
onSigExp SigExpBase f a
e
        onSigExp SigSpecs {} = forall a. Monoid a => a
mempty
        onSigExp (SigWith SigExpBase f a
e TypeRefBase f a
_ SrcLoc
_) = SigExpBase f a -> Set a
onSigExp SigExpBase f a
e
        onSigExp (SigArrow Maybe a
_ SigExpBase f a
e1 SigExpBase f a
e2 SrcLoc
_) = SigExpBase f a -> Set a
onSigExp SigExpBase f a
e1 forall a. Semigroup a => a -> a -> a
<> SigExpBase f a -> Set a
onSigExp SigExpBase f a
e2

-- | Extract a leading @((name, namespace, file), remainder)@ from a
-- documentation comment string.  These are formatted as
-- \`name\`\@namespace[\@file].  Let us hope that this pattern does not occur
-- anywhere else.
identifierReference :: String -> Maybe ((String, String, Maybe FilePath), String)
identifierReference :: FilePath -> Maybe ((FilePath, FilePath, Maybe FilePath), FilePath)
identifierReference (Char
'`' : FilePath
s)
  | (FilePath
identifier, Char
'`' : Char
'@' : FilePath
s') <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'`') FilePath
s,
    (FilePath
namespace, FilePath
s'') <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlpha FilePath
s',
    Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
namespace =
      case FilePath
s'' of
        Char
'@' : Char
'"' : FilePath
s'''
          | (FilePath
file, Char
'"' : FilePath
s'''') <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'"') FilePath
s''' ->
              forall a. a -> Maybe a
Just ((FilePath
identifier, FilePath
namespace, forall a. a -> Maybe a
Just FilePath
file), FilePath
s'''')
        FilePath
_ -> forall a. a -> Maybe a
Just ((FilePath
identifier, FilePath
namespace, forall a. Maybe a
Nothing), FilePath
s'')
identifierReference FilePath
_ = forall a. Maybe a
Nothing

-- | Given an operator name, return the operator that determines its
-- syntactical properties.
leadingOperator :: Name -> BinOp
leadingOperator :: Name -> BinOp
leadingOperator Name
s =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe BinOp
Backtick forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
s') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
      forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
        forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyString [BinOp]
operators) [BinOp]
operators
  where
    s' :: FilePath
s' = Name -> FilePath
nameToString Name
s
    operators :: [BinOp]
    operators :: [BinOp]
operators = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound :: BinOp]

-- | Find instances of typed holes in the program.
progHoles :: ProgBase Info VName -> [(Loc, StructType)]
progHoles :: ProgBase Info VName -> [(Loc, StructType)]
progHoles = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DecBase Info VName -> [(Loc, StructType)]
holesInDec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs
  where
    holesInDec :: DecBase Info VName -> [(Loc, StructType)]
holesInDec (ValDec ValBindBase Info VName
vb) = ExpBase Info VName -> [(Loc, StructType)]
holesInExp forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody ValBindBase Info VName
vb
    holesInDec (ModDec ModBindBase Info VName
me) = ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp ModBindBase Info VName
me
    holesInDec (OpenDec ModExpBase Info VName
me SrcLoc
_) = ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp ModExpBase Info VName
me
    holesInDec (LocalDec DecBase Info VName
d SrcLoc
_) = DecBase Info VName -> [(Loc, StructType)]
holesInDec DecBase Info VName
d
    holesInDec TypeDec {} = forall a. Monoid a => a
mempty
    holesInDec SigDec {} = forall a. Monoid a => a
mempty
    holesInDec ImportDec {} = forall a. Monoid a => a
mempty

    holesInModExp :: ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp (ModDecs [DecBase Info VName]
ds SrcLoc
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DecBase Info VName -> [(Loc, StructType)]
holesInDec [DecBase Info VName]
ds
    holesInModExp (ModParens ModExpBase Info VName
me SrcLoc
_) = ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp ModExpBase Info VName
me
    holesInModExp (ModApply ModExpBase Info VName
x ModExpBase Info VName
y Info (Map VName VName)
_ Info (Map VName VName)
_ SrcLoc
_) = ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp ModExpBase Info VName
x forall a. Semigroup a => a -> a -> a
<> ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp ModExpBase Info VName
y
    holesInModExp (ModAscript ModExpBase Info VName
me SigExpBase Info VName
_ Info (Map VName VName)
_ SrcLoc
_) = ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp ModExpBase Info VName
me
    holesInModExp (ModLambda ModParamBase Info VName
_ Maybe (SigExpBase Info VName, Info (Map VName VName))
_ ModExpBase Info VName
me SrcLoc
_) = ModExpBase Info VName -> [(Loc, StructType)]
holesInModExp ModExpBase Info VName
me
    holesInModExp ModVar {} = forall a. Monoid a => a
mempty
    holesInModExp ModImport {} = forall a. Monoid a => a
mempty

    holesInExp :: ExpBase Info VName -> [(Loc, StructType)]
holesInExp = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *}.
MonadState [(Loc, StructType)] m =>
ExpBase Info VName -> m (ExpBase Info VName)
onExp

    onExp :: ExpBase Info VName -> m (ExpBase Info VName)
onExp e :: ExpBase Info VName
e@(Hole (Info StructType
t) SrcLoc
loc) = do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((forall a. Located a => a -> Loc
locOf SrcLoc
loc, forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct StructType
t) :)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpBase Info VName
e
    onExp ExpBase Info VName
e = forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap (forall (m :: * -> *). Monad m => ASTMapper m
identityMapper {mapOnExp :: ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp = ExpBase Info VName -> m (ExpBase Info VName)
onExp}) ExpBase Info VName
e

-- | Strip semantically irrelevant stuff from the top level of
-- expression.  This is used to provide a slightly fuzzy notion of
-- expression equality.
--
-- Ideally we'd implement unification on a simpler representation that
-- simply didn't allow us.
stripExp :: Exp -> Maybe Exp
stripExp :: ExpBase Info VName -> Maybe (ExpBase Info VName)
stripExp (Parens ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> Maybe (ExpBase Info VName)
stripExp ExpBase Info VName
e forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just ExpBase Info VName
e
stripExp (Assert ExpBase Info VName
_ ExpBase Info VName
e Info Text
_ SrcLoc
_) = ExpBase Info VName -> Maybe (ExpBase Info VName)
stripExp ExpBase Info VName
e forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just ExpBase Info VName
e
stripExp (Attr AttrInfo VName
_ ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> Maybe (ExpBase Info VName)
stripExp ExpBase Info VName
e forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just ExpBase Info VName
e
stripExp (Ascript ExpBase Info VName
e TypeExp Info VName
_ SrcLoc
_) = ExpBase Info VName -> Maybe (ExpBase Info VName)
stripExp ExpBase Info VName
e forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just ExpBase Info VName
e
stripExp ExpBase Info VName
_ = forall a. Maybe a
Nothing

similarSlices :: Slice -> Slice -> Maybe [(Exp, Exp)]
similarSlices :: SliceBase Info VName
-> SliceBase Info VName
-> Maybe [(ExpBase Info VName, ExpBase Info VName)]
similarSlices SliceBase Info VName
slice1 SliceBase Info VName
slice2
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length SliceBase Info VName
slice1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length SliceBase Info VName
slice2 = do
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall {f :: * -> *} {vn} {f :: * -> *} {vn}.
DimIndexBase f vn
-> DimIndexBase f vn -> Maybe [(ExpBase f vn, ExpBase f vn)]
match SliceBase Info VName
slice1 SliceBase Info VName
slice2
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    match :: DimIndexBase f vn
-> DimIndexBase f vn -> Maybe [(ExpBase f vn, ExpBase f vn)]
match (DimFix ExpBase f vn
e1) (DimFix ExpBase f vn
e2) = forall a. a -> Maybe a
Just [(ExpBase f vn
e1, ExpBase f vn
e2)]
    match (DimSlice Maybe (ExpBase f vn)
a1 Maybe (ExpBase f vn)
b1 Maybe (ExpBase f vn)
c1) (DimSlice Maybe (ExpBase f vn)
a2 Maybe (ExpBase f vn)
b2 Maybe (ExpBase f vn)
c2) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall {a} {b}. (Maybe a, Maybe b) -> Maybe [(a, b)]
pair (Maybe (ExpBase f vn)
a1, Maybe (ExpBase f vn)
a2), forall {a} {b}. (Maybe a, Maybe b) -> Maybe [(a, b)]
pair (Maybe (ExpBase f vn)
b1, Maybe (ExpBase f vn)
b2), forall {a} {b}. (Maybe a, Maybe b) -> Maybe [(a, b)]
pair (Maybe (ExpBase f vn)
c1, Maybe (ExpBase f vn)
c2)]
    match DimIndexBase f vn
_ DimIndexBase f vn
_ = forall a. Maybe a
Nothing
    pair :: (Maybe a, Maybe b) -> Maybe [(a, b)]
pair (Maybe a
Nothing, Maybe b
Nothing) = forall a. a -> Maybe a
Just []
    pair (Just a
x, Just b
y) = forall a. a -> Maybe a
Just [(a
x, b
y)]
    pair (Maybe a, Maybe b)
_ = forall a. Maybe a
Nothing

-- | If these two expressions are structurally similar at top level as
-- sizes, produce their subexpressions (which are not necessarily
-- similar, but you can check for that!).  This is the machinery
-- underlying expresssion unification.
similarExps :: Exp -> Exp -> Maybe [(Exp, Exp)]
similarExps :: ExpBase Info VName
-> ExpBase Info VName
-> Maybe [(ExpBase Info VName, ExpBase Info VName)]
similarExps ExpBase Info VName
e1 ExpBase Info VName
e2 | ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e1 forall a. Eq a => a -> a -> Bool
== ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e2 = forall a. a -> Maybe a
Just []
similarExps ExpBase Info VName
e1 ExpBase Info VName
e2 | Just ExpBase Info VName
e1' <- ExpBase Info VName -> Maybe (ExpBase Info VName)
stripExp ExpBase Info VName
e1 = ExpBase Info VName
-> ExpBase Info VName
-> Maybe [(ExpBase Info VName, ExpBase Info VName)]
similarExps ExpBase Info VName
e1' ExpBase Info VName
e2
similarExps ExpBase Info VName
e1 ExpBase Info VName
e2 | Just ExpBase Info VName
e2' <- ExpBase Info VName -> Maybe (ExpBase Info VName)
stripExp ExpBase Info VName
e2 = ExpBase Info VName
-> ExpBase Info VName
-> Maybe [(ExpBase Info VName, ExpBase Info VName)]
similarExps ExpBase Info VName
e1 ExpBase Info VName
e2'
similarExps
  (AppExp (BinOp (QualName VName
op1, SrcLoc
_) Info StructType
_ (ExpBase Info VName
x1, Info (Maybe VName)
_) (ExpBase Info VName
y1, Info (Maybe VName)
_) SrcLoc
_) Info AppRes
_)
  (AppExp (BinOp (QualName VName
op2, SrcLoc
_) Info StructType
_ (ExpBase Info VName
x2, Info (Maybe VName)
_) (ExpBase Info VName
y2, Info (Maybe VName)
_) SrcLoc
_) Info AppRes
_)
    | QualName VName
op1 forall a. Eq a => a -> a -> Bool
== QualName VName
op2 = forall a. a -> Maybe a
Just [(ExpBase Info VName
x1, ExpBase Info VName
x2), (ExpBase Info VName
y1, ExpBase Info VName
y2)]
similarExps (AppExp (Apply ExpBase Info VName
f1 NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args1 SrcLoc
_) Info AppRes
_) (AppExp (Apply ExpBase Info VName
f2 NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args2 SrcLoc
_) Info AppRes
_)
  | ExpBase Info VName
f1 forall a. Eq a => a -> a -> Bool
== ExpBase Info VName
f2 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args1) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args2)
similarExps (AppExp (Index ExpBase Info VName
arr1 SliceBase Info VName
slice1 SrcLoc
_) Info AppRes
_) (AppExp (Index ExpBase Info VName
arr2 SliceBase Info VName
slice2 SrcLoc
_) Info AppRes
_)
  | ExpBase Info VName
arr1 forall a. Eq a => a -> a -> Bool
== ExpBase Info VName
arr2,
    forall (t :: * -> *) a. Foldable t => t a -> Int
length SliceBase Info VName
slice1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length SliceBase Info VName
slice2 =
      SliceBase Info VName
-> SliceBase Info VName
-> Maybe [(ExpBase Info VName, ExpBase Info VName)]
similarSlices SliceBase Info VName
slice1 SliceBase Info VName
slice2
similarExps (TupLit [ExpBase Info VName]
es1 SrcLoc
_) (TupLit [ExpBase Info VName]
es2 SrcLoc
_)
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpBase Info VName]
es1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpBase Info VName]
es2 =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ExpBase Info VName]
es1 [ExpBase Info VName]
es2
similarExps (RecordLit [FieldBase Info VName]
fs1 SrcLoc
_) (RecordLit [FieldBase Info VName]
fs2 SrcLoc
_)
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldBase Info VName]
fs1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldBase Info VName]
fs2 =
      forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall {f :: * -> *} {vn} {f :: * -> *} {vn}.
FieldBase f vn
-> FieldBase f vn -> Maybe (ExpBase f vn, ExpBase f vn)
onFields [FieldBase Info VName]
fs1 [FieldBase Info VName]
fs2
  where
    onFields :: FieldBase f vn
-> FieldBase f vn -> Maybe (ExpBase f vn, ExpBase f vn)
onFields (RecordFieldExplicit Name
n1 ExpBase f vn
fe1 SrcLoc
_) (RecordFieldExplicit Name
n2 ExpBase f vn
fe2 SrcLoc
_)
      | Name
n1 forall a. Eq a => a -> a -> Bool
== Name
n2 = forall a. a -> Maybe a
Just (ExpBase f vn
fe1, ExpBase f vn
fe2)
    onFields (RecordFieldImplicit vn
vn1 f StructType
ty1 SrcLoc
_) (RecordFieldImplicit vn
vn2 f StructType
ty2 SrcLoc
_) =
      forall a. a -> Maybe a
Just (forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var (forall v. v -> QualName v
qualName vn
vn1) f StructType
ty1 forall a. Monoid a => a
mempty, forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var (forall v. v -> QualName v
qualName vn
vn2) f StructType
ty2 forall a. Monoid a => a
mempty)
    onFields FieldBase f vn
_ FieldBase f vn
_ = forall a. Maybe a
Nothing
similarExps (ArrayLit [ExpBase Info VName]
es1 Info StructType
_ SrcLoc
_) (ArrayLit [ExpBase Info VName]
es2 Info StructType
_ SrcLoc
_)
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpBase Info VName]
es1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpBase Info VName]
es2 =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ExpBase Info VName]
es1 [ExpBase Info VName]
es2
similarExps (Project Name
field1 ExpBase Info VName
e1 Info StructType
_ SrcLoc
_) (Project Name
field2 ExpBase Info VName
e2 Info StructType
_ SrcLoc
_)
  | Name
field1 forall a. Eq a => a -> a -> Bool
== Name
field2 =
      forall a. a -> Maybe a
Just [(ExpBase Info VName
e1, ExpBase Info VName
e2)]
similarExps (Negate ExpBase Info VName
e1 SrcLoc
_) (Negate ExpBase Info VName
e2 SrcLoc
_) =
  forall a. a -> Maybe a
Just [(ExpBase Info VName
e1, ExpBase Info VName
e2)]
similarExps (Not ExpBase Info VName
e1 SrcLoc
_) (Not ExpBase Info VName
e2 SrcLoc
_) =
  forall a. a -> Maybe a
Just [(ExpBase Info VName
e1, ExpBase Info VName
e2)]
similarExps (Constr Name
n1 [ExpBase Info VName]
es1 Info StructType
_ SrcLoc
_) (Constr Name
n2 [ExpBase Info VName]
es2 Info StructType
_ SrcLoc
_)
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpBase Info VName]
es1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpBase Info VName]
es2,
    Name
n1 forall a. Eq a => a -> a -> Bool
== Name
n2 =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ExpBase Info VName]
es1 [ExpBase Info VName]
es2
similarExps (Update ExpBase Info VName
e1 SliceBase Info VName
slice1 ExpBase Info VName
e'1 SrcLoc
_) (Update ExpBase Info VName
e2 SliceBase Info VName
slice2 ExpBase Info VName
e'2 SrcLoc
_) =
  ([(ExpBase Info VName
e1, ExpBase Info VName
e2), (ExpBase Info VName
e'1, ExpBase Info VName
e'2)] ++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SliceBase Info VName
-> SliceBase Info VName
-> Maybe [(ExpBase Info VName, ExpBase Info VName)]
similarSlices SliceBase Info VName
slice1 SliceBase Info VName
slice2
similarExps (RecordUpdate ExpBase Info VName
e1 [Name]
names1 ExpBase Info VName
e'1 Info StructType
_ SrcLoc
_) (RecordUpdate ExpBase Info VName
e2 [Name]
names2 ExpBase Info VName
e'2 Info StructType
_ SrcLoc
_)
  | [Name]
names1 forall a. Eq a => a -> a -> Bool
== [Name]
names2 =
      forall a. a -> Maybe a
Just [(ExpBase Info VName
e1, ExpBase Info VName
e2), (ExpBase Info VName
e'1, ExpBase Info VName
e'2)]
similarExps (OpSection QualName VName
op1 Info StructType
_ SrcLoc
_) (OpSection QualName VName
op2 Info StructType
_ SrcLoc
_)
  | QualName VName
op1 forall a. Eq a => a -> a -> Bool
== QualName VName
op2 = forall a. a -> Maybe a
Just []
similarExps (OpSectionLeft QualName VName
op1 Info StructType
_ ExpBase Info VName
x1 (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
_ (Info ResRetType, Info [VName])
_ SrcLoc
_) (OpSectionLeft QualName VName
op2 Info StructType
_ ExpBase Info VName
x2 (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
_ (Info ResRetType, Info [VName])
_ SrcLoc
_)
  | QualName VName
op1 forall a. Eq a => a -> a -> Bool
== QualName VName
op2 = forall a. a -> Maybe a
Just [(ExpBase Info VName
x1, ExpBase Info VName
x2)]
similarExps (OpSectionRight QualName VName
op1 Info StructType
_ ExpBase Info VName
x1 (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
_ Info ResRetType
_ SrcLoc
_) (OpSectionRight QualName VName
op2 Info StructType
_ ExpBase Info VName
x2 (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
_ Info ResRetType
_ SrcLoc
_)
  | QualName VName
op1 forall a. Eq a => a -> a -> Bool
== QualName VName
op2 = forall a. a -> Maybe a
Just [(ExpBase Info VName
x1, ExpBase Info VName
x2)]
similarExps (ProjectSection [Name]
names1 Info StructType
_ SrcLoc
_) (ProjectSection [Name]
names2 Info StructType
_ SrcLoc
_)
  | [Name]
names1 forall a. Eq a => a -> a -> Bool
== [Name]
names2 = forall a. a -> Maybe a
Just []
similarExps (IndexSection SliceBase Info VName
slice1 Info StructType
_ SrcLoc
_) (IndexSection SliceBase Info VName
slice2 Info StructType
_ SrcLoc
_) =
  SliceBase Info VName
-> SliceBase Info VName
-> Maybe [(ExpBase Info VName, ExpBase Info VName)]
similarSlices SliceBase Info VName
slice1 SliceBase Info VName
slice2
similarExps ExpBase Info VName
_ ExpBase Info VName
_ = forall a. Maybe a
Nothing

-- | An identifier with type- and aliasing information.
type Ident = IdentBase Info VName

-- | An index with type information.
type DimIndex = DimIndexBase Info VName

-- | A slice with type information.
type Slice = SliceBase Info VName

-- | An expression with type information.
type Exp = ExpBase Info VName

-- | An application expression with type information.
type AppExp = AppExpBase Info VName

-- | A pattern with type information.
type Pat = PatBase Info VName

-- | An constant declaration with type information.
type ValBind = ValBindBase Info VName

-- | A type binding with type information.
type TypeBind = TypeBindBase Info VName

-- | A type-checked module binding.
type ModBind = ModBindBase Info VName

-- | A type-checked module type binding.
type SigBind = SigBindBase Info VName

-- | A type-checked module expression.
type ModExp = ModExpBase Info VName

-- | A type-checked module parameter.
type ModParam = ModParamBase Info VName

-- | A type-checked module type expression.
type SigExp = SigExpBase Info VName

-- | A type-checked declaration.
type Dec = DecBase Info VName

-- | A type-checked specification.
type Spec = SpecBase Info VName

-- | An Futhark program with type information.
type Prog = ProgBase Info VName

-- | A known type arg with shape annotations.
type StructTypeArg = TypeArg Size

-- | A type-checked type parameter.
type TypeParam = TypeParamBase VName

-- | A known scalar type with no shape annotations.
type ScalarType = ScalarTypeBase ()

-- | A type-checked case (of a match expression).
type Case = CaseBase Info VName

-- | A type with no aliasing information but shape annotations.
type UncheckedType = TypeBase (Shape Name) ()

-- | An unchecked type expression.
type UncheckedTypeExp = TypeExp NoInfo Name

-- | An identifier with no type annotations.
type UncheckedIdent = IdentBase NoInfo Name

-- | An index with no type annotations.
type UncheckedDimIndex = DimIndexBase NoInfo Name

-- | A slice with no type annotations.
type UncheckedSlice = SliceBase NoInfo Name

-- | An expression with no type annotations.
type UncheckedExp = ExpBase NoInfo Name

-- | A module expression with no type annotations.
type UncheckedModExp = ModExpBase NoInfo Name

-- | A module type expression with no type annotations.
type UncheckedSigExp = SigExpBase NoInfo Name

-- | A type parameter with no type annotations.
type UncheckedTypeParam = TypeParamBase Name

-- | A pattern with no type annotations.
type UncheckedPat = PatBase NoInfo Name

-- | A function declaration with no type annotations.
type UncheckedValBind = ValBindBase NoInfo Name

-- | A type binding with no type annotations.
type UncheckedTypeBind = TypeBindBase NoInfo Name

-- | A module type binding with no type annotations.
type UncheckedSigBind = SigBindBase NoInfo Name

-- | A module binding with no type annotations.
type UncheckedModBind = ModBindBase NoInfo Name

-- | A declaration with no type annotations.
type UncheckedDec = DecBase NoInfo Name

-- | A spec with no type annotations.
type UncheckedSpec = SpecBase NoInfo Name

-- | A Futhark program with no type annotations.
type UncheckedProg = ProgBase NoInfo Name

-- | A case (of a match expression) with no type annotations.
type UncheckedCase = CaseBase NoInfo Name