{-# LANGUAGE Strict #-}
-- | A usage-table is sort of a bottom-up symbol table, describing how
-- (and if) a variable is used.
module Futhark.Analysis.UsageTable
  ( UsageTable
  , empty
  , without
  , lookup
  , used
  , expand
  , isConsumed
  , isInResult
  , isUsedDirectly
  , usages
  , usage
  , consumedUsage
  , inResultUsage
  , Usages
  )
  where

import Control.Arrow (first)
import Data.Bits
import qualified Data.Foldable as Foldable
import Data.List (foldl')
import qualified Data.Map.Strict as M

import Prelude hiding (lookup)

import Futhark.Transform.Substitute
import Futhark.Representation.AST

newtype UsageTable = UsageTable (M.Map VName Usages)
                   deriving (UsageTable -> UsageTable -> Bool
(UsageTable -> UsageTable -> Bool)
-> (UsageTable -> UsageTable -> Bool) -> Eq UsageTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsageTable -> UsageTable -> Bool
$c/= :: UsageTable -> UsageTable -> Bool
== :: UsageTable -> UsageTable -> Bool
$c== :: UsageTable -> UsageTable -> Bool
Eq, Int -> UsageTable -> ShowS
[UsageTable] -> ShowS
UsageTable -> String
(Int -> UsageTable -> ShowS)
-> (UsageTable -> String)
-> ([UsageTable] -> ShowS)
-> Show UsageTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsageTable] -> ShowS
$cshowList :: [UsageTable] -> ShowS
show :: UsageTable -> String
$cshow :: UsageTable -> String
showsPrec :: Int -> UsageTable -> ShowS
$cshowsPrec :: Int -> UsageTable -> ShowS
Show)

instance Semigroup UsageTable where
  UsageTable Map VName Usages
table1 <> :: UsageTable -> UsageTable -> UsageTable
<> UsageTable Map VName Usages
table2 =
    Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable) -> Map VName Usages -> UsageTable
forall a b. (a -> b) -> a -> b
$ (Usages -> Usages -> Usages)
-> Map VName Usages -> Map VName Usages -> Map VName Usages
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Usages -> Usages -> Usages
forall a. Semigroup a => a -> a -> a
(<>) Map VName Usages
table1 Map VName Usages
table2

instance Monoid UsageTable where
  mempty :: UsageTable
mempty = UsageTable
empty

instance Substitute UsageTable where
  substituteNames :: Map VName VName -> UsageTable -> UsageTable
substituteNames Map VName VName
subst (UsageTable Map VName Usages
table)
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map VName VName -> Bool
forall k a. Map k a -> Bool
M.null (Map VName VName -> Bool) -> Map VName VName -> Bool
forall a b. (a -> b) -> a -> b
$ Map VName VName
subst Map VName VName -> Map VName Usages -> Map VName VName
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.intersection` Map VName Usages
table =
      Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable) -> Map VName Usages -> UsageTable
forall a b. (a -> b) -> a -> b
$ [(VName, Usages)] -> Map VName Usages
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(VName, Usages)] -> Map VName Usages)
-> [(VName, Usages)] -> Map VName Usages
forall a b. (a -> b) -> a -> b
$
      ((VName, Usages) -> (VName, Usages))
-> [(VName, Usages)] -> [(VName, Usages)]
forall a b. (a -> b) -> [a] -> [b]
map ((VName -> VName) -> (VName, Usages) -> (VName, Usages)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((VName -> VName) -> (VName, Usages) -> (VName, Usages))
-> (VName -> VName) -> (VName, Usages) -> (VName, Usages)
forall a b. (a -> b) -> a -> b
$ Map VName VName -> VName -> VName
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
subst) ([(VName, Usages)] -> [(VName, Usages)])
-> [(VName, Usages)] -> [(VName, Usages)]
forall a b. (a -> b) -> a -> b
$ Map VName Usages -> [(VName, Usages)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName Usages
table
    | Bool
otherwise = Map VName Usages -> UsageTable
UsageTable Map VName Usages
table

empty :: UsageTable
empty :: UsageTable
empty = Map VName Usages -> UsageTable
UsageTable Map VName Usages
forall k a. Map k a
M.empty


without :: UsageTable -> [VName] -> UsageTable
without :: UsageTable -> [VName] -> UsageTable
without (UsageTable Map VName Usages
table) = Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable)
-> ([VName] -> Map VName Usages) -> [VName] -> UsageTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map VName Usages -> VName -> Map VName Usages)
-> Map VName Usages -> [VName] -> Map VName Usages
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl ((VName -> Map VName Usages -> Map VName Usages)
-> Map VName Usages -> VName -> Map VName Usages
forall a b c. (a -> b -> c) -> b -> a -> c
flip VName -> Map VName Usages -> Map VName Usages
forall k a. Ord k => k -> Map k a -> Map k a
M.delete) Map VName Usages
table

lookup :: VName -> UsageTable -> Maybe Usages
lookup :: VName -> UsageTable -> Maybe Usages
lookup VName
name (UsageTable Map VName Usages
table) = VName -> Map VName Usages -> Maybe Usages
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
name Map VName Usages
table

lookupPred :: (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred :: (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred Usages -> Bool
f VName
name = Bool -> (Usages -> Bool) -> Maybe Usages -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Usages -> Bool
f (Maybe Usages -> Bool)
-> (UsageTable -> Maybe Usages) -> UsageTable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> UsageTable -> Maybe Usages
lookup VName
name

used :: VName -> UsageTable -> Bool
used :: VName -> UsageTable -> Bool
used = (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred ((Usages -> Bool) -> VName -> UsageTable -> Bool)
-> (Usages -> Bool) -> VName -> UsageTable -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Usages -> Bool
forall a b. a -> b -> a
const Bool
True

-- | Expand the usage table based on aliasing information.
expand :: (VName -> Names) -> UsageTable -> UsageTable
expand :: (VName -> Names) -> UsageTable -> UsageTable
expand VName -> Names
look (UsageTable Map VName Usages
m) = Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable) -> Map VName Usages -> UsageTable
forall a b. (a -> b) -> a -> b
$ (Map VName Usages -> (VName, Usages) -> Map VName Usages)
-> Map VName Usages -> [(VName, Usages)] -> Map VName Usages
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map VName Usages -> (VName, Usages) -> Map VName Usages
grow Map VName Usages
m ([(VName, Usages)] -> Map VName Usages)
-> [(VName, Usages)] -> Map VName Usages
forall a b. (a -> b) -> a -> b
$ Map VName Usages -> [(VName, Usages)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName Usages
m
  where grow :: Map VName Usages -> (VName, Usages) -> Map VName Usages
grow Map VName Usages
m' (VName
k, Usages
v) = (Map VName Usages -> VName -> Map VName Usages)
-> Map VName Usages -> [VName] -> Map VName Usages
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Usages -> Map VName Usages -> VName -> Map VName Usages
forall k a. (Ord k, Semigroup a) => a -> Map k a -> k -> Map k a
grow'' (Usages -> Map VName Usages -> VName -> Map VName Usages)
-> Usages -> Map VName Usages -> VName -> Map VName Usages
forall a b. (a -> b) -> a -> b
$ Usages
v Usages -> Usages -> Usages
`withoutU` Usages
presentU) Map VName Usages
m' ([VName] -> Map VName Usages) -> [VName] -> Map VName Usages
forall a b. (a -> b) -> a -> b
$
                         Names -> [VName]
namesToList (Names -> [VName]) -> Names -> [VName]
forall a b. (a -> b) -> a -> b
$ VName -> Names
look VName
k
        grow'' :: a -> Map k a -> k -> Map k a
grow'' a
v Map k a
m'' k
k = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) k
k a
v Map k a
m''

is :: Usages -> VName -> UsageTable -> Bool
is :: Usages -> VName -> UsageTable -> Bool
is = (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred ((Usages -> Bool) -> VName -> UsageTable -> Bool)
-> (Usages -> Usages -> Bool)
-> Usages
-> VName
-> UsageTable
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usages -> Usages -> Bool
matches

isConsumed :: VName -> UsageTable -> Bool
isConsumed :: VName -> UsageTable -> Bool
isConsumed = Usages -> VName -> UsageTable -> Bool
is Usages
consumedU

isInResult :: VName -> UsageTable -> Bool
isInResult :: VName -> UsageTable -> Bool
isInResult = Usages -> VName -> UsageTable -> Bool
is Usages
inResultU

-- | Has the given name been used directly (i.e. could we rename it or
-- remove it without anyone noticing?)
isUsedDirectly :: VName -> UsageTable -> Bool
isUsedDirectly :: VName -> UsageTable -> Bool
isUsedDirectly = Usages -> VName -> UsageTable -> Bool
is Usages
presentU

usages :: Names -> UsageTable
usages :: Names -> UsageTable
usages Names
names = Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable) -> Map VName Usages -> UsageTable
forall a b. (a -> b) -> a -> b
$ [(VName, Usages)] -> Map VName Usages
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (VName
name, Usages
presentU) | VName
name <- Names -> [VName]
namesToList Names
names ]

usage :: VName -> Usages -> UsageTable
usage :: VName -> Usages -> UsageTable
usage VName
name Usages
uses = Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable) -> Map VName Usages -> UsageTable
forall a b. (a -> b) -> a -> b
$ VName -> Usages -> Map VName Usages
forall k a. k -> a -> Map k a
M.singleton VName
name Usages
uses

consumedUsage :: VName -> UsageTable
consumedUsage :: VName -> UsageTable
consumedUsage VName
name = Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable) -> Map VName Usages -> UsageTable
forall a b. (a -> b) -> a -> b
$ VName -> Usages -> Map VName Usages
forall k a. k -> a -> Map k a
M.singleton VName
name Usages
consumedU

inResultUsage :: VName -> UsageTable
inResultUsage :: VName -> UsageTable
inResultUsage VName
name = Map VName Usages -> UsageTable
UsageTable (Map VName Usages -> UsageTable) -> Map VName Usages -> UsageTable
forall a b. (a -> b) -> a -> b
$ VName -> Usages -> Map VName Usages
forall k a. k -> a -> Map k a
M.singleton VName
name Usages
inResultU

newtype Usages = Usages Int
  deriving (Usages -> Usages -> Bool
(Usages -> Usages -> Bool)
-> (Usages -> Usages -> Bool) -> Eq Usages
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Usages -> Usages -> Bool
$c/= :: Usages -> Usages -> Bool
== :: Usages -> Usages -> Bool
$c== :: Usages -> Usages -> Bool
Eq, Eq Usages
Eq Usages
-> (Usages -> Usages -> Ordering)
-> (Usages -> Usages -> Bool)
-> (Usages -> Usages -> Bool)
-> (Usages -> Usages -> Bool)
-> (Usages -> Usages -> Bool)
-> (Usages -> Usages -> Usages)
-> (Usages -> Usages -> Usages)
-> Ord Usages
Usages -> Usages -> Bool
Usages -> Usages -> Ordering
Usages -> Usages -> Usages
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Usages -> Usages -> Usages
$cmin :: Usages -> Usages -> Usages
max :: Usages -> Usages -> Usages
$cmax :: Usages -> Usages -> Usages
>= :: Usages -> Usages -> Bool
$c>= :: Usages -> Usages -> Bool
> :: Usages -> Usages -> Bool
$c> :: Usages -> Usages -> Bool
<= :: Usages -> Usages -> Bool
$c<= :: Usages -> Usages -> Bool
< :: Usages -> Usages -> Bool
$c< :: Usages -> Usages -> Bool
compare :: Usages -> Usages -> Ordering
$ccompare :: Usages -> Usages -> Ordering
$cp1Ord :: Eq Usages
Ord, Int -> Usages -> ShowS
[Usages] -> ShowS
Usages -> String
(Int -> Usages -> ShowS)
-> (Usages -> String) -> ([Usages] -> ShowS) -> Show Usages
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Usages] -> ShowS
$cshowList :: [Usages] -> ShowS
show :: Usages -> String
$cshow :: Usages -> String
showsPrec :: Int -> Usages -> ShowS
$cshowsPrec :: Int -> Usages -> ShowS
Show)

instance Semigroup Usages where
  Usages Int
x <> :: Usages -> Usages -> Usages
<> Usages Int
y = Int -> Usages
Usages (Int -> Usages) -> Int -> Usages
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
y

instance Monoid Usages where
  mempty :: Usages
mempty = Int -> Usages
Usages Int
0

consumedU, inResultU, presentU :: Usages
consumedU :: Usages
consumedU = Int -> Usages
Usages Int
1
inResultU :: Usages
inResultU = Int -> Usages
Usages Int
2
presentU :: Usages
presentU = Int -> Usages
Usages Int
4

-- | Check whether the bits that are set in the first argument are
-- also set in the second.
matches :: Usages -> Usages -> Bool
matches :: Usages -> Usages -> Bool
matches (Usages Int
x) (Usages Int
y) = Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
y)

-- | x - y, but for Usages.
withoutU :: Usages -> Usages -> Usages
withoutU :: Usages -> Usages -> Usages
withoutU (Usages Int
x) (Usages Int
y) = Int -> Usages
Usages (Int -> Usages) -> Int -> Usages
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement Int
y