{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Futhark.Optimise.ArrayShortCircuiting.DataStructs
( Coalesced (..),
CoalescedKind (..),
ArrayMemBound (..),
AllocTab,
HasMemBlock,
ScalarTab,
CoalsTab,
ScopeTab,
CoalsEntry (..),
FreeVarSubsts,
LmadRef,
MemRefs (..),
AccessSummary (..),
BotUpEnv (..),
InhibitTab,
unionCoalsEntry,
vnameToPrimExp,
getArrMemAssocFParam,
getScopeMemInfo,
createsNewArrOK,
getArrMemAssoc,
getUniqueMemFParam,
markFailedCoal,
accessSubtract,
markSuccessCoal,
)
where
import Control.Applicative
import Data.Functor ((<&>))
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Set qualified as S
import Futhark.IR.Aliases
import Futhark.IR.GPUMem as GPU
import Futhark.IR.MCMem as MC
import Futhark.IR.Mem.IxFun qualified as IxFun
import Futhark.IR.SeqMem
import Futhark.Util.Pretty hiding (line, sep, (</>))
import Prelude
type ScopeTab rep = Scope (Aliases rep)
type LmadRef = IxFun.LMAD (TPrimExp Int64 VName)
data AccessSummary
=
Undeterminable
|
Set (S.Set LmadRef)
instance Semigroup AccessSummary where
AccessSummary
Undeterminable <> :: AccessSummary -> AccessSummary -> AccessSummary
<> AccessSummary
_ = AccessSummary
Undeterminable
AccessSummary
_ <> AccessSummary
Undeterminable = AccessSummary
Undeterminable
(Set Set LmadRef
a) <> (Set Set LmadRef
b) =
Set LmadRef -> AccessSummary
Set forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.union Set LmadRef
a Set LmadRef
b
instance Monoid AccessSummary where
mempty :: AccessSummary
mempty = Set LmadRef -> AccessSummary
Set forall a. Monoid a => a
mempty
instance FreeIn AccessSummary where
freeIn' :: AccessSummary -> FV
freeIn' AccessSummary
Undeterminable = forall a. Monoid a => a
mempty
freeIn' (Set Set LmadRef
s) = forall a. FreeIn a => a -> FV
freeIn' Set LmadRef
s
accessSubtract :: AccessSummary -> AccessSummary -> AccessSummary
accessSubtract :: AccessSummary -> AccessSummary -> AccessSummary
accessSubtract AccessSummary
Undeterminable AccessSummary
_ = AccessSummary
Undeterminable
accessSubtract AccessSummary
_ AccessSummary
Undeterminable = AccessSummary
Undeterminable
accessSubtract (Set Set LmadRef
s1) (Set Set LmadRef
s2) = Set LmadRef -> AccessSummary
Set forall a b. (a -> b) -> a -> b
$ Set LmadRef
s1 forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set LmadRef
s2
data MemRefs = MemRefs
{
MemRefs -> AccessSummary
dstrefs :: AccessSummary,
MemRefs -> AccessSummary
srcwrts :: AccessSummary
}
instance Semigroup MemRefs where
MemRefs
m1 <> :: MemRefs -> MemRefs -> MemRefs
<> MemRefs
m2 =
AccessSummary -> AccessSummary -> MemRefs
MemRefs (MemRefs -> AccessSummary
dstrefs MemRefs
m1 forall a. Semigroup a => a -> a -> a
<> MemRefs -> AccessSummary
dstrefs MemRefs
m2) (MemRefs -> AccessSummary
srcwrts MemRefs
m1 forall a. Semigroup a => a -> a -> a
<> MemRefs -> AccessSummary
srcwrts MemRefs
m2)
instance Monoid MemRefs where
mempty :: MemRefs
mempty = AccessSummary -> AccessSummary -> MemRefs
MemRefs forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
data CoalescedKind
=
CopyCoal
|
InPlaceCoal
|
ConcatCoal
|
TransitiveCoal
| MapCoal
data ArrayMemBound = MemBlock
{ ArrayMemBound -> PrimType
primType :: PrimType,
ArrayMemBound -> Shape
shape :: Shape,
ArrayMemBound -> VName
memName :: VName,
ArrayMemBound -> IxFun
ixfun :: IxFun
}
type FreeVarSubsts = M.Map VName (TPrimExp Int64 VName)
data Coalesced
= Coalesced
CoalescedKind
ArrayMemBound
FreeVarSubsts
data CoalsEntry = CoalsEntry
{
CoalsEntry -> VName
dstmem :: VName,
CoalsEntry -> IxFun
dstind :: IxFun,
CoalsEntry -> Names
alsmem :: Names,
CoalsEntry -> Map VName Coalesced
vartab :: M.Map VName Coalesced,
CoalsEntry -> Map VName VName
optdeps :: M.Map VName VName,
CoalsEntry -> MemRefs
memrefs :: MemRefs,
CoalsEntry -> Certs
certs :: Certs
}
type AllocTab = M.Map VName Space
type ScalarTab = M.Map VName (PrimExp VName)
type CoalsTab = M.Map VName CoalsEntry
type InhibitTab = M.Map VName Names
data BotUpEnv = BotUpEnv
{
BotUpEnv -> ScalarTab
scals :: ScalarTab,
BotUpEnv -> CoalsTab
activeCoals :: CoalsTab,
BotUpEnv -> CoalsTab
successCoals :: CoalsTab,
BotUpEnv -> InhibitTab
inhibit :: InhibitTab
}
instance Pretty CoalsTab where
pretty :: forall ann. CoalsTab -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
instance Pretty AccessSummary where
pretty :: forall ann. AccessSummary -> Doc ann
pretty AccessSummary
Undeterminable = Doc ann
"Undeterminable"
pretty (Set Set LmadRef
a) = Doc ann
"Access-Set:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Set a -> [a]
S.toList Set LmadRef
a) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
" "
instance Pretty MemRefs where
pretty :: forall ann. MemRefs -> Doc ann
pretty (MemRefs AccessSummary
a AccessSummary
b) = Doc ann
"( Use-Sum:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty AccessSummary
a forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Write-Sum:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty AccessSummary
b forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
instance Pretty CoalescedKind where
pretty :: forall ann. CoalescedKind -> Doc ann
pretty CoalescedKind
CopyCoal = Doc ann
"Copy"
pretty CoalescedKind
InPlaceCoal = Doc ann
"InPlace"
pretty CoalescedKind
ConcatCoal = Doc ann
"Concat"
pretty CoalescedKind
TransitiveCoal = Doc ann
"Transitive"
pretty CoalescedKind
MapCoal = Doc ann
"Map"
instance Pretty ArrayMemBound where
pretty :: forall ann. ArrayMemBound -> Doc ann
pretty (MemBlock PrimType
ptp Shape
shp VName
m_nm IxFun
ixfn) =
Doc ann
"{" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
ptp forall a. Semigroup a => a -> a -> a
<> Doc ann
"," forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Shape
shp forall a. Semigroup a => a -> a -> a
<> Doc ann
"," forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
m_nm forall a. Semigroup a => a -> a -> a
<> Doc ann
"," forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IxFun
ixfn forall a. Semigroup a => a -> a -> a
<> Doc ann
"}"
instance Pretty Coalesced where
pretty :: forall ann. Coalesced -> Doc ann
pretty (Coalesced CoalescedKind
knd ArrayMemBound
mbd FreeVarSubsts
_) =
Doc ann
"(Kind:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty CoalescedKind
knd forall a. Semigroup a => a -> a -> a
<> Doc ann
", membds:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ArrayMemBound
mbd
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"\n"
instance Pretty CoalsEntry where
pretty :: forall ann. CoalsEntry -> Doc ann
pretty CoalsEntry
etry =
Doc ann
"{"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Dstmem:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (CoalsEntry -> VName
dstmem CoalsEntry
etry)
forall a. Semigroup a => a -> a -> a
<> Doc ann
", AliasMems:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (CoalsEntry -> Names
alsmem CoalsEntry
etry)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
", optdeps:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ CoalsEntry -> Map VName VName
optdeps CoalsEntry
etry)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
", memrefs:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (CoalsEntry -> MemRefs
memrefs CoalsEntry
etry)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
", vartab:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ CoalsEntry -> Map VName Coalesced
vartab CoalsEntry
etry)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"}"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"\n"
unionCoalsEntry :: CoalsEntry -> CoalsEntry -> CoalsEntry
unionCoalsEntry :: CoalsEntry -> CoalsEntry -> CoalsEntry
unionCoalsEntry CoalsEntry
etry1 (CoalsEntry VName
dstmem2 IxFun
dstind2 Names
alsmem2 Map VName Coalesced
vartab2 Map VName VName
optdeps2 MemRefs
memrefs2 Certs
certs2) =
if CoalsEntry -> VName
dstmem CoalsEntry
etry1 forall a. Eq a => a -> a -> Bool
/= VName
dstmem2 Bool -> Bool -> Bool
|| CoalsEntry -> IxFun
dstind CoalsEntry
etry1 forall a. Eq a => a -> a -> Bool
/= IxFun
dstind2
then CoalsEntry
etry1
else
CoalsEntry
etry1
{ alsmem :: Names
alsmem = CoalsEntry -> Names
alsmem CoalsEntry
etry1 forall a. Semigroup a => a -> a -> a
<> Names
alsmem2,
optdeps :: Map VName VName
optdeps = CoalsEntry -> Map VName VName
optdeps CoalsEntry
etry1 forall a. Semigroup a => a -> a -> a
<> Map VName VName
optdeps2,
vartab :: Map VName Coalesced
vartab = CoalsEntry -> Map VName Coalesced
vartab CoalsEntry
etry1 forall a. Semigroup a => a -> a -> a
<> Map VName Coalesced
vartab2,
memrefs :: MemRefs
memrefs = CoalsEntry -> MemRefs
memrefs CoalsEntry
etry1 forall a. Semigroup a => a -> a -> a
<> MemRefs
memrefs2,
certs :: Certs
certs = CoalsEntry -> Certs
certs CoalsEntry
etry1 forall a. Semigroup a => a -> a -> a
<> Certs
certs2
}
getArrMemAssoc :: Pat (aliases, LetDecMem) -> [(VName, ArrayMemBound)]
getArrMemAssoc :: forall aliases.
Pat (aliases, LetDecMem) -> [(VName, ArrayMemBound)]
getArrMemAssoc Pat (aliases, LetDecMem)
pat =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
( \PatElem (aliases, LetDecMem)
patel -> case forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall dec. PatElem dec -> dec
patElemDec PatElem (aliases, LetDecMem)
patel of
(MemArray PrimType
tp Shape
shp NoUniqueness
_ (ArrayIn VName
mem_nm IxFun
indfun)) ->
forall a. a -> Maybe a
Just (forall dec. PatElem dec -> VName
patElemName PatElem (aliases, LetDecMem)
patel, PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
mem_nm IxFun
indfun)
MemMem Space
_ -> forall a. Maybe a
Nothing
MemPrim PrimType
_ -> forall a. Maybe a
Nothing
MemAcc {} -> forall a. Maybe a
Nothing
)
forall a b. (a -> b) -> a -> b
$ forall dec. Pat dec -> [PatElem dec]
patElems Pat (aliases, LetDecMem)
pat
getArrMemAssocFParam :: [Param FParamMem] -> [(VName, Uniqueness, ArrayMemBound)]
getArrMemAssocFParam :: [Param FParamMem] -> [(VName, Uniqueness, ArrayMemBound)]
getArrMemAssocFParam =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
( \Param FParamMem
param -> case forall dec. Param dec -> dec
paramDec Param FParamMem
param of
(MemArray PrimType
tp Shape
shp Uniqueness
u (ArrayIn VName
mem_nm IxFun
indfun)) ->
forall a. a -> Maybe a
Just (forall dec. Param dec -> VName
paramName Param FParamMem
param, Uniqueness
u, PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
mem_nm IxFun
indfun)
MemMem Space
_ -> forall a. Maybe a
Nothing
MemPrim PrimType
_ -> forall a. Maybe a
Nothing
MemAcc {} -> forall a. Maybe a
Nothing
)
getUniqueMemFParam :: [Param FParamMem] -> M.Map VName Space
getUniqueMemFParam :: [Param FParamMem] -> Map VName Space
getUniqueMemFParam [Param FParamMem]
params =
let mems :: Map VName Space
mems = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {d} {u} {ret}.
Param (MemInfo d u ret) -> Maybe (VName, Space)
justMem [Param FParamMem]
params
arrayMems :: Set VName
arrayMems = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {d}. MemInfo d Uniqueness MemBind -> Maybe VName
justArrayMem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. Param dec -> dec
paramDec) [Param FParamMem]
params
in Map VName Space
mems forall k a. Ord k => Map k a -> Set k -> Map k a
`M.restrictKeys` Set VName
arrayMems
where
justMem :: Param (MemInfo d u ret) -> Maybe (VName, Space)
justMem (Param Attrs
_ VName
nm (MemMem Space
sp)) = forall a. a -> Maybe a
Just (VName
nm, Space
sp)
justMem Param (MemInfo d u ret)
_ = forall a. Maybe a
Nothing
justArrayMem :: MemInfo d Uniqueness MemBind -> Maybe VName
justArrayMem (MemArray PrimType
_ ShapeBase d
_ Uniqueness
Unique (ArrayIn VName
mem_nm IxFun
_)) = forall a. a -> Maybe a
Just VName
mem_nm
justArrayMem MemInfo d Uniqueness MemBind
_ = forall a. Maybe a
Nothing
class HasMemBlock rep where
getScopeMemInfo :: VName -> Scope rep -> Maybe ArrayMemBound
instance HasMemBlock (Aliases SeqMem) where
getScopeMemInfo :: VName -> Scope (Aliases SeqMem) -> Maybe ArrayMemBound
getScopeMemInfo VName
r Scope (Aliases SeqMem)
scope_env0 =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
r Scope (Aliases SeqMem)
scope_env0 of
Just (LetName (VarAliases
_, MemArray PrimType
tp Shape
shp NoUniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Just (FParamName (MemArray PrimType
tp Shape
shp Uniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Just (LParamName (MemArray PrimType
tp Shape
shp NoUniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Maybe (NameInfo (Aliases SeqMem))
_ -> forall a. Maybe a
Nothing
instance HasMemBlock (Aliases GPUMem) where
getScopeMemInfo :: VName -> Scope (Aliases GPUMem) -> Maybe ArrayMemBound
getScopeMemInfo VName
r Scope (Aliases GPUMem)
scope_env0 =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
r Scope (Aliases GPUMem)
scope_env0 of
Just (LetName (VarAliases
_, MemArray PrimType
tp Shape
shp NoUniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Just (FParamName (MemArray PrimType
tp Shape
shp Uniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Just (LParamName (MemArray PrimType
tp Shape
shp NoUniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Maybe (NameInfo (Aliases GPUMem))
_ -> forall a. Maybe a
Nothing
instance HasMemBlock (Aliases MCMem) where
getScopeMemInfo :: VName -> Scope (Aliases MCMem) -> Maybe ArrayMemBound
getScopeMemInfo VName
r Scope (Aliases MCMem)
scope_env0 =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
r Scope (Aliases MCMem)
scope_env0 of
Just (LetName (VarAliases
_, MemArray PrimType
tp Shape
shp NoUniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Just (FParamName (MemArray PrimType
tp Shape
shp Uniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Just (LParamName (MemArray PrimType
tp Shape
shp NoUniqueness
_ (ArrayIn VName
m IxFun
idx))) -> forall a. a -> Maybe a
Just (PrimType -> Shape -> VName -> IxFun -> ArrayMemBound
MemBlock PrimType
tp Shape
shp VName
m IxFun
idx)
Maybe (NameInfo (Aliases MCMem))
_ -> forall a. Maybe a
Nothing
createsNewArrOK :: Exp rep -> Bool
createsNewArrOK :: forall rep. Exp rep -> Bool
createsNewArrOK (BasicOp Replicate {}) = Bool
True
createsNewArrOK (BasicOp Iota {}) = Bool
True
createsNewArrOK (BasicOp Manifest {}) = Bool
True
createsNewArrOK (BasicOp Concat {}) = Bool
True
createsNewArrOK (BasicOp ArrayLit {}) = Bool
True
createsNewArrOK (BasicOp Scratch {}) = Bool
True
createsNewArrOK Exp rep
_ = Bool
False
markFailedCoal ::
(CoalsTab, InhibitTab) ->
VName ->
(CoalsTab, InhibitTab)
markFailedCoal :: (CoalsTab, InhibitTab) -> VName -> (CoalsTab, InhibitTab)
markFailedCoal (CoalsTab
coal_tab, InhibitTab
inhb_tab) VName
src_mem =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
src_mem CoalsTab
coal_tab of
Maybe CoalsEntry
Nothing -> (CoalsTab
coal_tab, InhibitTab
inhb_tab)
Just CoalsEntry
coale ->
let failed_set :: Names
failed_set = VName -> Names
oneName forall a b. (a -> b) -> a -> b
$ CoalsEntry -> VName
dstmem CoalsEntry
coale
failed_set' :: Names
failed_set' = Names
failed_set forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
src_mem InhibitTab
inhb_tab)
in ( forall k a. Ord k => k -> Map k a -> Map k a
M.delete VName
src_mem CoalsTab
coal_tab,
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
src_mem Names
failed_set' InhibitTab
inhb_tab
)
markSuccessCoal ::
(CoalsTab, CoalsTab) ->
VName ->
CoalsEntry ->
(CoalsTab, CoalsTab)
markSuccessCoal :: (CoalsTab, CoalsTab) -> VName -> CoalsEntry -> (CoalsTab, CoalsTab)
markSuccessCoal (CoalsTab
actv, CoalsTab
succc) VName
m_b CoalsEntry
info_b =
( forall k a. Ord k => k -> Map k a -> Map k a
M.delete VName
m_b CoalsTab
actv,
VName -> CoalsEntry -> CoalsTab -> CoalsTab
appendCoalsInfo VName
m_b CoalsEntry
info_b CoalsTab
succc
)
appendCoalsInfo :: VName -> CoalsEntry -> CoalsTab -> CoalsTab
appendCoalsInfo :: VName -> CoalsEntry -> CoalsTab -> CoalsTab
appendCoalsInfo VName
mb CoalsEntry
info_new CoalsTab
coalstab =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
mb CoalsTab
coalstab of
Maybe CoalsEntry
Nothing -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
mb CoalsEntry
info_new CoalsTab
coalstab
Just CoalsEntry
info_old -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
mb (CoalsEntry -> CoalsEntry -> CoalsEntry
unionCoalsEntry CoalsEntry
info_old CoalsEntry
info_new) CoalsTab
coalstab
vnameToPrimExp ::
(AliasableRep rep) =>
ScopeTab rep ->
ScalarTab ->
VName ->
Maybe (PrimExp VName)
vnameToPrimExp :: forall rep.
AliasableRep rep =>
ScopeTab rep -> ScalarTab -> VName -> Maybe (PrimExp VName)
vnameToPrimExp ScopeTab rep
scopetab ScalarTab
scaltab VName
v =
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
v ScalarTab
scaltab
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
v ScopeTab rep
scopetab
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall shp u. TypeBase shp u -> Maybe PrimType
toPrimType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Typed t => t -> Type
typeOf
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall v. v -> PrimType -> PrimExp v
LeafExp VName
v
)
toPrimType :: TypeBase shp u -> Maybe PrimType
toPrimType :: forall shp u. TypeBase shp u -> Maybe PrimType
toPrimType (Prim PrimType
pt) = forall a. a -> Maybe a
Just PrimType
pt
toPrimType TypeBase shp u
_ = forall a. Maybe a
Nothing