    module Futhark.Internalise.TypesValues
      ( -- * Internalising types
        internaliseReturnType,
        internaliseCoerceType,
        internaliseLambdaReturnType,
        internaliseEntryReturnType,
        internaliseType,
        internaliseParamTypes,
        internaliseLoopParamType,
        internalisePrimType,
        internalisedTypeSize,
        internaliseSumTypeRep,
        internaliseSumType,
        Tree,

        -- * Internalising values
        internalisePrimValue,

        -- * For internal testing
        inferAliases,
        internaliseConstructors,
      )
    where

    import Control.Monad
    import Control.Monad.Free (Free (..))
    import Control.Monad.State
    import Data.Bifunctor
    import Data.Bitraversable (bitraverse)
    import Data.Foldable (toList)
    import Data.List (delete, find, foldl')
    import Data.List qualified as L
    import Data.Map.Strict qualified as M
    import Data.Maybe
    import Futhark.IR.SOACS hiding (Free)
    import Futhark.IR.SOACS qualified as I
    import Futhark.Internalise.Monad
    import Futhark.Util (chunkLike)
    import Language.Futhark qualified as E

    internaliseUniqueness :: E.Uniqueness -> I.Uniqueness
    internaliseUniqueness :: Uniqueness -> Uniqueness
    internaliseUniqueness Uniqueness
    E.Nonunique = Uniqueness
    I.Nonunique
    internaliseUniqueness Uniqueness
    E.Unique = Uniqueness
    I.Unique

    newtype TypeState = TypeState {TypeState -> Int
    typeCounter :: Int}

    newtype InternaliseTypeM a
      = InternaliseTypeM (State TypeState a)
      deriving ((forall a b. (a -> b) -> InternaliseTypeM a -> InternaliseTypeM b)
    -> (forall a b. a -> InternaliseTypeM b -> InternaliseTypeM a)
    -> Functor InternaliseTypeM
    forall a b. a -> InternaliseTypeM b -> InternaliseTypeM a
    forall a b. (a -> b) -> InternaliseTypeM a -> InternaliseTypeM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> InternaliseTypeM a -> InternaliseTypeM b
    fmap :: forall a b. (a -> b) -> InternaliseTypeM a -> InternaliseTypeM b
    $c<$ :: forall a b. a -> InternaliseTypeM b -> InternaliseTypeM a
    <$ :: forall a b. a -> InternaliseTypeM b -> InternaliseTypeM a
    Functor, Functor InternaliseTypeM
    Functor InternaliseTypeM =>
    (forall a. a -> InternaliseTypeM a)
    -> (forall a b.
        InternaliseTypeM (a -> b)
        -> InternaliseTypeM a -> InternaliseTypeM b)
    -> (forall a b c.
        (a -> b -> c)
        -> InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM c)
    -> (forall a b.
        InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b)
    -> (forall a b.
        InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM a)
    -> Applicative InternaliseTypeM
    forall a. a -> InternaliseTypeM a
    forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM a
    forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b
    forall a b.
    InternaliseTypeM (a -> b)
    -> InternaliseTypeM a -> InternaliseTypeM b
    forall a b c.
    (a -> b -> c)
    -> InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> InternaliseTypeM a
    pure :: forall a. a -> InternaliseTypeM a
    $c<*> :: forall a b.
    InternaliseTypeM (a -> b)
    -> InternaliseTypeM a -> InternaliseTypeM b
    <*> :: forall a b.
    InternaliseTypeM (a -> b)
    -> InternaliseTypeM a -> InternaliseTypeM b
    $cliftA2 :: forall a b c.
    (a -> b -> c)
    -> InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM c
    $c*> :: forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b
    *> :: forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b
    $c<* :: forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM a
    <* :: forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM a
    Applicative, Applicative InternaliseTypeM
    Applicative InternaliseTypeM =>
    (forall a b.
     InternaliseTypeM a
     -> (a -> InternaliseTypeM b) -> InternaliseTypeM b)
    -> (forall a b.
        InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b)
    -> (forall a. a -> InternaliseTypeM a)
    -> Monad InternaliseTypeM
    forall a. a -> InternaliseTypeM a
    forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b
    forall a b.
    InternaliseTypeM a
    -> (a -> InternaliseTypeM b) -> InternaliseTypeM b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b.
    InternaliseTypeM a
    -> (a -> InternaliseTypeM b) -> InternaliseTypeM b
    >>= :: forall a b.
    InternaliseTypeM a
    -> (a -> InternaliseTypeM b) -> InternaliseTypeM b
    $c>> :: forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b
    >> :: forall a b.
    InternaliseTypeM a -> InternaliseTypeM b -> InternaliseTypeM b
    $creturn :: forall a. a -> InternaliseTypeM a
    return :: forall a. a -> InternaliseTypeM a
    Monad, MonadState TypeState)

    runInternaliseTypeM :: InternaliseTypeM a -> a
    runInternaliseTypeM :: forall a. InternaliseTypeM a -> a
    runInternaliseTypeM = [VName] -> InternaliseTypeM a -> a
    forall a. [VName] -> InternaliseTypeM a -> a
    runInternaliseTypeM' [VName]
    forall a. Monoid a => a
    mempty

    runInternaliseTypeM' :: [VName] -> InternaliseTypeM a -> a
    runInternaliseTypeM' :: forall a. [VName] -> InternaliseTypeM a -> a
    runInternaliseTypeM' [VName]
    exts (InternaliseTypeM State TypeState a
    m) = State TypeState a -> TypeState -> a
    forall s a. State s a -> s -> a
    evalState State TypeState a
    m (TypeState -> a) -> TypeState -> a
    forall a b. (a -> b) -> a -> b
    $ Int -> TypeState
    TypeState ([VName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [VName]
    exts)

    internaliseParamTypes ::
      [E.ParamType] ->
      InternaliseM [[Tree (I.TypeBase Shape Uniqueness)]]
    internaliseParamTypes :: [ParamType] -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]]
    internaliseParamTypes [ParamType]
    ts =
      ([Tree (TypeBase Shape Uniqueness)]
     -> InternaliseM [Tree (TypeBase Shape Uniqueness)])
    -> [[Tree (TypeBase Shape Uniqueness)]]
    -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((Tree (TypeBase Shape Uniqueness)
     -> InternaliseM (Tree (TypeBase Shape Uniqueness)))
    -> [Tree (TypeBase Shape Uniqueness)]
    -> InternaliseM [Tree (TypeBase Shape Uniqueness)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((TypeBase Shape Uniqueness
     -> InternaliseM (TypeBase Shape Uniqueness))
    -> Tree (TypeBase Shape Uniqueness)
    -> InternaliseM (Tree (TypeBase Shape Uniqueness))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Free [] a -> m (Free [] b)
    mapM TypeBase Shape Uniqueness
    -> InternaliseM (TypeBase Shape Uniqueness)
    forall shape u. TypeBase shape u -> InternaliseM (TypeBase shape u)
    mkAccCerts)) ([[Tree (TypeBase Shape Uniqueness)]]
     -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]])
    -> (InternaliseTypeM [[Tree (TypeBase Shape Uniqueness)]]
        -> [[Tree (TypeBase Shape Uniqueness)]])
    -> InternaliseTypeM [[Tree (TypeBase Shape Uniqueness)]]
    -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InternaliseTypeM [[Tree (TypeBase Shape Uniqueness)]]
    -> [[Tree (TypeBase Shape Uniqueness)]]
    forall a. InternaliseTypeM a -> a
    runInternaliseTypeM (InternaliseTypeM [[Tree (TypeBase Shape Uniqueness)]]
     -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]])
    -> InternaliseTypeM [[Tree (TypeBase Shape Uniqueness)]]
    -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]]
    forall a b. (a -> b) -> a -> b
    $
        (ParamType -> InternaliseTypeM [Tree (TypeBase Shape Uniqueness)])
    -> [ParamType]
    -> InternaliseTypeM [[Tree (TypeBase Shape Uniqueness)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (([Tree (TypeBase ExtShape Uniqueness)]
     -> [Tree (TypeBase Shape Uniqueness)])
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    -> InternaliseTypeM [Tree (TypeBase Shape Uniqueness)]
    forall a b. (a -> b) -> InternaliseTypeM a -> InternaliseTypeM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Tree (TypeBase ExtShape Uniqueness)
     -> Tree (TypeBase Shape Uniqueness))
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [Tree (TypeBase Shape Uniqueness)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TypeBase ExtShape Uniqueness -> TypeBase Shape Uniqueness)
    -> Tree (TypeBase ExtShape Uniqueness)
    -> Tree (TypeBase Shape Uniqueness)
    forall a b. (a -> b) -> Free [] a -> Free [] b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypeBase ExtShape Uniqueness -> TypeBase Shape Uniqueness
    forall {u}. TypeBase ExtShape u -> TypeBase Shape u
    onType)) (InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
     -> InternaliseTypeM [Tree (TypeBase Shape Uniqueness)])
    -> (ParamType
        -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> ParamType
    -> InternaliseTypeM [Tree (TypeBase Shape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    forall a. Monoid a => a
    mempty (ResType -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> (ParamType -> ResType)
    -> ParamType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParamType -> ResType
    E.paramToRes) [ParamType]
    ts
      where
        onType :: TypeBase ExtShape u -> TypeBase Shape u
    onType = TypeBase Shape u -> Maybe (TypeBase Shape u) -> TypeBase Shape u
    forall a. a -> Maybe a -> a
    fromMaybe TypeBase Shape u
    forall {a}. a
    bad (Maybe (TypeBase Shape u) -> TypeBase Shape u)
    -> (TypeBase ExtShape u -> Maybe (TypeBase Shape u))
    -> TypeBase ExtShape u
    -> TypeBase Shape u
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TypeBase ExtShape u -> Maybe (TypeBase Shape u)
    forall u. TypeBase ExtShape u -> Maybe (TypeBase Shape u)
    hasStaticShape
        bad :: a
    bad = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "internaliseParamTypes: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [ParamType] -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyString [ParamType]
    ts

    -- We need to fix up the arrays for any Acc return values or loop
    -- parameters.  We look at the concrete types for this, since the Acc
    -- parameter name in the second list will just be something we made up.
    fixupKnownTypes ::
      [TypeBase shape1 u1] ->
      [(TypeBase shape2 u2, b)] ->
      [(TypeBase shape2 u2, b)]
    fixupKnownTypes :: forall shape1 u1 shape2 u2 b.
    [TypeBase shape1 u1]
    -> [(TypeBase shape2 u2, b)] -> [(TypeBase shape2 u2, b)]
    fixupKnownTypes = (TypeBase shape1 u1
     -> (TypeBase shape2 u2, b) -> (TypeBase shape2 u2, b))
    -> [TypeBase shape1 u1]
    -> [(TypeBase shape2 u2, b)]
    -> [(TypeBase shape2 u2, b)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith TypeBase shape1 u1
    -> (TypeBase shape2 u2, b) -> (TypeBase shape2 u2, b)
    forall {shape} {u} {shape} {u} {b}.
    TypeBase shape u -> (TypeBase shape u, b) -> (TypeBase shape u, b)
    fixup
      where
        fixup :: TypeBase shape u -> (TypeBase shape u, b) -> (TypeBase shape u, b)
    fixup (Acc VName
    acc Shape
    ispace [TypeBase Shape NoUniqueness]
    ts u
    _) (Acc VName
    _ Shape
    _ [TypeBase Shape NoUniqueness]
    _ u
    u2, b
    b) = (VName
    -> Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u
    forall shape u.
    VName
    -> Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u
    Acc VName
    acc Shape
    ispace [TypeBase Shape NoUniqueness]
    ts u
    u2, b
    b)
        fixup TypeBase shape u
    _ (TypeBase shape u, b)
    t = (TypeBase shape u, b)
    t

    -- Generate proper certificates for the placeholder accumulator
    -- certificates produced by internaliseType (identified with tag 0).
    -- Only needed when we cannot use 'fixupKnownTypes'.
    mkAccCerts :: TypeBase shape u -> InternaliseM (TypeBase shape u)
    mkAccCerts :: forall shape u. TypeBase shape u -> InternaliseM (TypeBase shape u)
    mkAccCerts (Array PrimType
    pt shape
    shape u
    u) =
      TypeBase shape u -> InternaliseM (TypeBase shape u)
    forall a. a -> InternaliseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TypeBase shape u -> InternaliseM (TypeBase shape u))
    -> TypeBase shape u -> InternaliseM (TypeBase shape u)
    forall a b. (a -> b) -> a -> b
    $ PrimType -> shape -> u -> TypeBase shape u
    forall shape u. PrimType -> shape -> u -> TypeBase shape u
    Array PrimType
    pt shape
    shape u
    u
    mkAccCerts (Acc VName
    c Shape
    shape [TypeBase Shape NoUniqueness]
    ts u
    u) =
      VName
    -> Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u
    forall shape u.
    VName
    -> Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u
    Acc (VName
     -> Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u)
    -> InternaliseM VName
    -> InternaliseM
         (Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> InternaliseM VName
    c' InternaliseM
      (Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u)
    -> InternaliseM Shape
    -> InternaliseM
         ([TypeBase Shape NoUniqueness] -> u -> TypeBase shape u)
    forall a b.
    InternaliseM (a -> b) -> InternaliseM a -> InternaliseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Shape -> InternaliseM Shape
    forall a. a -> InternaliseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Shape
    shape InternaliseM
      ([TypeBase Shape NoUniqueness] -> u -> TypeBase shape u)
    -> InternaliseM [TypeBase Shape NoUniqueness]
    -> InternaliseM (u -> TypeBase shape u)
    forall a b.
    InternaliseM (a -> b) -> InternaliseM a -> InternaliseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [TypeBase Shape NoUniqueness]
    -> InternaliseM [TypeBase Shape NoUniqueness]
    forall a. a -> InternaliseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [TypeBase Shape NoUniqueness]
    ts InternaliseM (u -> TypeBase shape u)
    -> InternaliseM u -> InternaliseM (TypeBase shape u)
    forall a b.
    InternaliseM (a -> b) -> InternaliseM a -> InternaliseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> u -> InternaliseM u
    forall a. a -> InternaliseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure u
    u
      where
        c' :: InternaliseM VName
    c'
          | VName -> Int
    baseTag VName
    c Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = [Char] -> InternaliseM VName
    forall (m :: * -> *). MonadFreshNames m => [Char] -> m VName
    newVName [Char]
    "acc_cert"
          | Bool
    otherwise = VName -> InternaliseM VName
    forall a. a -> InternaliseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure VName
    c
    mkAccCerts TypeBase shape u
    t = TypeBase shape u -> InternaliseM (TypeBase shape u)
    forall a. a -> InternaliseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TypeBase shape u
    t

    internaliseLoopParamType ::
      E.ParamType ->
      [TypeBase shape u] ->
      InternaliseM [I.TypeBase Shape Uniqueness]
    internaliseLoopParamType :: forall shape u.
    ParamType
    -> [TypeBase shape u] -> InternaliseM [TypeBase Shape Uniqueness]
    internaliseLoopParamType ParamType
    et [TypeBase shape u]
    ts =
      ((TypeBase Shape Uniqueness, ()) -> TypeBase Shape Uniqueness)
    -> [(TypeBase Shape Uniqueness, ())] -> [TypeBase Shape Uniqueness]
    forall a b. (a -> b) -> [a] -> [b]
    map (TypeBase Shape Uniqueness, ()) -> TypeBase Shape Uniqueness
    forall a b. (a, b) -> a
    fst ([(TypeBase Shape Uniqueness, ())] -> [TypeBase Shape Uniqueness])
    -> ([[Tree (TypeBase Shape Uniqueness)]]
        -> [(TypeBase Shape Uniqueness, ())])
    -> [[Tree (TypeBase Shape Uniqueness)]]
    -> [TypeBase Shape Uniqueness]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TypeBase shape u]
    -> [(TypeBase Shape Uniqueness, ())]
    -> [(TypeBase Shape Uniqueness, ())]
    forall shape1 u1 shape2 u2 b.
    [TypeBase shape1 u1]
    -> [(TypeBase shape2 u2, b)] -> [(TypeBase shape2 u2, b)]
    fixupKnownTypes [TypeBase shape u]
    ts ([(TypeBase Shape Uniqueness, ())]
     -> [(TypeBase Shape Uniqueness, ())])
    -> ([[Tree (TypeBase Shape Uniqueness)]]
        -> [(TypeBase Shape Uniqueness, ())])
    -> [[Tree (TypeBase Shape Uniqueness)]]
    -> [(TypeBase Shape Uniqueness, ())]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypeBase Shape Uniqueness -> (TypeBase Shape Uniqueness, ()))
    -> [TypeBase Shape Uniqueness] -> [(TypeBase Shape Uniqueness, ())]
    forall a b. (a -> b) -> [a] -> [b]
    map (,()) ([TypeBase Shape Uniqueness] -> [(TypeBase Shape Uniqueness, ())])
    -> ([[Tree (TypeBase Shape Uniqueness)]]
        -> [TypeBase Shape Uniqueness])
    -> [[Tree (TypeBase Shape Uniqueness)]]
    -> [(TypeBase Shape Uniqueness, ())]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Tree (TypeBase Shape Uniqueness)] -> [TypeBase Shape Uniqueness])
    -> [[Tree (TypeBase Shape Uniqueness)]]
    -> [TypeBase Shape Uniqueness]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Tree (TypeBase Shape Uniqueness) -> [TypeBase Shape Uniqueness])
    -> [Tree (TypeBase Shape Uniqueness)]
    -> [TypeBase Shape Uniqueness]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree (TypeBase Shape Uniqueness) -> [TypeBase Shape Uniqueness]
    forall a. Free [] a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList)
        ([[Tree (TypeBase Shape Uniqueness)]]
     -> [TypeBase Shape Uniqueness])
    -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]]
    -> InternaliseM [TypeBase Shape Uniqueness]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ParamType] -> InternaliseM [[Tree (TypeBase Shape Uniqueness)]]
    internaliseParamTypes [ParamType
    et]

    -- Tag every sublist with its offset in corresponding flattened list.
    withOffsets :: (Foldable a) => [a b] -> [(a b, Int)]
    withOffsets :: forall (a :: * -> *) b. Foldable a => [a b] -> [(a b, Int)]
    withOffsets [a b]
    xs = [a b] -> [Int] -> [(a b, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a b]
    xs ((Int -> Int -> Int) -> Int -> [Int] -> [Int]
    forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    0 ([Int] -> [Int]) -> [Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ (a b -> Int) -> [a b] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map a b -> Int
    forall a. a a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a b]
    xs)

    numberFrom :: Int -> Tree a -> Tree (a, Int)
    numberFrom :: forall a. Int -> Tree a -> Tree (a, Int)
    numberFrom Int
    o = (State Int (Tree (a, Int)) -> Int -> Tree (a, Int))
    -> Int -> State Int (Tree (a, Int)) -> Tree (a, Int)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip State Int (Tree (a, Int)) -> Int -> Tree (a, Int)
    forall s a. State s a -> s -> a
    evalState Int
    o (State Int (Tree (a, Int)) -> Tree (a, Int))
    -> (Tree a -> State Int (Tree (a, Int))) -> Tree a -> Tree (a, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree a -> State Int (Tree (a, Int))
    forall {b} {m :: * -> *} {f :: * -> *} {a}.
    (MonadState b m, Num b, Traversable f) =>
    Free f a -> m (Free f (a, b))
    f
      where
        f :: Free f a -> m (Free f (a, b))
    f (Pure a
    x) = (b -> (Free f (a, b), b)) -> m (Free f (a, b))
    forall a. (b -> (a, b)) -> m a
    forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
    state ((b -> (Free f (a, b), b)) -> m (Free f (a, b)))
    -> (b -> (Free f (a, b), b)) -> m (Free f (a, b))
    forall a b. (a -> b) -> a -> b
    $ \b
    i -> ((a, b) -> Free f (a, b)
    forall (f :: * -> *) a. a -> Free f a
    Pure (a
    x, b
    i), b
    i b -> b -> b
    forall a. Num a => a -> a -> a
    + b
    1)
        f (Free f (Free f a)
    xs) = f (Free f (a, b)) -> Free f (a, b)
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f (a, b)) -> Free f (a, b))
    -> m (f (Free f (a, b))) -> m (Free f (a, b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Free f a -> m (Free f (a, b)))
    -> f (Free f a) -> m (f (Free f (a, b)))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> f a -> f (f b)
    traverse Free f a -> m (Free f (a, b))
    f f (Free f a)
    xs

    numberTrees :: [Tree a] -> [Tree (a, Int)]
    numberTrees :: forall a. [Tree a] -> [Tree (a, Int)]
    numberTrees = ((Tree a, Int) -> Tree (a, Int))
    -> [(Tree a, Int)] -> [Tree (a, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Tree a -> Int -> Tree (a, Int)) -> (Tree a, Int) -> Tree (a, Int)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((Tree a -> Int -> Tree (a, Int))
     -> (Tree a, Int) -> Tree (a, Int))
    -> (Tree a -> Int -> Tree (a, Int))
    -> (Tree a, Int)
    -> Tree (a, Int)
    forall a b. (a -> b) -> a -> b
    $ (Int -> Tree a -> Tree (a, Int)) -> Tree a -> Int -> Tree (a, Int)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Int -> Tree a -> Tree (a, Int)
    forall a. Int -> Tree a -> Tree (a, Int)
    numberFrom) ([(Tree a, Int)] -> [Tree (a, Int)])
    -> ([Tree a] -> [(Tree a, Int)]) -> [Tree a] -> [Tree (a, Int)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tree a] -> [(Tree a, Int)]
    forall (a :: * -> *) b. Foldable a => [a b] -> [(a b, Int)]
    withOffsets

    nonuniqueArray :: TypeBase shape Uniqueness -> Bool
    nonuniqueArray :: forall shape. TypeBase shape Uniqueness -> Bool
    nonuniqueArray t :: TypeBase shape Uniqueness
    t@Array {} = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ TypeBase shape Uniqueness -> Bool
    forall shape. TypeBase shape Uniqueness -> Bool
    unique TypeBase shape Uniqueness
    t
    nonuniqueArray TypeBase shape Uniqueness
    _ = Bool
    False

    matchTrees :: Tree a -> Tree b -> Maybe (Tree (a, b))
    matchTrees :: forall a b. Tree a -> Tree b -> Maybe (Tree (a, b))
    matchTrees (Pure a
    a) (Pure b
    b) = Tree (a, b) -> Maybe (Tree (a, b))
    forall a. a -> Maybe a
    Just (Tree (a, b) -> Maybe (Tree (a, b)))
    -> Tree (a, b) -> Maybe (Tree (a, b))
    forall a b. (a -> b) -> a -> b
    $ (a, b) -> Tree (a, b)
    forall (f :: * -> *) a. a -> Free f a
    Pure (a
    a, b
    b)
    matchTrees (Free [Free [] a]
    as) (Free [Free [] b]
    bs)
      | [Free [] a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Free [] a]
    as Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Free [] b] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Free [] b]
    bs =
          [Tree (a, b)] -> Tree (a, b)
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free ([Tree (a, b)] -> Tree (a, b))
    -> Maybe [Tree (a, b)] -> Maybe (Tree (a, b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Free [] a -> Free [] b -> Maybe (Tree (a, b)))
    -> [Free [] a] -> [Free [] b] -> Maybe [Tree (a, b)]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Free [] a -> Free [] b -> Maybe (Tree (a, b))
    forall a b. Tree a -> Tree b -> Maybe (Tree (a, b))
    matchTrees [Free [] a]
    as [Free [] b]
    bs
    matchTrees Free [] a
    _ Free [] b
    _ = Maybe (Tree (a, b))
    forall a. Maybe a
    Nothing

    subtreesMatching :: Tree a -> Tree b -> [Tree (a, b)]
    subtreesMatching :: forall a b. Tree a -> Tree b -> [Tree (a, b)]
    subtreesMatching Tree a
    as Tree b
    bs =
      case Tree a -> Tree b -> Maybe (Tree (a, b))
    forall a b. Tree a -> Tree b -> Maybe (Tree (a, b))
    matchTrees Tree a
    as Tree b
    bs of
        Just Tree (a, b)
    m -> [Tree (a, b)
    m]
        Maybe (Tree (a, b))
    Nothing -> case Tree b
    bs of
          Pure b
    _ -> []
          Free [Tree b]
    bs' -> (Tree b -> [Tree (a, b)]) -> [Tree b] -> [Tree (a, b)]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (Tree a -> Tree b -> [Tree (a, b)]
    forall a b. Tree a -> Tree b -> [Tree (a, b)]
    subtreesMatching Tree a
    as) [Tree b]
    bs'

    -- See Note [Alias Inference].
    inferAliases ::
      [Tree (I.TypeBase Shape Uniqueness)] ->
      [Tree (I.TypeBase ExtShape Uniqueness)] ->
      [[(I.TypeBase ExtShape Uniqueness, RetAls)]]
    inferAliases :: [Tree (TypeBase Shape Uniqueness)]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    inferAliases [Tree (TypeBase Shape Uniqueness)]
    all_param_ts [Tree (TypeBase ExtShape Uniqueness)]
    all_res_ts =
      (Tree (TypeBase ExtShape Uniqueness)
     -> [(TypeBase ExtShape Uniqueness, RetAls)])
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    forall a b. (a -> b) -> [a] -> [b]
    map Tree (TypeBase ExtShape Uniqueness)
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall {shape}.
    Free [] (TypeBase shape Uniqueness)
    -> [(TypeBase shape Uniqueness, RetAls)]
    onRes [Tree (TypeBase ExtShape Uniqueness)]
    all_res_ts
      where
        all_res_ts' :: [Tree (TypeBase ExtShape Uniqueness, Int)]
    all_res_ts' = [Tree (TypeBase ExtShape Uniqueness)]
    -> [Tree (TypeBase ExtShape Uniqueness, Int)]
    forall a. [Tree a] -> [Tree (a, Int)]
    numberTrees [Tree (TypeBase ExtShape Uniqueness)]
    all_res_ts
        all_param_ts' :: [Tree (TypeBase Shape Uniqueness, Int)]
    all_param_ts' = [Tree (TypeBase Shape Uniqueness)]
    -> [Tree (TypeBase Shape Uniqueness, Int)]
    forall a. [Tree a] -> [Tree (a, Int)]
    numberTrees [Tree (TypeBase Shape Uniqueness)]
    all_param_ts
        aliasable_param_ts :: [Tree (TypeBase Shape Uniqueness, Int)]
    aliasable_param_ts = (Tree (TypeBase Shape Uniqueness, Int) -> Bool)
    -> [Tree (TypeBase Shape Uniqueness, Int)]
    -> [Tree (TypeBase Shape Uniqueness, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (((TypeBase Shape Uniqueness, Int) -> Bool)
    -> Tree (TypeBase Shape Uniqueness, Int) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (((TypeBase Shape Uniqueness, Int) -> Bool)
     -> Tree (TypeBase Shape Uniqueness, Int) -> Bool)
    -> ((TypeBase Shape Uniqueness, Int) -> Bool)
    -> Tree (TypeBase Shape Uniqueness, Int)
    -> Bool
    forall a b. (a -> b) -> a -> b
    $ TypeBase Shape Uniqueness -> Bool
    forall shape. TypeBase shape Uniqueness -> Bool
    nonuniqueArray (TypeBase Shape Uniqueness -> Bool)
    -> ((TypeBase Shape Uniqueness, Int) -> TypeBase Shape Uniqueness)
    -> (TypeBase Shape Uniqueness, Int)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypeBase Shape Uniqueness, Int) -> TypeBase Shape Uniqueness
    forall a b. (a, b) -> a
    fst) [Tree (TypeBase Shape Uniqueness, Int)]
    all_param_ts'
        aliasable_res_ts :: [Tree (TypeBase ExtShape Uniqueness, Int)]
    aliasable_res_ts = (Tree (TypeBase ExtShape Uniqueness, Int) -> Bool)
    -> [Tree (TypeBase ExtShape Uniqueness, Int)]
    -> [Tree (TypeBase ExtShape Uniqueness, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (((TypeBase ExtShape Uniqueness, Int) -> Bool)
    -> Tree (TypeBase ExtShape Uniqueness, Int) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (((TypeBase ExtShape Uniqueness, Int) -> Bool)
     -> Tree (TypeBase ExtShape Uniqueness, Int) -> Bool)
    -> ((TypeBase ExtShape Uniqueness, Int) -> Bool)
    -> Tree (TypeBase ExtShape Uniqueness, Int)
    -> Bool
    forall a b. (a -> b) -> a -> b
    $ TypeBase ExtShape Uniqueness -> Bool
    forall shape. TypeBase shape Uniqueness -> Bool
    nonuniqueArray (TypeBase ExtShape Uniqueness -> Bool)
    -> ((TypeBase ExtShape Uniqueness, Int)
        -> TypeBase ExtShape Uniqueness)
    -> (TypeBase ExtShape Uniqueness, Int)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypeBase ExtShape Uniqueness, Int) -> TypeBase ExtShape Uniqueness
    forall a b. (a, b) -> a
    fst) [Tree (TypeBase ExtShape Uniqueness, Int)]
    all_res_ts'
        onRes :: Free [] (TypeBase shape Uniqueness)
    -> [(TypeBase shape Uniqueness, RetAls)]
    onRes (Pure TypeBase shape Uniqueness
    res_t) =
          -- Necessarily a non-array.
          [(TypeBase shape Uniqueness
    res_t, [Int] -> [Int] -> RetAls
    RetAls [Int]
    forall a. Monoid a => a
    mempty [Int]
    forall a. Monoid a => a
    mempty)]
        onRes (Free [Free [] (TypeBase shape Uniqueness)]
    res_ts) =
          [ if TypeBase shape Uniqueness -> Bool
    forall shape. TypeBase shape Uniqueness -> Bool
    nonuniqueArray TypeBase shape Uniqueness
    res_t
              then (TypeBase shape Uniqueness
    res_t, [Int] -> [Int] -> RetAls
    RetAls [Int]
    pals [Int]
    rals)
              else (TypeBase shape Uniqueness
    res_t, RetAls
    forall a. Monoid a => a
    mempty)
            | (TypeBase shape Uniqueness
    res_t, [Int]
    pals, [Int]
    rals) <- [TypeBase shape Uniqueness]
    -> [[Int]]
    -> [[Int]]
    -> [(TypeBase shape Uniqueness, [Int], [Int])]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 (Free [] (TypeBase shape Uniqueness) -> [TypeBase shape Uniqueness]
    forall a. Free [] a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList ([Free [] (TypeBase shape Uniqueness)]
    -> Free [] (TypeBase shape Uniqueness)
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free [Free [] (TypeBase shape Uniqueness)]
    res_ts)) [[Int]]
    palss [[Int]]
    ralss
          ]
          where
            reorder :: [[a]] -> [[a]]
    reorder [] = Int -> [a] -> [[a]]
    forall a. Int -> a -> [a]
    replicate (Free [] (TypeBase shape Uniqueness) -> Int
    forall a. Free [] a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Free [] (TypeBase shape Uniqueness)]
    -> Free [] (TypeBase shape Uniqueness)
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free [Free [] (TypeBase shape Uniqueness)]
    res_ts)) []
            reorder [[a]]
    xs = [[a]] -> [[a]]
    forall a. [[a]] -> [[a]]
    L.transpose [[a]]
    xs
            infer :: t (Tree (a, a)) -> [[a]]
    infer t (Tree (a, a))
    ts =
              [[a]] -> [[a]]
    forall a. [[a]] -> [[a]]
    reorder ([[a]] -> [[a]])
    -> ([Free [] (TypeBase shape Uniqueness, (a, a))] -> [[a]])
    -> [Free [] (TypeBase shape Uniqueness, (a, a))]
    -> [[a]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Free [] (TypeBase shape Uniqueness, (a, a)) -> [a])
    -> [Free [] (TypeBase shape Uniqueness, (a, a))] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Free [] a -> [a]
    forall a. Free [] a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (Free [] a -> [a])
    -> (Free [] (TypeBase shape Uniqueness, (a, a)) -> Free [] a)
    -> Free [] (TypeBase shape Uniqueness, (a, a))
    -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((TypeBase shape Uniqueness, (a, a)) -> a)
    -> Free [] (TypeBase shape Uniqueness, (a, a)) -> Free [] a
    forall a b. (a -> b) -> Free [] a -> Free [] b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a, a) -> a
    forall a b. (a, b) -> b
    snd ((a, a) -> a)
    -> ((TypeBase shape Uniqueness, (a, a)) -> (a, a))
    -> (TypeBase shape Uniqueness, (a, a))
    -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypeBase shape Uniqueness, (a, a)) -> (a, a)
    forall a b. (a, b) -> b
    snd)) ([Free [] (TypeBase shape Uniqueness, (a, a))] -> [[a]])
    -> [Free [] (TypeBase shape Uniqueness, (a, a))] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $
                (Tree (a, a) -> [Free [] (TypeBase shape Uniqueness, (a, a))])
    -> t (Tree (a, a)) -> [Free [] (TypeBase shape Uniqueness, (a, a))]
    forall m a. Monoid m => (a -> m) -> t a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (Free [] (TypeBase shape Uniqueness)
    -> Tree (a, a) -> [Free [] (TypeBase shape Uniqueness, (a, a))]
    forall a b. Tree a -> Tree b -> [Tree (a, b)]
    subtreesMatching ([Free [] (TypeBase shape Uniqueness)]
    -> Free [] (TypeBase shape Uniqueness)
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free [Free [] (TypeBase shape Uniqueness)]
    res_ts)) t (Tree (a, a))
    ts
            palss :: [[Int]]
    palss = [Tree (TypeBase Shape Uniqueness, Int)] -> [[Int]]
    forall {t :: * -> *} {a} {a}.
    Foldable t =>
    t (Tree (a, a)) -> [[a]]
    infer [Tree (TypeBase Shape Uniqueness, Int)]
    aliasable_param_ts
            ralss :: [[Int]]
    ralss = [Tree (TypeBase ExtShape Uniqueness, Int)] -> [[Int]]
    forall {t :: * -> *} {a} {a}.
    Foldable t =>
    t (Tree (a, a)) -> [[a]]
    infer [Tree (TypeBase ExtShape Uniqueness, Int)]
    aliasable_res_ts

    internaliseReturnType ::
      [Tree (I.TypeBase Shape Uniqueness)] ->
      E.ResRetType ->
      [TypeBase shape u] ->
      [(I.TypeBase ExtShape Uniqueness, RetAls)]
    internaliseReturnType :: forall shape u.
    [Tree (TypeBase Shape Uniqueness)]
    -> ResRetType
    -> [TypeBase shape u]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    internaliseReturnType [Tree (TypeBase Shape Uniqueness)]
    paramts (E.RetType [VName]
    dims ResType
    et) [TypeBase shape u]
    ts =
      [TypeBase shape u]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall shape1 u1 shape2 u2 b.
    [TypeBase shape1 u1]
    -> [(TypeBase shape2 u2, b)] -> [(TypeBase shape2 u2, b)]
    fixupKnownTypes [TypeBase shape u]
    ts ([(TypeBase ExtShape Uniqueness, RetAls)]
     -> [(TypeBase ExtShape Uniqueness, RetAls)])
    -> ([Tree (TypeBase ExtShape Uniqueness)]
        -> [(TypeBase ExtShape Uniqueness, RetAls)])
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[(TypeBase ExtShape Uniqueness, RetAls)]]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(TypeBase ExtShape Uniqueness, RetAls)]]
     -> [(TypeBase ExtShape Uniqueness, RetAls)])
    -> ([Tree (TypeBase ExtShape Uniqueness)]
        -> [[(TypeBase ExtShape Uniqueness, RetAls)]])
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tree (TypeBase Shape Uniqueness)]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    inferAliases [Tree (TypeBase Shape Uniqueness)]
    paramts ([Tree (TypeBase ExtShape Uniqueness)]
     -> [(TypeBase ExtShape Uniqueness, RetAls)])
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall a b. (a -> b) -> a -> b
    $
        [VName]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    forall a. [VName] -> InternaliseTypeM a -> a
    runInternaliseTypeM' [VName]
    dims (Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    exts ResType
    et)
      where
        exts :: Map VName Int
    exts = [(VName, Int)] -> Map VName Int
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(VName, Int)] -> Map VName Int)
    -> [(VName, Int)] -> Map VName Int
    forall a b. (a -> b) -> a -> b
    $ [VName] -> [Int] -> [(VName, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [VName]
    dims [Int
    0 ..]

    -- | As 'internaliseReturnType', but returns components of a top-level
    -- tuple type piecemeal.
    internaliseEntryReturnType ::
      [Tree (I.TypeBase Shape Uniqueness)] ->
      E.ResRetType ->
      [[(I.TypeBase ExtShape Uniqueness, RetAls)]]
    internaliseEntryReturnType :: [Tree (TypeBase Shape Uniqueness)]
    -> ResRetType -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    internaliseEntryReturnType [Tree (TypeBase Shape Uniqueness)]
    paramts (E.RetType [VName]
    dims ResType
    et) =
      let et' :: [[Tree (TypeBase ExtShape Uniqueness)]]
    et' = [VName]
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    -> [[Tree (TypeBase ExtShape Uniqueness)]]
    forall a. [VName] -> InternaliseTypeM a -> a
    runInternaliseTypeM' [VName]
    dims (InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
     -> [[Tree (TypeBase ExtShape Uniqueness)]])
    -> ([ResType]
        -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]])
    -> [ResType]
    -> [[Tree (TypeBase ExtShape Uniqueness)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ResType -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> [ResType]
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    exts) ([ResType] -> [[Tree (TypeBase ExtShape Uniqueness)]])
    -> [ResType] -> [[Tree (TypeBase ExtShape Uniqueness)]]
    forall a b. (a -> b) -> a -> b
    $
            case ResType -> Maybe [ResType]
    forall dim as. TypeBase dim as -> Maybe [TypeBase dim as]
    E.isTupleRecord ResType
    et of
              Just [ResType]
    ets | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [ResType] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ResType]
    ets -> [ResType]
    ets
              Maybe [ResType]
    _ -> [ResType
    et]
       in ([[(TypeBase ExtShape Uniqueness, RetAls)]]
     -> [(TypeBase ExtShape Uniqueness, RetAls)])
    -> [[[(TypeBase ExtShape Uniqueness, RetAls)]]]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    forall a b. (a -> b) -> [a] -> [b]
    map [[(TypeBase ExtShape Uniqueness, RetAls)]]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[[(TypeBase ExtShape Uniqueness, RetAls)]]]
     -> [[(TypeBase ExtShape Uniqueness, RetAls)]])
    -> [[[(TypeBase ExtShape Uniqueness, RetAls)]]]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    forall a b. (a -> b) -> a -> b
    $ [[Tree (TypeBase ExtShape Uniqueness)]]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    -> [[[(TypeBase ExtShape Uniqueness, RetAls)]]]
    forall a b. [[a]] -> [b] -> [[b]]
    chunkLike [[Tree (TypeBase ExtShape Uniqueness)]]
    et' ([[(TypeBase ExtShape Uniqueness, RetAls)]]
     -> [[[(TypeBase ExtShape Uniqueness, RetAls)]]])
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    -> [[[(TypeBase ExtShape Uniqueness, RetAls)]]]
    forall a b. (a -> b) -> a -> b
    $ [Tree (TypeBase Shape Uniqueness)]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    inferAliases [Tree (TypeBase Shape Uniqueness)]
    paramts ([Tree (TypeBase ExtShape Uniqueness)]
     -> [[(TypeBase ExtShape Uniqueness, RetAls)]])
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [[(TypeBase ExtShape Uniqueness, RetAls)]]
    forall a b. (a -> b) -> a -> b
    $ [[Tree (TypeBase ExtShape Uniqueness)]]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Tree (TypeBase ExtShape Uniqueness)]]
    et'
      where
        exts :: Map VName Int
    exts = [(VName, Int)] -> Map VName Int
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(VName, Int)] -> Map VName Int)
    -> [(VName, Int)] -> Map VName Int
    forall a b. (a -> b) -> a -> b
    $ [VName] -> [Int] -> [(VName, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [VName]
    dims [Int
    0 ..]

    internaliseCoerceType ::
      E.StructType ->
      [TypeBase shape u] ->
      [I.TypeBase ExtShape Uniqueness]
    internaliseCoerceType :: forall shape u.
    StructType -> [TypeBase shape u] -> [TypeBase ExtShape Uniqueness]
    internaliseCoerceType StructType
    et [TypeBase shape u]
    ts =
      ((TypeBase ExtShape Uniqueness, RetAls)
     -> TypeBase ExtShape Uniqueness)
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    -> [TypeBase ExtShape Uniqueness]
    forall a b. (a -> b) -> [a] -> [b]
    map (TypeBase ExtShape Uniqueness, RetAls)
    -> TypeBase ExtShape Uniqueness
    forall a b. (a, b) -> a
    fst ([(TypeBase ExtShape Uniqueness, RetAls)]
     -> [TypeBase ExtShape Uniqueness])
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    -> [TypeBase ExtShape Uniqueness]
    forall a b. (a -> b) -> a -> b
    $ [Tree (TypeBase Shape Uniqueness)]
    -> ResRetType
    -> [TypeBase shape u]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    forall shape u.
    [Tree (TypeBase Shape Uniqueness)]
    -> ResRetType
    -> [TypeBase shape u]
    -> [(TypeBase ExtShape Uniqueness, RetAls)]
    internaliseReturnType [] ([VName] -> ResType -> ResRetType
    forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
    E.RetType [] (ResType -> ResRetType) -> ResType -> ResRetType
    forall a b. (a -> b) -> a -> b
    $ Uniqueness -> StructType -> ResType
    forall u. Uniqueness -> TypeBase Size u -> ResType
    E.toRes Uniqueness
    E.Nonunique StructType
    et) [TypeBase shape u]
    ts

    internaliseLambdaReturnType ::
      E.ResType ->
      [TypeBase shape u] ->
      InternaliseM [I.TypeBase Shape NoUniqueness]
    internaliseLambdaReturnType :: forall shape u.
    ResType
    -> [TypeBase shape u] -> InternaliseM [TypeBase Shape NoUniqueness]
    internaliseLambdaReturnType ResType
    et [TypeBase shape u]
    ts =
      (TypeBase Shape Uniqueness -> TypeBase Shape NoUniqueness)
    -> [TypeBase Shape Uniqueness] -> [TypeBase Shape NoUniqueness]
    forall a b. (a -> b) -> [a] -> [b]
    map TypeBase Shape Uniqueness -> TypeBase Shape NoUniqueness
    forall shape.
    TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    fromDecl ([TypeBase Shape Uniqueness] -> [TypeBase Shape NoUniqueness])
    -> InternaliseM [TypeBase Shape Uniqueness]
    -> InternaliseM [TypeBase Shape NoUniqueness]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParamType
    -> [TypeBase shape u] -> InternaliseM [TypeBase Shape Uniqueness]
    forall shape u.
    ParamType
    -> [TypeBase shape u] -> InternaliseM [TypeBase Shape Uniqueness]
    internaliseLoopParamType (ResType -> ParamType
    E.resToParam ResType
    et) [TypeBase shape u]
    ts

    internaliseType ::
      E.TypeBase E.Size NoUniqueness ->
      [Tree (I.TypeBase I.ExtShape Uniqueness)]
    internaliseType :: StructType -> [Tree (TypeBase ExtShape Uniqueness)]
    internaliseType =
      InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    forall a. InternaliseTypeM a -> a
    runInternaliseTypeM (InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
     -> [Tree (TypeBase ExtShape Uniqueness)])
    -> (StructType
        -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> StructType
    -> [Tree (TypeBase ExtShape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    forall a. Monoid a => a
    mempty (ResType -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> (StructType -> ResType)
    -> StructType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Uniqueness -> StructType -> ResType
    forall u. Uniqueness -> TypeBase Size u -> ResType
    E.toRes Uniqueness
    E.Nonunique

    newId :: InternaliseTypeM Int
    newId :: InternaliseTypeM Int
    newId = do
      i <- (TypeState -> Int) -> InternaliseTypeM Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TypeState -> Int
    typeCounter
      modify $ \TypeState
    s -> TypeState
    s {typeCounter = i + 1}
      pure i

    internaliseDim ::
      M.Map VName Int ->
      E.Size ->
      InternaliseTypeM ExtSize
    internaliseDim :: Map VName Int -> Size -> InternaliseTypeM (Ext SubExp)
    internaliseDim Map VName Int
    exts Size
    d =
      case Size
    d of
        Size
    e | Size
    e Size -> Size -> Bool
    forall a. Eq a => a -> a -> Bool
    == Size
    E.anySize -> Int -> Ext SubExp
    forall a. Int -> Ext a
    Ext (Int -> Ext SubExp)
    -> InternaliseTypeM Int -> InternaliseTypeM (Ext SubExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> InternaliseTypeM Int
    newId
        (E.IntLit Integer
    n Info StructType
    _ SrcLoc
    _) -> Ext SubExp -> InternaliseTypeM (Ext SubExp)
    forall a. a -> InternaliseTypeM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ext SubExp -> InternaliseTypeM (Ext SubExp))
    -> Ext SubExp -> InternaliseTypeM (Ext SubExp)
    forall a b. (a -> b) -> a -> b
    $ SubExp -> Ext SubExp
    forall a. a -> Ext a
    I.Free (SubExp -> Ext SubExp) -> SubExp -> Ext SubExp
    forall a b. (a -> b) -> a -> b
    $ IntType -> Integer -> SubExp
    intConst IntType
    I.Int64 Integer
    n
        (E.Var QualName VName
    name Info StructType
    _ SrcLoc
    _) -> Ext SubExp -> InternaliseTypeM (Ext SubExp)
    forall a. a -> InternaliseTypeM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ext SubExp -> InternaliseTypeM (Ext SubExp))
    -> Ext SubExp -> InternaliseTypeM (Ext SubExp)
    forall a b. (a -> b) -> a -> b
    $ QualName VName -> Ext SubExp
    namedDim QualName VName
    name
        Size
    e -> [Char] -> InternaliseTypeM (Ext SubExp)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> InternaliseTypeM (Ext SubExp))
    -> [Char] -> InternaliseTypeM (Ext SubExp)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unexpected size expression: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Size -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyString Size
    e
      where
        namedDim :: QualName VName -> Ext SubExp
    namedDim (E.QualName [VName]
    _ VName
    name)
          | Just Int
    x <- VName
    name VName -> Map VName Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    `M.lookup` Map VName Int
    exts = Int -> Ext SubExp
    forall a. Int -> Ext a
    I.Ext Int
    x
          | Bool
    otherwise = SubExp -> Ext SubExp
    forall a. a -> Ext a
    I.Free (SubExp -> Ext SubExp) -> SubExp -> Ext SubExp
    forall a b. (a -> b) -> a -> b
    $ VName -> SubExp
    I.Var VName
    name

    -- | A tree is just an instantiation of the free monad with a list
    -- monad.
    --
    -- The important thing is that we use it to represent the original
    -- structure of arrayss, as this matters for aliasing.  Each 'Free'
    -- constructor corresponds to an array dimension.  Only non-arrays
    -- have a 'Pure' at the top level.  See Note [Alias Inference].
    type Tree = Free []

    internaliseTypeM ::
      M.Map VName Int ->
      E.ResType ->
      InternaliseTypeM [Tree (I.TypeBase ExtShape Uniqueness)]
    internaliseTypeM :: Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    exts ResType
    orig_t =
      case ResType
    orig_t of
        E.Array Uniqueness
    u Shape Size
    shape ScalarTypeBase Size NoUniqueness
    et -> do
          dims <- Shape Size -> InternaliseTypeM [Ext SubExp]
    internaliseShape Shape Size
    shape
          ets <- internaliseTypeM exts $ E.toRes E.Nonunique $ E.Scalar et
          let f TypeBase ExtShape u_unused
    et' = TypeBase ExtShape u_unused
    -> ExtShape -> Uniqueness -> TypeBase ExtShape Uniqueness
    forall shape u_unused u.
    ArrayShape shape =>
    TypeBase shape u_unused -> shape -> u -> TypeBase shape u
    I.arrayOf TypeBase ExtShape u_unused
    et' ([Ext SubExp] -> ExtShape
    forall d. [d] -> ShapeBase d
    Shape [Ext SubExp]
    dims) (Uniqueness -> TypeBase ExtShape Uniqueness)
    -> Uniqueness -> TypeBase ExtShape Uniqueness
    forall a b. (a -> b) -> a -> b
    $ Uniqueness -> Uniqueness
    internaliseUniqueness Uniqueness
    u
          pure [array $ map (fmap f) ets]
        E.Scalar (E.Prim PrimType
    bt) ->
          [Tree (TypeBase ExtShape Uniqueness)]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a. a -> InternaliseTypeM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
    forall (f :: * -> *) a. a -> Free f a
    Pure (TypeBase ExtShape Uniqueness
     -> Tree (TypeBase ExtShape Uniqueness))
    -> TypeBase ExtShape Uniqueness
    -> Tree (TypeBase ExtShape Uniqueness)
    forall a b. (a -> b) -> a -> b
    $ PrimType -> TypeBase ExtShape Uniqueness
    forall shape u. PrimType -> TypeBase shape u
    I.Prim (PrimType -> TypeBase ExtShape Uniqueness)
    -> PrimType -> TypeBase ExtShape Uniqueness
    forall a b. (a -> b) -> a -> b
    $ PrimType -> PrimType
    internalisePrimType PrimType
    bt]
        E.Scalar (E.Record Map Name ResType
    ets)
          -- We map empty records to units, because otherwise arrays of
          -- unit will lose their sizes.
          | Map Name ResType -> Bool
    forall a. Map Name a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Map Name ResType
    ets -> [Tree (TypeBase ExtShape Uniqueness)]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a. a -> InternaliseTypeM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
    forall (f :: * -> *) a. a -> Free f a
    Pure (TypeBase ExtShape Uniqueness
     -> Tree (TypeBase ExtShape Uniqueness))
    -> TypeBase ExtShape Uniqueness
    -> Tree (TypeBase ExtShape Uniqueness)
    forall a b. (a -> b) -> a -> b
    $ PrimType -> TypeBase ExtShape Uniqueness
    forall shape u. PrimType -> TypeBase shape u
    I.Prim PrimType
    I.Unit]
          | Bool
    otherwise ->
              [[Tree (TypeBase ExtShape Uniqueness)]]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Tree (TypeBase ExtShape Uniqueness)]]
     -> [Tree (TypeBase ExtShape Uniqueness)])
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Name, ResType)
     -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> [(Name, ResType)]
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    exts (ResType -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> ((Name, ResType) -> ResType)
    -> (Name, ResType)
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, ResType) -> ResType
    forall a b. (a, b) -> b
    snd) (Map Name ResType -> [(Name, ResType)]
    forall a. Map Name a -> [(Name, a)]
    E.sortFields Map Name ResType
    ets)
        E.Scalar (E.TypeVar Uniqueness
    u QualName VName
    tn [E.TypeArgType StructType
    arr_t])
          | VName -> Int
    baseTag (QualName VName -> VName
    forall vn. QualName vn -> vn
    E.qualLeaf QualName VName
    tn) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    E.maxIntrinsicTag,
            VName -> [Char]
    baseString (QualName VName -> VName
    forall vn. QualName vn -> vn
    E.qualLeaf QualName VName
    tn) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "acc" -> do
              ts <-
                (Tree (TypeBase ExtShape Uniqueness)
     -> [TypeBase Shape NoUniqueness])
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [TypeBase Shape NoUniqueness]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (Free [] (TypeBase Shape NoUniqueness)
    -> [TypeBase Shape NoUniqueness]
    forall a. Free [] a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (Free [] (TypeBase Shape NoUniqueness)
     -> [TypeBase Shape NoUniqueness])
    -> (Tree (TypeBase ExtShape Uniqueness)
        -> Free [] (TypeBase Shape NoUniqueness))
    -> Tree (TypeBase ExtShape Uniqueness)
    -> [TypeBase Shape NoUniqueness]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypeBase ExtShape Uniqueness -> TypeBase Shape NoUniqueness)
    -> Tree (TypeBase ExtShape Uniqueness)
    -> Free [] (TypeBase Shape NoUniqueness)
    forall a b. (a -> b) -> Free [] a -> Free [] b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (TypeBase Shape Uniqueness -> TypeBase Shape NoUniqueness
    forall shape.
    TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    fromDecl (TypeBase Shape Uniqueness -> TypeBase Shape NoUniqueness)
    -> (TypeBase ExtShape Uniqueness -> TypeBase Shape Uniqueness)
    -> TypeBase ExtShape Uniqueness
    -> TypeBase Shape NoUniqueness
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TypeBase ExtShape Uniqueness -> TypeBase Shape Uniqueness
    forall {u}. TypeBase ExtShape u -> TypeBase Shape u
    onAccType))
                  ([Tree (TypeBase ExtShape Uniqueness)]
     -> [TypeBase Shape NoUniqueness])
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    -> InternaliseTypeM [TypeBase Shape NoUniqueness]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    exts (Uniqueness -> StructType -> ResType
    forall u. Uniqueness -> TypeBase Size u -> ResType
    E.toRes Uniqueness
    Nonunique StructType
    arr_t)
              let acc_param = Name -> Int -> VName
    VName Name
    "PLACEHOLDER" Int
    0 -- See mkAccCerts.
                  acc_shape = [SubExp] -> Shape
    forall d. [d] -> ShapeBase d
    Shape [Int -> [TypeBase Shape NoUniqueness] -> SubExp
    forall u. Int -> [TypeBase Shape u] -> SubExp
    arraysSize Int
    0 [TypeBase Shape NoUniqueness]
    ts]
                  u' = Uniqueness -> Uniqueness
    internaliseUniqueness Uniqueness
    u
                  acc_t = VName
    -> Shape
    -> [TypeBase Shape NoUniqueness]
    -> Uniqueness
    -> TypeBase shape Uniqueness
    forall shape u.
    VName
    -> Shape -> [TypeBase Shape NoUniqueness] -> u -> TypeBase shape u
    Acc VName
    acc_param Shape
    acc_shape ((TypeBase Shape NoUniqueness -> TypeBase Shape NoUniqueness)
    -> [TypeBase Shape NoUniqueness] -> [TypeBase Shape NoUniqueness]
    forall a b. (a -> b) -> [a] -> [b]
    map TypeBase Shape NoUniqueness -> TypeBase Shape NoUniqueness
    forall u. TypeBase Shape u -> TypeBase Shape u
    rowType [TypeBase Shape NoUniqueness]
    ts) Uniqueness
    u'
              pure [Pure acc_t]
        E.Scalar E.TypeVar {} ->
          [Char] -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> [Char] -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "internaliseTypeM: cannot handle type variable: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ResType -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyString ResType
    orig_t
        E.Scalar E.Arrow {} ->
          [Char] -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> [Char] -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "internaliseTypeM: cannot handle function type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ResType -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyString ResType
    orig_t
        E.Scalar (E.Sum Map Name [ResType]
    cs) -> do
          (ts, _) <-
            Map Name [Tree (TypeBase ExtShape Uniqueness)]
    -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    internaliseConstructors
              (Map Name [Tree (TypeBase ExtShape Uniqueness)]
     -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])]))
    -> InternaliseTypeM
         (Map Name [Tree (TypeBase ExtShape Uniqueness)])
    -> InternaliseTypeM
         ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([ResType]
     -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> Map Name [ResType]
    -> InternaliseTypeM
         (Map Name [Tree (TypeBase ExtShape Uniqueness)])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map Name a -> f (Map Name b)
    traverse (([[Tree (TypeBase ExtShape Uniqueness)]]
     -> [Tree (TypeBase ExtShape Uniqueness)])
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a b. (a -> b) -> InternaliseTypeM a -> InternaliseTypeM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[Tree (TypeBase ExtShape Uniqueness)]]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
     -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> ([ResType]
        -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]])
    -> [ResType]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ResType -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> [ResType]
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    exts)) Map Name [ResType]
    cs
          pure $ Pure (I.Prim (I.IntType I.Int8)) : ts
      where
        internaliseShape :: Shape Size -> InternaliseTypeM [Ext SubExp]
    internaliseShape = (Size -> InternaliseTypeM (Ext SubExp))
    -> [Size] -> InternaliseTypeM [Ext SubExp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Map VName Int -> Size -> InternaliseTypeM (Ext SubExp)
    internaliseDim Map VName Int
    exts) ([Size] -> InternaliseTypeM [Ext SubExp])
    -> (Shape Size -> [Size])
    -> Shape Size
    -> InternaliseTypeM [Ext SubExp]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Shape Size -> [Size]
    forall dim. Shape dim -> [dim]
    E.shapeDims
        array :: [Free [] a] -> Free [] a
    array [Free [Free [] a]
    ts] = [Free [] a] -> Free [] a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free [Free [] a]
    ts
        array [Free [] a]
    ts = [Free [] a] -> Free [] a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free [Free [] a]
    ts

        onAccType :: TypeBase ExtShape u -> TypeBase Shape u
    onAccType = TypeBase Shape u -> Maybe (TypeBase Shape u) -> TypeBase Shape u
    forall a. a -> Maybe a -> a
    fromMaybe TypeBase Shape u
    forall {a}. a
    bad (Maybe (TypeBase Shape u) -> TypeBase Shape u)
    -> (TypeBase ExtShape u -> Maybe (TypeBase Shape u))
    -> TypeBase ExtShape u
    -> TypeBase Shape u
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TypeBase ExtShape u -> Maybe (TypeBase Shape u)
    forall u. TypeBase ExtShape u -> Maybe (TypeBase Shape u)
    hasStaticShape
        bad :: a
    bad = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "internaliseTypeM Acc: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ResType -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyString ResType
    orig_t

    -- | Only exposed for testing purposes.
    internaliseConstructors ::
      M.Map Name [Tree (I.TypeBase ExtShape Uniqueness)] ->
      ( [Tree (I.TypeBase ExtShape Uniqueness)],
        [(Name, [Int])]
      )
    internaliseConstructors :: Map Name [Tree (TypeBase ExtShape Uniqueness)]
    -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    internaliseConstructors Map Name [Tree (TypeBase ExtShape Uniqueness)]
    cs =
      ([Tree (TypeBase ExtShape Uniqueness)]
     -> (Name, [Tree (TypeBase ExtShape Uniqueness)])
     -> ([Tree (TypeBase ExtShape Uniqueness)], (Name, [Int])))
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [(Name, [Tree (TypeBase ExtShape Uniqueness)])]
    -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    L.mapAccumL [Tree (TypeBase ExtShape Uniqueness)]
    -> (Name, [Tree (TypeBase ExtShape Uniqueness)])
    -> ([Tree (TypeBase ExtShape Uniqueness)], (Name, [Int]))
    forall {t :: * -> *} {shape} {t :: * -> *} {a}.
    (Eq (t (TypeBase shape NoUniqueness)), Foldable t, Foldable t,
     Functor t) =>
    [t (TypeBase shape Uniqueness)]
    -> (a, t (t (TypeBase shape Uniqueness)))
    -> ([t (TypeBase shape Uniqueness)], (a, [Int]))
    onConstructor [Tree (TypeBase ExtShape Uniqueness)]
    forall a. Monoid a => a
    mempty ([(Name, [Tree (TypeBase ExtShape Uniqueness)])]
     -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])]))
    -> [(Name, [Tree (TypeBase ExtShape Uniqueness)])]
    -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    forall a b. (a -> b) -> a -> b
    $ Map Name [Tree (TypeBase ExtShape Uniqueness)]
    -> [(Name, [Tree (TypeBase ExtShape Uniqueness)])]
    forall a. Map Name a -> [(Name, a)]
    E.sortConstrs Map Name [Tree (TypeBase ExtShape Uniqueness)]
    cs
      where
        onConstructor :: [t (TypeBase shape Uniqueness)]
    -> (a, t (t (TypeBase shape Uniqueness)))
    -> ([t (TypeBase shape Uniqueness)], (a, [Int]))
    onConstructor [t (TypeBase shape Uniqueness)]
    ts (a
    c, t (t (TypeBase shape Uniqueness))
    c_ts) =
          let ([(t (TypeBase shape NoUniqueness), Int)]
    _, [Int]
    js, [t (TypeBase shape Uniqueness)]
    new_ts) =
                (([(t (TypeBase shape NoUniqueness), Int)], [Int],
      [t (TypeBase shape Uniqueness)])
     -> t (TypeBase shape Uniqueness)
     -> ([(t (TypeBase shape NoUniqueness), Int)], [Int],
         [t (TypeBase shape Uniqueness)]))
    -> ([(t (TypeBase shape NoUniqueness), Int)], [Int],
        [t (TypeBase shape Uniqueness)])
    -> t (t (TypeBase shape Uniqueness))
    -> ([(t (TypeBase shape NoUniqueness), Int)], [Int],
        [t (TypeBase shape Uniqueness)])
    forall b a. (b -> a -> b) -> b -> t a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ([(t (TypeBase shape NoUniqueness), Int)], [Int],
     [t (TypeBase shape Uniqueness)])
    -> t (TypeBase shape Uniqueness)
    -> ([(t (TypeBase shape NoUniqueness), Int)], [Int],
        [t (TypeBase shape Uniqueness)])
    forall {shape}.
    Eq (t (TypeBase shape NoUniqueness)) =>
    ([(t (TypeBase shape NoUniqueness), Int)], [Int],
     [t (TypeBase shape Uniqueness)])
    -> t (TypeBase shape Uniqueness)
    -> ([(t (TypeBase shape NoUniqueness), Int)], [Int],
        [t (TypeBase shape Uniqueness)])
    f ([t (TypeBase shape NoUniqueness)]
    -> [(t (TypeBase shape NoUniqueness), Int)]
    forall (a :: * -> *) b. Foldable a => [a b] -> [(a b, Int)]
    withOffsets ((t (TypeBase shape Uniqueness) -> t (TypeBase shape NoUniqueness))
    -> [t (TypeBase shape Uniqueness)]
    -> [t (TypeBase shape NoUniqueness)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TypeBase shape Uniqueness -> TypeBase shape NoUniqueness)
    -> t (TypeBase shape Uniqueness) -> t (TypeBase shape NoUniqueness)
    forall a b. (a -> b) -> t a -> t b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    forall shape.
    TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    fromDecl) [t (TypeBase shape Uniqueness)]
    ts), [Int]
    forall a. Monoid a => a
    mempty, [t (TypeBase shape Uniqueness)]
    forall a. Monoid a => a
    mempty) t (t (TypeBase shape Uniqueness))
    c_ts
           in ([t (TypeBase shape Uniqueness)]
    ts [t (TypeBase shape Uniqueness)]
    -> [t (TypeBase shape Uniqueness)]
    -> [t (TypeBase shape Uniqueness)]
    forall a. [a] -> [a] -> [a]
    ++ [t (TypeBase shape Uniqueness)]
    new_ts, (a
    c, [Int]
    js))
          where
            size :: [t a] -> Int
    size = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> ([t a] -> [Int]) -> [t a] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (t a -> Int) -> [t a] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length
            f :: ([(t (TypeBase shape NoUniqueness), Int)], [Int],
     [t (TypeBase shape Uniqueness)])
    -> t (TypeBase shape Uniqueness)
    -> ([(t (TypeBase shape NoUniqueness), Int)], [Int],
        [t (TypeBase shape Uniqueness)])
    f ([(t (TypeBase shape NoUniqueness), Int)]
    ts', [Int]
    js, [t (TypeBase shape Uniqueness)]
    new_ts) t (TypeBase shape Uniqueness)
    t
              | (TypeBase shape Uniqueness -> Bool)
    -> t (TypeBase shape Uniqueness) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all TypeBase shape Uniqueness -> Bool
    forall shape u. TypeBase shape u -> Bool
    primType t (TypeBase shape Uniqueness)
    t,
                Just (t (TypeBase shape NoUniqueness)
    _, Int
    j) <- ((t (TypeBase shape NoUniqueness), Int) -> Bool)
    -> [(t (TypeBase shape NoUniqueness), Int)]
    -> Maybe (t (TypeBase shape NoUniqueness), Int)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((t (TypeBase shape NoUniqueness)
    -> t (TypeBase shape NoUniqueness) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (TypeBase shape Uniqueness -> TypeBase shape NoUniqueness)
    -> t (TypeBase shape Uniqueness) -> t (TypeBase shape NoUniqueness)
    forall a b. (a -> b) -> t a -> t b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    forall shape.
    TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    fromDecl t (TypeBase shape Uniqueness)
    t) (t (TypeBase shape NoUniqueness) -> Bool)
    -> ((t (TypeBase shape NoUniqueness), Int)
        -> t (TypeBase shape NoUniqueness))
    -> (t (TypeBase shape NoUniqueness), Int)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (t (TypeBase shape NoUniqueness), Int)
    -> t (TypeBase shape NoUniqueness)
    forall a b. (a, b) -> a
    fst) [(t (TypeBase shape NoUniqueness), Int)]
    ts' =
                  ( (t (TypeBase shape NoUniqueness), Int)
    -> [(t (TypeBase shape NoUniqueness), Int)]
    -> [(t (TypeBase shape NoUniqueness), Int)]
    forall a. Eq a => a -> [a] -> [a]
    delete ((TypeBase shape Uniqueness -> TypeBase shape NoUniqueness)
    -> t (TypeBase shape Uniqueness) -> t (TypeBase shape NoUniqueness)
    forall a b. (a -> b) -> t a -> t b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    forall shape.
    TypeBase shape Uniqueness -> TypeBase shape NoUniqueness
    fromDecl t (TypeBase shape Uniqueness)
    t, Int
    j) [(t (TypeBase shape NoUniqueness), Int)]
    ts',
                    [Int]
    js [Int] -> [Int] -> [Int]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take (t (TypeBase shape Uniqueness) -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t (TypeBase shape Uniqueness)
    t) [Int
    j ..],
                    [t (TypeBase shape Uniqueness)]
    new_ts
                  )
              | Bool
    otherwise =
                  ( [(t (TypeBase shape NoUniqueness), Int)]
    ts',
                    [Int]
    js [Int] -> [Int] -> [Int]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take (t (TypeBase shape Uniqueness) -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t (TypeBase shape Uniqueness)
    t) [[t (TypeBase shape Uniqueness)] -> Int
    forall {a}. [t a] -> Int
    size [t (TypeBase shape Uniqueness)]
    ts Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [t (TypeBase shape Uniqueness)] -> Int
    forall {a}. [t a] -> Int
    size [t (TypeBase shape Uniqueness)]
    new_ts ..],
                    [t (TypeBase shape Uniqueness)]
    new_ts [t (TypeBase shape Uniqueness)]
    -> [t (TypeBase shape Uniqueness)]
    -> [t (TypeBase shape Uniqueness)]
    forall a. [a] -> [a] -> [a]
    ++ [t (TypeBase shape Uniqueness)
    t]
                  )

    internaliseSumTypeRep ::
      M.Map Name [E.StructType] ->
      ( [I.TypeBase ExtShape Uniqueness],
        [(Name, [Int])]
      )
    internaliseSumTypeRep :: Map Name [StructType]
    -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    internaliseSumTypeRep Map Name [StructType]
    cs =
      ([Tree (TypeBase ExtShape Uniqueness)]
     -> [TypeBase ExtShape Uniqueness])
    -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first ((Tree (TypeBase ExtShape Uniqueness)
     -> [TypeBase ExtShape Uniqueness])
    -> [Tree (TypeBase ExtShape Uniqueness)]
    -> [TypeBase ExtShape Uniqueness]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Tree (TypeBase ExtShape Uniqueness)
    -> [TypeBase ExtShape Uniqueness]
    forall a. Free [] a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList) (([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
     -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])]))
    -> (InternaliseTypeM
          ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
        -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])]))
    -> InternaliseTypeM
         ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InternaliseTypeM
      ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    forall a. InternaliseTypeM a -> a
    runInternaliseTypeM (InternaliseTypeM
       ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
     -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])]))
    -> InternaliseTypeM
         ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    forall a b. (a -> b) -> a -> b
    $
        Map Name [Tree (TypeBase ExtShape Uniqueness)]
    -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    internaliseConstructors
          (Map Name [Tree (TypeBase ExtShape Uniqueness)]
     -> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])]))
    -> InternaliseTypeM
         (Map Name [Tree (TypeBase ExtShape Uniqueness)])
    -> InternaliseTypeM
         ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([StructType]
     -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> Map Name [StructType]
    -> InternaliseTypeM
         (Map Name [Tree (TypeBase ExtShape Uniqueness)])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map Name a -> f (Map Name b)
    traverse (([[Tree (TypeBase ExtShape Uniqueness)]]
     -> [Tree (TypeBase ExtShape Uniqueness)])
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall a b. (a -> b) -> InternaliseTypeM a -> InternaliseTypeM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[Tree (TypeBase ExtShape Uniqueness)]]
    -> [Tree (TypeBase ExtShape Uniqueness)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
     -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> ([StructType]
        -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]])
    -> [StructType]
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StructType
     -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> [StructType]
    -> InternaliseTypeM [[Tree (TypeBase ExtShape Uniqueness)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Map VName Int
    -> ResType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    internaliseTypeM Map VName Int
    forall a. Monoid a => a
    mempty (ResType -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)])
    -> (StructType -> ResType)
    -> StructType
    -> InternaliseTypeM [Tree (TypeBase ExtShape Uniqueness)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Uniqueness -> StructType -> ResType
    forall u. Uniqueness -> TypeBase Size u -> ResType
    E.toRes Uniqueness
    E.Nonunique)) Map Name [StructType]
    cs

    internaliseSumType ::
      M.Map Name [E.StructType] ->
      InternaliseM
        ( [I.TypeBase ExtShape Uniqueness],
          [(Name, [Int])]
        )
    internaliseSumType :: Map Name [StructType]
    -> InternaliseM ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    internaliseSumType =
      ([TypeBase ExtShape Uniqueness]
     -> InternaliseM [TypeBase ExtShape Uniqueness])
    -> ([(Name, [Int])] -> InternaliseM [(Name, [Int])])
    -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    -> InternaliseM ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    forall (f :: * -> *) a c b d.
    Applicative f =>
    (a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
    forall (t :: * -> * -> *) (f :: * -> *) a c b d.
    (Bitraversable t, Applicative f) =>
    (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
    bitraverse ((TypeBase ExtShape Uniqueness
     -> InternaliseM (TypeBase ExtShape Uniqueness))
    -> [TypeBase ExtShape Uniqueness]
    -> InternaliseM [TypeBase ExtShape Uniqueness]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TypeBase ExtShape Uniqueness
    -> InternaliseM (TypeBase ExtShape Uniqueness)
    forall shape u. TypeBase shape u -> InternaliseM (TypeBase shape u)
    mkAccCerts) [(Name, [Int])] -> InternaliseM [(Name, [Int])]
    forall a. a -> InternaliseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (([TypeBase ExtShape Uniqueness], [(Name, [Int])])
     -> InternaliseM ([TypeBase ExtShape Uniqueness], [(Name, [Int])]))
    -> (Map Name [StructType]
        -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])]))
    -> Map Name [StructType]
    -> InternaliseM ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Name [StructType]
    -> ([TypeBase ExtShape Uniqueness], [(Name, [Int])])
    internaliseSumTypeRep

    -- | How many core language values are needed to represent one source
    -- language value of the given type?
    internalisedTypeSize :: E.TypeBase E.Size als -> Int
    -- A few special cases for performance.
    internalisedTypeSize :: forall als. TypeBase Size als -> Int
    internalisedTypeSize (E.Scalar (E.Prim PrimType
    _)) = Int
    1
    internalisedTypeSize (E.Array als
    _ Shape Size
    _ (E.Prim PrimType
    _)) = Int
    1
    internalisedTypeSize TypeBase Size als
    t = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Tree (TypeBase ExtShape Uniqueness) -> Int)
    -> [Tree (TypeBase ExtShape Uniqueness)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Tree (TypeBase ExtShape Uniqueness) -> Int
    forall a. Free [] a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Tree (TypeBase ExtShape Uniqueness)] -> [Int])
    -> [Tree (TypeBase ExtShape Uniqueness)] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ StructType -> [Tree (TypeBase ExtShape Uniqueness)]
    internaliseType (StructType -> [Tree (TypeBase ExtShape Uniqueness)])
    -> StructType -> [Tree (TypeBase ExtShape Uniqueness)]
    forall a b. (a -> b) -> a -> b
    $ TypeBase Size als -> StructType
    forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
    E.toStruct TypeBase Size als
    t

    -- | Convert an external primitive to an internal primitive.
    internalisePrimType :: E.PrimType -> I.PrimType
    internalisePrimType :: PrimType -> PrimType
    internalisePrimType (E.Signed IntType
    t) = IntType -> PrimType
    I.IntType IntType
    t
    internalisePrimType (E.Unsigned IntType
    t) = IntType -> PrimType
    I.IntType IntType
    t
    internalisePrimType (E.FloatType FloatType
    t) = FloatType -> PrimType
    I.FloatType FloatType
    t
    internalisePrimType PrimType
    E.Bool = PrimType
    I.Bool

    -- | Convert an external primitive value to an internal primitive value.
    internalisePrimValue :: E.PrimValue -> I.PrimValue
    internalisePrimValue :: PrimValue -> PrimValue
    internalisePrimValue (E.SignedValue IntValue
    v) = IntValue -> PrimValue
    I.IntValue IntValue
    v
    internalisePrimValue (E.UnsignedValue IntValue
    v) = IntValue -> PrimValue
    I.IntValue IntValue
    v
    internalisePrimValue (E.FloatValue FloatValue
    v) = FloatValue -> PrimValue
    I.FloatValue FloatValue
    v
    internalisePrimValue (E.BoolValue Bool
    b) = Bool -> PrimValue
    I.BoolValue Bool
    b

    -- Note [Alias Inference]
    --
    -- The core language requires us to precisely indicate the aliasing of
    -- function results (the RetAls type).  This is a problem when coming
    -- from the source language, where it is implicit: a non-unique
    -- function return value aliases every function argument.  The problem
    -- now occurs because the core language uses a different value
    -- representation than the source language - in particular, we do not
    -- have arrays of tuples. E.g. @([]i32,[]i32)@ and @[](i32,i32)@ both
    -- have the same core representation, but their implications for
    -- aliasing are different.
    --
    --
    -- To understand why this is a problem, consider a source program
    --
    --     def id (x: [](i32,i32)) = x
    --
    --     def f n =
    --       let x = replicate n (0,0)
    --       let x' = id x
    --       let x'' = x' with [0] = (1,1)
    --       in x''
    --
    -- With the core language value representation, it will be this:
    --
    --   def id (x1: []i32) (x2: []i32) = (x1,x2)
    --
    --   def f n =
    --     let x1 = replicate n 0
    --     let x2 = replicate n 0
    --     let (x1', x2') = id x1 x2
    --     let x1'' = x1' with [0] = 1
    --     let x2'' = x2' with [0] = 1
    --     in (x1'', x2'')
    --
    -- The results of 'id' alias *both* of the arguments, so x1' aliases
    -- x1 and x2, and x2' also aliases x1 and x2.  This means that the
    -- first with-expression will consume all of x1/x2/x1'/x2', and then
    -- the second with-expression is a type error, as it references a
    -- consumed variable.
    --
    -- Our solution is to deduce the possible aliasing such that
    -- components that originally constituted the same array-of-tuples are
    -- not aliased.  The main complexity is that we have to keep
    -- information on the original (source) type structure around for a
    -- while.  This is done with the Tree type.