{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.CodeGen.Base
-- Copyright   : [2015..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.CodeGen.Base (

  -- References
  Name(..),
  local, global,

  -- Arrays
  irArray,
  mutableArray,
  delayedArray,

  -- Functions & parameters
  call,
  parameter, scalarParameter, ptrParameter,
  envParam,
  arrayParam,

) where

import LLVM.AST.Type.AddrSpace
import LLVM.AST.Type.Constant
import LLVM.AST.Type.Downcast
import LLVM.AST.Type.Function
import LLVM.AST.Type.Global
import LLVM.AST.Type.InlineAssembly
import LLVM.AST.Type.Instruction
import LLVM.AST.Type.Instruction.Volatile
import LLVM.AST.Type.Name
import LLVM.AST.Type.Operand
import LLVM.AST.Type.Representation

import Data.Array.Accelerate.LLVM.CodeGen.Environment
import Data.Array.Accelerate.LLVM.CodeGen.IR
import Data.Array.Accelerate.LLVM.CodeGen.Monad
import Data.Array.Accelerate.LLVM.CodeGen.Sugar
import Data.Array.Accelerate.Representation.Array                   ( Array, ArrayR(..) )
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Type
import {-# SOURCE #-} Data.Array.Accelerate.LLVM.CodeGen.Exp

import qualified LLVM.AST.Global                                    as LLVM

import Data.Monoid
import Data.String
import Text.Printf
import qualified Data.IntMap                                        as IM
import Prelude                                                      as P


-- References
-- ----------

local :: TypeR a -> Name a -> Operands a
local :: TypeR a -> Name a -> Operands a
local  TypeR a
tp Name a
n = TypeR a
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands a
forall t.
TypeR t
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands t
travTypeToOperands TypeR a
tp (\ScalarType s
t Int
i -> Type s -> Name s -> Operand s
forall a. Type a -> Name a -> Operand a
LocalReference (PrimType s -> Type s
forall a. PrimType a -> Type a
PrimType (ScalarType s -> PrimType s
forall a. ScalarType a -> PrimType a
ScalarPrimType ScalarType s
t)) (Name a -> Int -> Name s
forall t t'. Name t -> Int -> Name t'
rename Name a
n Int
i))

global :: TypeR a -> Name a -> Operands a
global :: TypeR a -> Name a -> Operands a
global TypeR a
tp Name a
n = TypeR a
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands a
forall t.
TypeR t
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands t
travTypeToOperands TypeR a
tp (\ScalarType s
t Int
i -> Constant s -> Operand s
forall a. Constant a -> Operand a
ConstantOperand (Type s -> Name s -> Constant s
forall a. Type a -> Name a -> Constant a
GlobalReference (PrimType s -> Type s
forall a. PrimType a -> Type a
PrimType (ScalarType s -> PrimType s
forall a. ScalarType a -> PrimType a
ScalarPrimType ScalarType s
t)) (Name a -> Int -> Name s
forall t t'. Name t -> Int -> Name t'
rename Name a
n Int
i)))


-- Generating names for things
-- ---------------------------

-- | Names of array data components
--
arrayName :: Name (Array sh e) -> Int -> Name e'        -- for the i-th component of the ArrayData
arrayName :: Name (Array sh e) -> Int -> Name e'
arrayName (Name ShortByteString
n)   Int
i = ShortByteString -> Name e'
forall a. ShortByteString -> Name a
Name (ShortByteString
n ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> String -> ShortByteString
forall a. IsString a => String -> a
fromString (String -> Int -> String
forall r. PrintfType r => String -> r
printf   String
".ad%d"   Int
i))
arrayName (UnName Word
n) Int
i = ShortByteString -> Name e'
forall a. ShortByteString -> Name a
Name (     String -> ShortByteString
forall a. IsString a => String -> a
fromString (String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d.ad%d" Word
n Int
i))

-- | Names of shape components
--
shapeName :: Name (Array sh e) -> Int -> Name sh'       -- for the i-th component of the shape structure
shapeName :: Name (Array sh e) -> Int -> Name sh'
shapeName (Name ShortByteString
n)   Int
i = ShortByteString -> Name sh'
forall a. ShortByteString -> Name a
Name (ShortByteString
n ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> String -> ShortByteString
forall a. IsString a => String -> a
fromString (String -> Int -> String
forall r. PrintfType r => String -> r
printf   String
".sh%d"   Int
i))
shapeName (UnName Word
n) Int
i = ShortByteString -> Name sh'
forall a. ShortByteString -> Name a
Name (     String -> ShortByteString
forall a. IsString a => String -> a
fromString (String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d.sh%d" Word
n Int
i))

-- | Names combined with traversing
--
rename :: Name t -> Int -> Name t'                      -- for the i-th component of the named variable
rename :: Name t -> Int -> Name t'
rename (Name   ShortByteString
n) Int
i = ShortByteString -> Name t'
forall a. ShortByteString -> Name a
Name (ShortByteString
n ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> String -> ShortByteString
forall a. IsString a => String -> a
fromString (String -> Int -> String
forall r. PrintfType r => String -> r
printf    String
"%d"   Int
i))
rename (UnName Word
n) Int
i = ShortByteString -> Name t'
forall a. ShortByteString -> Name a
Name (     String -> ShortByteString
forall a. IsString a => String -> a
fromString (String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d.%d" Word
n Int
i))


-- | Names of array data elements
--
{-# INLINEABLE irArray #-}
irArray
    :: ArrayR  (Array sh e)
    -> Name    (Array sh e)
    -> IRArray (Array sh e)
irArray :: ArrayR (Array sh e) -> Name (Array sh e) -> IRArray (Array sh e)
irArray repr :: ArrayR (Array sh e)
repr@(ArrayR ShapeR sh
shr TypeR e
tp) Name (Array sh e)
n
  = ArrayR (Array sh e)
-> Operands sh
-> Operands e
-> AddrSpace
-> Volatility
-> IRArray (Array sh e)
forall sh e.
ArrayR (Array sh e)
-> Operands sh
-> Operands e
-> AddrSpace
-> Volatility
-> IRArray (Array sh e)
IRArray ArrayR (Array sh e)
repr
            (TypeR sh
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands sh
forall t.
TypeR t
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands t
travTypeToOperands (ShapeR sh -> TypeR sh
forall sh. ShapeR sh -> TypeR sh
shapeType ShapeR sh
shr) (\ScalarType s
t Int
i -> Type s -> Name s -> Operand s
forall a. Type a -> Name a -> Operand a
LocalReference (PrimType s -> Type s
forall a. PrimType a -> Type a
PrimType (ScalarType s -> PrimType s
forall a. ScalarType a -> PrimType a
ScalarPrimType ScalarType s
t)) (Name (Array sh e) -> Int -> Name s
forall sh e sh'. Name (Array sh e) -> Int -> Name sh'
shapeName Name (Array sh e)
n Int
i)))
            (TypeR e
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands e
forall t.
TypeR t
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands t
travTypeToOperands TypeR e
tp              (\ScalarType s
t Int
i -> Type s -> Name s -> Operand s
forall a. Type a -> Name a -> Operand a
LocalReference (PrimType s -> Type s
forall a. PrimType a -> Type a
PrimType (ScalarType s -> PrimType s
forall a. ScalarType a -> PrimType a
ScalarPrimType ScalarType s
t)) (Name (Array sh e) -> Int -> Name s
forall sh e sh'. Name (Array sh e) -> Int -> Name sh'
arrayName Name (Array sh e)
n Int
i)))
            AddrSpace
defaultAddrSpace
            Volatility
NonVolatile

-- | Generate typed local names for array data components as well as function
-- parameters to bind those names
--
{-# INLINEABLE mutableArray #-}
mutableArray
    :: ArrayR (Array sh e)
    -> Name (Array sh e)
    -> (IRArray (Array sh e), [LLVM.Parameter])
mutableArray :: ArrayR (Array sh e)
-> Name (Array sh e) -> (IRArray (Array sh e), [Parameter])
mutableArray ArrayR (Array sh e)
repr Name (Array sh e)
name =
  ( ArrayR (Array sh e) -> Name (Array sh e) -> IRArray (Array sh e)
forall sh e.
ArrayR (Array sh e) -> Name (Array sh e) -> IRArray (Array sh e)
irArray ArrayR (Array sh e)
repr Name (Array sh e)
name
  , ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
forall sh e.
ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
arrayParam ArrayR (Array sh e)
repr Name (Array sh e)
name )

-- | Generate a delayed array representation for input arrays which come in
-- either delayed (fused) or manifest representation.
--
{-# INLINEABLE delayedArray #-}
delayedArray
    :: Name (Array sh e)
    -> MIRDelayed arch aenv (Array sh e)
    -> (IRDelayed arch aenv (Array sh e), [LLVM.Parameter])
delayedArray :: Name (Array sh e)
-> MIRDelayed arch aenv (Array sh e)
-> (IRDelayed arch aenv (Array sh e), [Parameter])
delayedArray Name (Array sh e)
name = \case
  IRDelayedJust IRDelayed arch aenv (Array sh e)
a -> (IRDelayed arch aenv (Array sh e)
a, [])
  IRDelayedNothing ArrayR (Array sh e)
repr ->
    let (IRArray (Array sh e)
arr, [Parameter]
param) = ArrayR (Array sh e)
-> Name (Array sh e) -> (IRArray (Array sh e), [Parameter])
forall sh e.
ArrayR (Array sh e)
-> Name (Array sh e) -> (IRArray (Array sh e), [Parameter])
mutableArray ArrayR (Array sh e)
repr Name (Array sh e)
name
    in ( IRDelayed :: forall sh e arch aenv.
ArrayR (Array sh e)
-> IRExp arch aenv sh
-> IRFun1 arch aenv (sh -> e)
-> IRFun1 arch aenv (Int -> e)
-> IRDelayed arch aenv (Array sh e)
IRDelayed { delayedRepr :: ArrayR (Array sh e)
delayedRepr        = ArrayR (Array sh e)
repr
                  , delayedExtent :: IRExp arch aenv sh
delayedExtent      = Operands sh -> IRExp arch aenv sh
forall (m :: * -> *) a. Monad m => a -> m a
return (IRArray (Array sh e) -> Operands sh
forall sh e. IRArray (Array sh e) -> Operands sh
irArrayShape IRArray (Array sh e)
arr)
                  , delayedIndex :: IRFun1 arch aenv (sh -> e)
delayedIndex       = (Operands sh -> IROpenExp arch ((), sh) aenv e)
-> IRFun1 arch aenv (sh -> e)
forall a arch env aenv b.
(Operands a -> IROpenExp arch (env, a) aenv b)
-> IROpenFun1 arch env aenv (a -> b)
IRFun1 (IRArray (Array sh e)
-> Operands sh -> IROpenExp arch ((), sh) aenv e
forall sh e arch env aenv.
IRArray (Array sh e) -> Operands sh -> IROpenExp arch env aenv e
indexArray IRArray (Array sh e)
arr)
                  , delayedLinearIndex :: IRFun1 arch aenv (Int -> e)
delayedLinearIndex = (Operands Int -> IROpenExp arch ((), sh) aenv e)
-> IRFun1 arch aenv (Int -> e)
forall a arch env aenv b.
(Operands a -> IROpenExp arch (env, a) aenv b)
-> IROpenFun1 arch env aenv (a -> b)
IRFun1 (IRArray (Array sh e)
-> Operands Int -> IROpenExp arch ((), sh) aenv e
forall sh e arch env aenv.
IRArray (Array sh e) -> Operands Int -> IROpenExp arch env aenv e
linearIndexArray IRArray (Array sh e)
arr)
                  }
      , [Parameter]
param
      )

{-# INLINEABLE travTypeToList #-}
travTypeToList
    :: forall tp a.
       TypeR tp
    -> (forall s. ScalarType s -> Int -> a)
    -> [a]
travTypeToList :: TypeR tp -> (forall s. ScalarType s -> Int -> a) -> [a]
travTypeToList TypeR tp
tp forall s. ScalarType s -> Int -> a
f = (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Int, [a]) -> [a]) -> (Int, [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ TypeR tp -> Int -> (Int, [a])
forall s. TypeR s -> Int -> (Int, [a])
go TypeR tp
tp Int
0
  where
    -- DANGER: [1] must traverse in the same order as [2]
    go :: TypeR s -> Int -> (Int, [a])
    go :: TypeR s -> Int -> (Int, [a])
go TypeR s
TupRunit         Int
i = (Int
i,   [])
    go (TupRsingle ScalarType s
t')  Int
i = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, [ScalarType s -> Int -> a
forall s. ScalarType s -> Int -> a
f ScalarType s
t' Int
i])
    go (TupRpair TupR ScalarType a1
t2 TupR ScalarType b
t1) Int
i = let (Int
i1, [a]
r1) = TupR ScalarType b -> Int -> (Int, [a])
forall s. TypeR s -> Int -> (Int, [a])
go TupR ScalarType b
t1 Int
i
                                (Int
i2, [a]
r2) = TupR ScalarType a1 -> Int -> (Int, [a])
forall s. TypeR s -> Int -> (Int, [a])
go TupR ScalarType a1
t2 Int
i1
                            in
                            (Int
i2, [a]
r2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
r1)

{-# INLINEABLE travTypeToOperands #-}
travTypeToOperands
    :: TypeR t
    -> (forall s. ScalarType s -> Int -> Operand s)
    -> Operands t
travTypeToOperands :: TypeR t
-> (forall s. ScalarType s -> Int -> Operand s) -> Operands t
travTypeToOperands TypeR t
tp forall s. ScalarType s -> Int -> Operand s
f = (Int, Operands t) -> Operands t
forall a b. (a, b) -> b
snd ((Int, Operands t) -> Operands t)
-> (Int, Operands t) -> Operands t
forall a b. (a -> b) -> a -> b
$ TypeR t -> Int -> (Int, Operands t)
forall s. TypeR s -> Int -> (Int, Operands s)
go TypeR t
tp Int
0
  where
    -- DANGER: [2] must traverse in the same order as [1]
    go :: TypeR s -> Int -> (Int, Operands s)
    go :: TypeR s -> Int -> (Int, Operands s)
go TypeR s
TupRunit         Int
i = (Int
i,   Operands s
Operands ()
OP_Unit)
    go (TupRsingle ScalarType s
t')  Int
i = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, ScalarType s -> Operand s -> Operands s
forall (dict :: * -> *) a.
(IROP dict, HasCallStack) =>
dict a -> Operand a -> Operands a
ir ScalarType s
t' (Operand s -> Operands s) -> Operand s -> Operands s
forall a b. (a -> b) -> a -> b
$ ScalarType s -> Int -> Operand s
forall s. ScalarType s -> Int -> Operand s
f ScalarType s
t' Int
i)
    go (TupRpair TupR ScalarType a1
t2 TupR ScalarType b
t1) Int
i = let (Int
i1, Operands b
r1) = TupR ScalarType b -> Int -> (Int, Operands b)
forall s. TypeR s -> Int -> (Int, Operands s)
go TupR ScalarType b
t1 Int
i
                                (Int
i2, Operands a1
r2) = TupR ScalarType a1 -> Int -> (Int, Operands a1)
forall s. TypeR s -> Int -> (Int, Operands s)
go TupR ScalarType a1
t2 Int
i1
                            in
                            (Int
i2, Operands a1 -> Operands b -> Operands (a1, b)
forall a b. Operands a -> Operands b -> Operands (a, b)
OP_Pair Operands a1
r2 Operands b
r1)

-- travTypeToOperandsPtr
--     :: forall t. Elt t
--     => AddrSpace
--     -> t {- dummy -}
--     -> (forall s. ScalarType s -> Int -> Operand (Ptr s))
--     -> Operands (Ptr t)
-- travTypeToOperandsPtr as t f = snd $ go (eltType @t) 0
--   where
--     -- DANGER: [2] must traverse in the same order as [1]
--     -- go :: TypeR s -> Int -> (Int, Operands (Ptr s))
--     go :: TypeR (EltRepr s) -> Int -> (Int, Operands (EltRepr (Ptr s)))   -- TLM: ugh ):
--     go TypeRunit         i = (i,   OP_Unit)
--     go (TypeRscalar t')  i = (i+1, ir (PtrPrimType t' as) $ f t' i)
--     go (TypeRpair t2 t1) i = let (i1, r1) = go t1 i
--                                  (i2, r2) = go t2 i1
--                              in
--                              (i2, OP_Pair r2 r1)


-- Function parameters
-- -------------------

-- | Call a global function. The function declaration is inserted into the
-- symbol table.
--
call :: GlobalFunction args t -> [FunctionAttribute] -> CodeGen arch (Operands t)
call :: GlobalFunction args t
-> [FunctionAttribute] -> CodeGen arch (Operands t)
call GlobalFunction args t
f [FunctionAttribute]
attrs = do
  let decl :: Global
decl      = (GlobalFunction args t -> Global
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast GlobalFunction args t
f) { functionAttributes :: [Either GroupID FunctionAttribute]
LLVM.functionAttributes = [Either GroupID FunctionAttribute]
-> [Either GroupID FunctionAttribute]
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast [Either GroupID FunctionAttribute]
attrs' }
      attrs' :: [Either GroupID FunctionAttribute]
attrs'    = (FunctionAttribute -> Either GroupID FunctionAttribute)
-> [FunctionAttribute] -> [Either GroupID FunctionAttribute]
forall a b. (a -> b) -> [a] -> [b]
map FunctionAttribute -> Either GroupID FunctionAttribute
forall a b. b -> Either a b
Right [FunctionAttribute]
attrs
      --
      go :: GlobalFunction args t -> Function (Either InlineAssembly Label) args t
      go :: GlobalFunction args t
-> Function (Either InlineAssembly Label) args t
go (Body Type t
t Maybe TailCall
k Label
l) = Type t
-> Maybe TailCall
-> Either InlineAssembly Label
-> Function (Either InlineAssembly Label) '[] t
forall r kind.
Type r -> Maybe TailCall -> kind -> Function kind '[] r
Body Type t
t Maybe TailCall
k (Label -> Either InlineAssembly Label
forall a b. b -> Either a b
Right Label
l)
      go (Lam PrimType a
t Operand a
x Function Label args t
l)  = PrimType a
-> Operand a
-> Function (Either InlineAssembly Label) args t
-> Function (Either InlineAssembly Label) (a : args) t
forall a kind (args :: [*]) t.
PrimType a
-> Operand a -> Function kind args t -> Function kind (a : args) t
Lam PrimType a
t Operand a
x (Function Label args t
-> Function (Either InlineAssembly Label) args t
forall (args :: [*]) t.
GlobalFunction args t
-> Function (Either InlineAssembly Label) args t
go Function Label args t
l)
  --
  Global -> CodeGen arch ()
forall arch. HasCallStack => Global -> CodeGen arch ()
declare Global
decl
  Instruction t -> CodeGen arch (Operands t)
forall a arch.
HasCallStack =>
Instruction a -> CodeGen arch (Operands a)
instr (Function (Either InlineAssembly Label) args t
-> [Either GroupID FunctionAttribute] -> Instruction t
forall (args :: [*]) t.
Function (Either InlineAssembly Label) args t
-> [Either GroupID FunctionAttribute] -> Instruction t
Call (GlobalFunction args t
-> Function (Either InlineAssembly Label) args t
forall (args :: [*]) t.
GlobalFunction args t
-> Function (Either InlineAssembly Label) args t
go GlobalFunction args t
f) [Either GroupID FunctionAttribute]
attrs')


parameter :: TypeR t -> Name t -> [LLVM.Parameter]
parameter :: TypeR t -> Name t -> [Parameter]
parameter TypeR t
tp Name t
n = TypeR t
-> (forall s. ScalarType s -> Int -> Parameter) -> [Parameter]
forall tp a.
TypeR tp -> (forall s. ScalarType s -> Int -> a) -> [a]
travTypeToList TypeR t
tp (\ScalarType s
s Int
i -> ScalarType s -> Name s -> Parameter
forall t. ScalarType t -> Name t -> Parameter
scalarParameter ScalarType s
s (Name t -> Int -> Name s
forall t t'. Name t -> Int -> Name t'
rename Name t
n Int
i))

scalarParameter :: ScalarType t -> Name t -> LLVM.Parameter
scalarParameter :: ScalarType t -> Name t -> Parameter
scalarParameter ScalarType t
t Name t
x = Parameter t -> Parameter
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast (PrimType t -> Name t -> Parameter t
forall a. PrimType a -> Name a -> Parameter a
Parameter (ScalarType t -> PrimType t
forall a. ScalarType a -> PrimType a
ScalarPrimType ScalarType t
t) Name t
x)

ptrParameter :: ScalarType t -> Name (Ptr t) -> LLVM.Parameter
ptrParameter :: ScalarType t -> Name (Ptr t) -> Parameter
ptrParameter ScalarType t
t Name (Ptr t)
x = Parameter (Ptr t) -> Parameter
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast (PrimType (Ptr t) -> Name (Ptr t) -> Parameter (Ptr t)
forall a. PrimType a -> Name a -> Parameter a
Parameter (PrimType t -> AddrSpace -> PrimType (Ptr t)
forall a. PrimType a -> AddrSpace -> PrimType (Ptr a)
PtrPrimType (ScalarType t -> PrimType t
forall a. ScalarType a -> PrimType a
ScalarPrimType ScalarType t
t) AddrSpace
defaultAddrSpace) Name (Ptr t)
x)


-- | Unpack the array environment into a set of input parameters to a function.
-- The environment here refers only to the actual free array variables that are
-- accessed by the function.
--
envParam :: forall aenv. Gamma aenv -> [LLVM.Parameter]
envParam :: Gamma aenv -> [Parameter]
envParam Gamma aenv
aenv = ((Label, Idx' aenv) -> [Parameter])
-> [(Label, Idx' aenv)] -> [Parameter]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Label ShortByteString
n, Idx' ArrayR (Array sh e)
repr Idx aenv (Array sh e)
_) -> ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
forall sh e.
ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
toParam ArrayR (Array sh e)
repr (ShortByteString -> Name (Array sh e)
forall a. ShortByteString -> Name a
Name ShortByteString
n)) (Gamma aenv -> [(Label, Idx' aenv)]
forall a. IntMap a -> [a]
IM.elems Gamma aenv
aenv)
  where
    toParam :: ArrayR (Array sh e) -> Name (Array sh e) -> [LLVM.Parameter]
    toParam :: ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
toParam ArrayR (Array sh e)
repr Name (Array sh e)
name = ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
forall sh e.
ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
arrayParam ArrayR (Array sh e)
repr Name (Array sh e)
name


-- | Generate function parameters for an Array with given base name.
--
{-# INLINEABLE arrayParam #-}
arrayParam
    :: ArrayR (Array sh e)
    -> Name (Array sh e)
    -> [LLVM.Parameter]
arrayParam :: ArrayR (Array sh e) -> Name (Array sh e) -> [Parameter]
arrayParam (ArrayR ShapeR sh
shr TypeR e
tp) Name (Array sh e)
name = [Parameter]
ad [Parameter] -> [Parameter] -> [Parameter]
forall a. [a] -> [a] -> [a]
++ [Parameter]
sh
  where
    ad :: [Parameter]
ad = TypeR e
-> (forall s. ScalarType s -> Int -> Parameter) -> [Parameter]
forall tp a.
TypeR tp -> (forall s. ScalarType s -> Int -> a) -> [a]
travTypeToList TypeR e
tp              (\ScalarType s
t Int
i -> ScalarType s -> Name (Ptr s) -> Parameter
forall t. ScalarType t -> Name (Ptr t) -> Parameter
ptrParameter    ScalarType s
t (Name (Array sh e) -> Int -> Name (Ptr s)
forall sh e sh'. Name (Array sh e) -> Int -> Name sh'
arrayName Name (Array sh e)
name Int
i))
    sh :: [Parameter]
sh = TypeR sh
-> (forall s. ScalarType s -> Int -> Parameter) -> [Parameter]
forall tp a.
TypeR tp -> (forall s. ScalarType s -> Int -> a) -> [a]
travTypeToList (ShapeR sh -> TypeR sh
forall sh. ShapeR sh -> TypeR sh
shapeType ShapeR sh
shr) (\ScalarType s
t Int
i -> ScalarType s -> Name s -> Parameter
forall t. ScalarType t -> Name t -> Parameter
scalarParameter ScalarType s
t (Name (Array sh e) -> Int -> Name s
forall sh e sh'. Name (Array sh e) -> Int -> Name sh'
shapeName Name (Array sh e)
name Int
i))