{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

-- | The IR tracks aliases, mostly to ensure the soundness of in-place
-- updates, but it can also be used for other things (such as memory
-- optimisations).  This module contains the raw building blocks for
-- determining the aliases of the values produced by expressions.  It
-- also contains some building blocks for inspecting consumption.
--
-- One important caveat is that all aliases computed here are /local/.
-- Thus, they do not take aliases-of-aliases into account.  See
-- "Futhark.Analysis.Alias" if this is not what you want.
module Futhark.IR.Prop.Aliases
  ( subExpAliases,
    expAliases,
    patAliases,
    lookupAliases,
    Aliased (..),
    AliasesOf (..),

    -- * Consumption
    consumedInStm,
    consumedInExp,
    consumedByLambda,

    -- * Extensibility
    AliasTable,
    AliasedOp (..),
    CanBeAliased (..),
  )
where

import Control.Arrow (first)
import qualified Data.Kind
import qualified Data.Map as M
import Futhark.IR.Prop (IsOp, NameInfo (..), Scope)
import Futhark.IR.Prop.Names
import Futhark.IR.Prop.Patterns
import Futhark.IR.Prop.Types
import Futhark.IR.Syntax

-- | The class of representations that contain aliasing information.
class (RepTypes rep, AliasedOp (Op rep), AliasesOf (LetDec rep)) => Aliased rep where
  -- | The aliases of the body results.
  bodyAliases :: Body rep -> [Names]

  -- | The variables consumed in the body.
  consumedInBody :: Body rep -> Names

vnameAliases :: VName -> Names
vnameAliases :: VName -> Names
vnameAliases = VName -> Names
oneName

-- | The alises of a subexpression.
subExpAliases :: SubExp -> Names
subExpAliases :: SubExp -> Names
subExpAliases Constant {} = Names
forall a. Monoid a => a
mempty
subExpAliases (Var VName
v) = VName -> Names
vnameAliases VName
v

basicOpAliases :: BasicOp -> [Names]
basicOpAliases :: BasicOp -> [Names]
basicOpAliases (SubExp SubExp
se) = [SubExp -> Names
subExpAliases SubExp
se]
basicOpAliases (Opaque OpaqueOp
_ SubExp
se) = [SubExp -> Names
subExpAliases SubExp
se]
basicOpAliases (ArrayLit [SubExp]
_ Type
_) = [Names
forall a. Monoid a => a
mempty]
basicOpAliases BinOp {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases ConvOp {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases CmpOp {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases UnOp {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases (Index VName
ident Slice SubExp
_) = [VName -> Names
vnameAliases VName
ident]
basicOpAliases Update {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases (FlatIndex VName
ident FlatSlice SubExp
_) = [VName -> Names
vnameAliases VName
ident]
basicOpAliases FlatUpdate {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases Iota {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases Replicate {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases Scratch {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases (Reshape ShapeChange SubExp
_ VName
e) = [VName -> Names
vnameAliases VName
e]
basicOpAliases (Rearrange [Int]
_ VName
e) = [VName -> Names
vnameAliases VName
e]
basicOpAliases (Rotate [SubExp]
_ VName
e) = [VName -> Names
vnameAliases VName
e]
basicOpAliases Concat {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases Copy {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases Manifest {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases Assert {} = [Names
forall a. Monoid a => a
mempty]
basicOpAliases UpdateAcc {} = [Names
forall a. Monoid a => a
mempty]

ifAliases :: ([Names], Names) -> ([Names], Names) -> [Names]
ifAliases :: ([Names], Names) -> ([Names], Names) -> [Names]
ifAliases ([Names]
als1, Names
cons1) ([Names]
als2, Names
cons2) =
  (Names -> Names) -> [Names] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map (Names -> Names -> Names
`namesSubtract` Names
cons) ([Names] -> [Names]) -> [Names] -> [Names]
forall a b. (a -> b) -> a -> b
$ (Names -> Names -> Names) -> [Names] -> [Names] -> [Names]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Names -> Names -> Names
forall a. Monoid a => a -> a -> a
mappend [Names]
als1 [Names]
als2
  where
    cons :: Names
cons = Names
cons1 Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
cons2

funcallAliases :: [(SubExp, Diet)] -> [TypeBase shape Uniqueness] -> [Names]
funcallAliases :: [(SubExp, Diet)] -> [TypeBase shape Uniqueness] -> [Names]
funcallAliases [(SubExp, Diet)]
args [TypeBase shape Uniqueness]
t =
  [TypeBase shape Uniqueness] -> [(Names, Diet)] -> [Names]
forall shape.
[TypeBase shape Uniqueness] -> [(Names, Diet)] -> [Names]
returnAliases [TypeBase shape Uniqueness]
t [(SubExp -> Names
subExpAliases SubExp
se, Diet
d) | (SubExp
se, Diet
d) <- [(SubExp, Diet)]
args]

-- | The aliases of an expression, one per non-context value returned.
expAliases :: (Aliased rep) => Exp rep -> [Names]
expAliases :: Exp rep -> [Names]
expAliases (If SubExp
_ BodyT rep
tb BodyT rep
fb IfDec (BranchType rep)
dec) =
  Int -> [Names] -> [Names]
forall a. Int -> [a] -> [a]
drop ([Names] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Names]
all_aliases Int -> Int -> Int
forall a. Num a => a -> a -> a
- [BranchType rep] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BranchType rep]
ts) [Names]
all_aliases
  where
    ts :: [BranchType rep]
ts = IfDec (BranchType rep) -> [BranchType rep]
forall rt. IfDec rt -> [rt]
ifReturns IfDec (BranchType rep)
dec
    all_aliases :: [Names]
all_aliases =
      ([Names], Names) -> ([Names], Names) -> [Names]
ifAliases
        (BodyT rep -> [Names]
forall rep. Aliased rep => Body rep -> [Names]
bodyAliases BodyT rep
tb, BodyT rep -> Names
forall rep. Aliased rep => Body rep -> Names
consumedInBody BodyT rep
tb)
        (BodyT rep -> [Names]
forall rep. Aliased rep => Body rep -> [Names]
bodyAliases BodyT rep
fb, BodyT rep -> Names
forall rep. Aliased rep => Body rep -> Names
consumedInBody BodyT rep
fb)
expAliases (BasicOp BasicOp
op) = BasicOp -> [Names]
basicOpAliases BasicOp
op
expAliases (DoLoop [(FParam rep, SubExp)]
merge LoopForm rep
_ BodyT rep
loopbody) =
  (Names -> Names) -> [Names] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map (Names -> Names -> Names
`namesSubtract` Names
merge_names) [Names]
aliases
  where
    aliases :: [Names]
aliases = BodyT rep -> [Names]
forall rep. Aliased rep => Body rep -> [Names]
bodyAliases BodyT rep
loopbody
    merge_names :: Names
merge_names = [VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ ((FParam rep, SubExp) -> VName)
-> [(FParam rep, SubExp)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map (FParam rep -> VName
forall dec. Param dec -> VName
paramName (FParam rep -> VName)
-> ((FParam rep, SubExp) -> FParam rep)
-> (FParam rep, SubExp)
-> VName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FParam rep, SubExp) -> FParam rep
forall a b. (a, b) -> a
fst) [(FParam rep, SubExp)]
merge
expAliases (Apply Name
_ [(SubExp, Diet)]
args [RetType rep]
t (Safety, SrcLoc, [SrcLoc])
_) =
  [(SubExp, Diet)] -> [TypeBase ExtShape Uniqueness] -> [Names]
forall shape.
[(SubExp, Diet)] -> [TypeBase shape Uniqueness] -> [Names]
funcallAliases [(SubExp, Diet)]
args ([TypeBase ExtShape Uniqueness] -> [Names])
-> [TypeBase ExtShape Uniqueness] -> [Names]
forall a b. (a -> b) -> a -> b
$ (RetType rep -> TypeBase ExtShape Uniqueness)
-> [RetType rep] -> [TypeBase ExtShape Uniqueness]
forall a b. (a -> b) -> [a] -> [b]
map RetType rep -> TypeBase ExtShape Uniqueness
forall t. DeclExtTyped t => t -> TypeBase ExtShape Uniqueness
declExtTypeOf [RetType rep]
t
expAliases (WithAcc [(Shape, [VName], Maybe (Lambda rep, [SubExp]))]
inputs Lambda rep
lam) =
  ((Shape, [VName], Maybe (Lambda rep, [SubExp])) -> [Names])
-> [(Shape, [VName], Maybe (Lambda rep, [SubExp]))] -> [Names]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Shape, [VName], Maybe (Lambda rep, [SubExp])) -> [Names]
forall (t :: * -> *) a a a c.
(Foldable t, Monoid a) =>
(a, t a, c) -> [a]
inputAliases [(Shape, [VName], Maybe (Lambda rep, [SubExp]))]
inputs [Names] -> [Names] -> [Names]
forall a. [a] -> [a] -> [a]
++ Int -> [Names] -> [Names]
forall a. Int -> [a] -> [a]
drop Int
num_accs (BodyT rep -> [Names]
forall rep. Aliased rep => Body rep -> [Names]
bodyAliases (Lambda rep -> BodyT rep
forall rep. LambdaT rep -> BodyT rep
lambdaBody Lambda rep
lam))
  where
    inputAliases :: (a, t a, c) -> [a]
inputAliases (a
_, t a
arrs, c
_) = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
arrs) a
forall a. Monoid a => a
mempty
    num_accs :: Int
num_accs = [(Shape, [VName], Maybe (Lambda rep, [SubExp]))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Shape, [VName], Maybe (Lambda rep, [SubExp]))]
inputs
expAliases (Op Op rep
op) = Op rep -> [Names]
forall op. AliasedOp op => op -> [Names]
opAliases Op rep
op

returnAliases :: [TypeBase shape Uniqueness] -> [(Names, Diet)] -> [Names]
returnAliases :: [TypeBase shape Uniqueness] -> [(Names, Diet)] -> [Names]
returnAliases [TypeBase shape Uniqueness]
rts [(Names, Diet)]
args = (TypeBase shape Uniqueness -> Names)
-> [TypeBase shape Uniqueness] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map TypeBase shape Uniqueness -> Names
returnType' [TypeBase shape Uniqueness]
rts
  where
    returnType' :: TypeBase shape Uniqueness -> Names
returnType' (Array PrimType
_ shape
_ Uniqueness
Nonunique) =
      [Names] -> Names
forall a. Monoid a => [a] -> a
mconcat ([Names] -> Names) -> [Names] -> Names
forall a b. (a -> b) -> a -> b
$ ((Names, Diet) -> Names) -> [(Names, Diet)] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map ((Names -> Diet -> Names) -> (Names, Diet) -> Names
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Names -> Diet -> Names
maskAliases) [(Names, Diet)]
args
    returnType' (Array PrimType
_ shape
_ Uniqueness
Unique) =
      Names
forall a. Monoid a => a
mempty
    returnType' (Prim PrimType
_) =
      Names
forall a. Monoid a => a
mempty
    returnType' Acc {} =
      [Char] -> Names
forall a. HasCallStack => [Char] -> a
error [Char]
"returnAliases Acc"
    returnType' Mem {} =
      [Names] -> Names
forall a. Monoid a => [a] -> a
mconcat ([Names] -> Names) -> [Names] -> Names
forall a b. (a -> b) -> a -> b
$ ((Names, Diet) -> Names) -> [(Names, Diet)] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map ((Names -> Diet -> Names) -> (Names, Diet) -> Names
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Names -> Diet -> Names
maskAliases) [(Names, Diet)]
args

maskAliases :: Names -> Diet -> Names
maskAliases :: Names -> Diet -> Names
maskAliases Names
_ Diet
Consume = Names
forall a. Monoid a => a
mempty
maskAliases Names
_ Diet
ObservePrim = Names
forall a. Monoid a => a
mempty
maskAliases Names
als Diet
Observe = Names
als

-- | The variables consumed in this statement.
consumedInStm :: Aliased rep => Stm rep -> Names
consumedInStm :: Stm rep -> Names
consumedInStm = Exp rep -> Names
forall rep. Aliased rep => Exp rep -> Names
consumedInExp (Exp rep -> Names) -> (Stm rep -> Exp rep) -> Stm rep -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stm rep -> Exp rep
forall rep. Stm rep -> Exp rep
stmExp

-- | The variables consumed in this expression.
consumedInExp :: (Aliased rep) => Exp rep -> Names
consumedInExp :: Exp rep -> Names
consumedInExp (Apply Name
_ [(SubExp, Diet)]
args [RetType rep]
_ (Safety, SrcLoc, [SrcLoc])
_) =
  [Names] -> Names
forall a. Monoid a => [a] -> a
mconcat (((SubExp, Diet) -> Names) -> [(SubExp, Diet)] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map ((Names, Diet) -> Names
forall p. Monoid p => (p, Diet) -> p
consumeArg ((Names, Diet) -> Names)
-> ((SubExp, Diet) -> (Names, Diet)) -> (SubExp, Diet) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubExp -> Names) -> (SubExp, Diet) -> (Names, Diet)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first SubExp -> Names
subExpAliases) [(SubExp, Diet)]
args)
  where
    consumeArg :: (p, Diet) -> p
consumeArg (p
als, Diet
Consume) = p
als
    consumeArg (p, Diet)
_ = p
forall a. Monoid a => a
mempty
consumedInExp (If SubExp
_ BodyT rep
tb BodyT rep
fb IfDec (BranchType rep)
_) =
  BodyT rep -> Names
forall rep. Aliased rep => Body rep -> Names
consumedInBody BodyT rep
tb Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> BodyT rep -> Names
forall rep. Aliased rep => Body rep -> Names
consumedInBody BodyT rep
fb
consumedInExp (DoLoop [(FParam rep, SubExp)]
merge LoopForm rep
form BodyT rep
body) =
  [Names] -> Names
forall a. Monoid a => [a] -> a
mconcat
    ( ((FParam rep, SubExp) -> Names)
-> [(FParam rep, SubExp)] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map (SubExp -> Names
subExpAliases (SubExp -> Names)
-> ((FParam rep, SubExp) -> SubExp)
-> (FParam rep, SubExp)
-> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FParam rep, SubExp) -> SubExp
forall a b. (a, b) -> b
snd) ([(FParam rep, SubExp)] -> [Names])
-> [(FParam rep, SubExp)] -> [Names]
forall a b. (a -> b) -> a -> b
$
        ((FParam rep, SubExp) -> Bool)
-> [(FParam rep, SubExp)] -> [(FParam rep, SubExp)]
forall a. (a -> Bool) -> [a] -> [a]
filter (TypeBase Shape Uniqueness -> Bool
forall shape. TypeBase shape Uniqueness -> Bool
unique (TypeBase Shape Uniqueness -> Bool)
-> ((FParam rep, SubExp) -> TypeBase Shape Uniqueness)
-> (FParam rep, SubExp)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FParam rep -> TypeBase Shape Uniqueness
forall dec. DeclTyped dec => Param dec -> TypeBase Shape Uniqueness
paramDeclType (FParam rep -> TypeBase Shape Uniqueness)
-> ((FParam rep, SubExp) -> FParam rep)
-> (FParam rep, SubExp)
-> TypeBase Shape Uniqueness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FParam rep, SubExp) -> FParam rep
forall a b. (a, b) -> a
fst) [(FParam rep, SubExp)]
merge
    )
    Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> LoopForm rep -> Names
consumedInForm LoopForm rep
form
  where
    body_consumed :: Names
body_consumed = BodyT rep -> Names
forall rep. Aliased rep => Body rep -> Names
consumedInBody BodyT rep
body
    varConsumed :: (Param (LParamInfo rep), VName) -> Bool
varConsumed = (VName -> Names -> Bool
`nameIn` Names
body_consumed) (VName -> Bool)
-> ((Param (LParamInfo rep), VName) -> VName)
-> (Param (LParamInfo rep), VName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param (LParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName (Param (LParamInfo rep) -> VName)
-> ((Param (LParamInfo rep), VName) -> Param (LParamInfo rep))
-> (Param (LParamInfo rep), VName)
-> VName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Param (LParamInfo rep), VName) -> Param (LParamInfo rep)
forall a b. (a, b) -> a
fst
    consumedInForm :: LoopForm rep -> Names
consumedInForm (ForLoop VName
_ IntType
_ SubExp
_ [(Param (LParamInfo rep), VName)]
loopvars) =
      [VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ ((Param (LParamInfo rep), VName) -> VName)
-> [(Param (LParamInfo rep), VName)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map (Param (LParamInfo rep), VName) -> VName
forall a b. (a, b) -> b
snd ([(Param (LParamInfo rep), VName)] -> [VName])
-> [(Param (LParamInfo rep), VName)] -> [VName]
forall a b. (a -> b) -> a -> b
$ ((Param (LParamInfo rep), VName) -> Bool)
-> [(Param (LParamInfo rep), VName)]
-> [(Param (LParamInfo rep), VName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Param (LParamInfo rep), VName) -> Bool
varConsumed [(Param (LParamInfo rep), VName)]
loopvars
    consumedInForm WhileLoop {} =
      Names
forall a. Monoid a => a
mempty
consumedInExp (WithAcc [(Shape, [VName], Maybe (Lambda rep, [SubExp]))]
inputs Lambda rep
lam) =
  [Names] -> Names
forall a. Monoid a => [a] -> a
mconcat (((Shape, [VName], Maybe (Lambda rep, [SubExp])) -> Names)
-> [(Shape, [VName], Maybe (Lambda rep, [SubExp]))] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map (Shape, [VName], Maybe (Lambda rep, [SubExp])) -> Names
forall a c. (a, [VName], c) -> Names
inputConsumed [(Shape, [VName], Maybe (Lambda rep, [SubExp]))]
inputs)
    Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> ( Lambda rep -> Names
forall rep. Aliased rep => Lambda rep -> Names
consumedByLambda Lambda rep
lam
           Names -> Names -> Names
`namesSubtract` [VName] -> Names
namesFromList ((Param (LParamInfo rep) -> VName)
-> [Param (LParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (LParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName (Lambda rep -> [Param (LParamInfo rep)]
forall rep. LambdaT rep -> [LParam rep]
lambdaParams Lambda rep
lam))
       )
  where
    inputConsumed :: (a, [VName], c) -> Names
inputConsumed (a
_, [VName]
arrs, c
_) = [VName] -> Names
namesFromList [VName]
arrs
consumedInExp (BasicOp (Update Safety
_ VName
src Slice SubExp
_ SubExp
_)) = VName -> Names
oneName VName
src
consumedInExp (BasicOp (FlatUpdate VName
src FlatSlice SubExp
_ VName
_)) = VName -> Names
oneName VName
src
consumedInExp (BasicOp (UpdateAcc VName
acc [SubExp]
_ [SubExp]
_)) = VName -> Names
oneName VName
acc
consumedInExp (BasicOp BasicOp
_) = Names
forall a. Monoid a => a
mempty
consumedInExp (Op Op rep
op) = Op rep -> Names
forall op. AliasedOp op => op -> Names
consumedInOp Op rep
op

-- | The variables consumed by this lambda.
consumedByLambda :: Aliased rep => Lambda rep -> Names
consumedByLambda :: Lambda rep -> Names
consumedByLambda = Body rep -> Names
forall rep. Aliased rep => Body rep -> Names
consumedInBody (Body rep -> Names)
-> (Lambda rep -> Body rep) -> Lambda rep -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lambda rep -> Body rep
forall rep. LambdaT rep -> BodyT rep
lambdaBody

-- | The aliases of each pattern element (including the context).
patAliases :: AliasesOf dec => PatT dec -> [Names]
patAliases :: PatT dec -> [Names]
patAliases = (PatElemT dec -> Names) -> [PatElemT dec] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map (dec -> Names
forall a. AliasesOf a => a -> Names
aliasesOf (dec -> Names) -> (PatElemT dec -> dec) -> PatElemT dec -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatElemT dec -> dec
forall dec. PatElemT dec -> dec
patElemDec) ([PatElemT dec] -> [Names])
-> (PatT dec -> [PatElemT dec]) -> PatT dec -> [Names]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatT dec -> [PatElemT dec]
forall dec. PatT dec -> [PatElemT dec]
patElems

-- | Something that contains alias information.
class AliasesOf a where
  -- | The alias of the argument element.
  aliasesOf :: a -> Names

instance AliasesOf Names where
  aliasesOf :: Names -> Names
aliasesOf = Names -> Names
forall a. a -> a
id

instance AliasesOf dec => AliasesOf (PatElemT dec) where
  aliasesOf :: PatElemT dec -> Names
aliasesOf = dec -> Names
forall a. AliasesOf a => a -> Names
aliasesOf (dec -> Names) -> (PatElemT dec -> dec) -> PatElemT dec -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatElemT dec -> dec
forall dec. PatElemT dec -> dec
patElemDec

-- | Also includes the name itself.
lookupAliases :: AliasesOf (LetDec rep) => VName -> Scope rep -> Names
lookupAliases :: VName -> Scope rep -> Names
lookupAliases VName
v Scope rep
scope =
  case VName -> Scope rep -> Maybe (NameInfo rep)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
v Scope rep
scope of
    Just (LetName LetDec rep
dec) ->
      VName -> Names
oneName VName
v Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> (VName -> Names) -> [VName] -> Names
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (VName -> Scope rep -> Names
forall rep. AliasesOf (LetDec rep) => VName -> Scope rep -> Names
`lookupAliases` Scope rep
scope) (Names -> [VName]
namesToList (LetDec rep -> Names
forall a. AliasesOf a => a -> Names
aliasesOf LetDec rep
dec))
    Maybe (NameInfo rep)
_ -> VName -> Names
oneName VName
v

-- | The class of operations that can produce aliasing and consumption
-- information.
class IsOp op => AliasedOp op where
  opAliases :: op -> [Names]
  consumedInOp :: op -> Names

instance AliasedOp () where
  opAliases :: () -> [Names]
opAliases () = []
  consumedInOp :: () -> Names
consumedInOp () = Names
forall a. Monoid a => a
mempty

-- | Pre-existing aliases for variables.  Used to add transitive
-- aliases.
type AliasTable = M.Map VName Names

-- | The class of operations that can be given aliasing information.
-- This is a somewhat subtle concept that is only used in the
-- simplifier and when using "rep adapters".
class AliasedOp (OpWithAliases op) => CanBeAliased op where
  -- | The op that results when we add aliases to this op.
  type OpWithAliases op :: Data.Kind.Type

  -- | Remove aliases from this op.
  removeOpAliases :: OpWithAliases op -> op

  -- | Add aliases to this op.
  addOpAliases :: AliasTable -> op -> OpWithAliases op

instance CanBeAliased () where
  type OpWithAliases () = ()
  removeOpAliases :: OpWithAliases () -> ()
removeOpAliases = OpWithAliases () -> ()
forall a. a -> a
id
  addOpAliases :: AliasTable -> () -> OpWithAliases ()
addOpAliases = (() -> ()) -> AliasTable -> () -> ()
forall a b. a -> b -> a
const () -> ()
forall a. a -> a
id