-- Based on Appel
--
-- live ranges
module LR ( reconstruct
          , reconstructFlat
          ) where

import           CF               hiding (done, liveness)
import           Data.Copointed
-- this seems to be faster
import qualified Data.IntMap.Lazy as IM
import qualified Data.IntSet      as IS

emptyLiveness :: Liveness
emptyLiveness :: Liveness
emptyLiveness = IntSet -> IntSet -> IntSet -> IntSet -> Liveness
Liveness IntSet
IS.empty IntSet
IS.empty IntSet
IS.empty IntSet
IS.empty

initLiveness :: Copointed p => [p ControlAnn] -> LivenessMap
initLiveness :: forall (p :: * -> *). Copointed p => [p ControlAnn] -> LivenessMap
initLiveness = [(Key, (ControlAnn, Liveness))] -> LivenessMap
forall a. [(Key, a)] -> IntMap a
IM.fromList ([(Key, (ControlAnn, Liveness))] -> LivenessMap)
-> ([p ControlAnn] -> [(Key, (ControlAnn, Liveness))])
-> [p ControlAnn]
-> LivenessMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p ControlAnn -> (Key, (ControlAnn, Liveness)))
-> [p ControlAnn] -> [(Key, (ControlAnn, Liveness))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p ControlAnn
asm -> let x :: ControlAnn
x = p ControlAnn -> ControlAnn
forall a. p a -> a
forall (p :: * -> *) a. Copointed p => p a -> a
copoint p ControlAnn
asm in (ControlAnn -> Key
node ControlAnn
x, (ControlAnn
x, Liveness
emptyLiveness)))

type LivenessMap = IM.IntMap (ControlAnn, Liveness)

succNode :: ControlAnn -- ^ 'ControlAnn' associated w/ node @n@
         -> LivenessMap
         -> [Liveness] -- ^ 'Liveness' associated with 'succNode' @n@
succNode :: ControlAnn -> LivenessMap -> [Liveness]
succNode ControlAnn
x LivenessMap
ns =
    let conns :: [Key]
conns = ControlAnn -> [Key]
conn ControlAnn
x
        in (Key -> Liveness) -> [Key] -> [Liveness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ControlAnn, Liveness) -> Liveness
forall a b. (a, b) -> b
snd ((ControlAnn, Liveness) -> Liveness)
-> (Key -> (ControlAnn, Liveness)) -> Key -> Liveness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> LivenessMap -> (ControlAnn, Liveness))
-> LivenessMap -> Key -> (ControlAnn, Liveness)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Key -> LivenessMap -> (ControlAnn, Liveness)
lookupNode LivenessMap
ns) [Key]
conns

lookupNode :: Int -> LivenessMap -> (ControlAnn, Liveness)
lookupNode :: Key -> LivenessMap -> (ControlAnn, Liveness)
lookupNode = (ControlAnn, Liveness)
-> Key -> LivenessMap -> (ControlAnn, Liveness)
forall a. a -> Key -> IntMap a -> a
IM.findWithDefault ([Char] -> (ControlAnn, Liveness)
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: failed to look up instruction")

done :: LivenessMap -> LivenessMap -> Bool
done :: LivenessMap -> LivenessMap -> Bool
done LivenessMap
n0 LivenessMap
n1 = {-# SCC "done" #-} [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((ControlAnn, Liveness) -> (ControlAnn, Liveness) -> Bool)
-> [(ControlAnn, Liveness)] -> [(ControlAnn, Liveness)] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(ControlAnn
_, Liveness
l) (ControlAnn
_, Liveness
l') -> Liveness
l Liveness -> Liveness -> Bool
forall a. Eq a => a -> a -> Bool
== Liveness
l') (LivenessMap -> [(ControlAnn, Liveness)]
forall a. IntMap a -> [a]
IM.elems LivenessMap
n0) (LivenessMap -> [(ControlAnn, Liveness)]
forall a. IntMap a -> [a]
IM.elems LivenessMap
n1) -- n0, n1 have same length

-- order in which to inspect nodes during liveness analysis
inspectOrder :: Copointed p => [p ControlAnn] -> [Int]
inspectOrder :: forall (p :: * -> *). Copointed p => [p ControlAnn] -> [Key]
inspectOrder = (p ControlAnn -> Key) -> [p ControlAnn] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ControlAnn -> Key
node (ControlAnn -> Key)
-> (p ControlAnn -> ControlAnn) -> p ControlAnn -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ControlAnn -> ControlAnn
forall a. p a -> a
forall (p :: * -> *) a. Copointed p => p a -> a
copoint) -- don't need to reverse because thread goes in opposite order

reconstructFlat :: [p ControlAnn] -> [p NLiveness]
reconstructFlat [p ControlAnn]
isns = let is :: [Key]
is=[p ControlAnn] -> [Key]
forall (p :: * -> *). Copointed p => [p ControlAnn] -> [Key]
inspectOrder [p ControlAnn]
isns in [Key] -> LivenessMap -> [p ControlAnn] -> [p NLiveness]
forall (p :: * -> *).
Copointed p =>
[Key] -> LivenessMap -> [p ControlAnn] -> [p NLiveness]
reconstruct [Key]
is ([Key] -> [p ControlAnn] -> LivenessMap
forall (p :: * -> *).
Copointed p =>
[Key] -> [p ControlAnn] -> LivenessMap
mkLiveness [Key]
is [p ControlAnn]
isns) [p ControlAnn]
isns

reconstruct :: (Copointed p) => [Int] -> LivenessMap -> [p ControlAnn] -> [p NLiveness]
reconstruct :: forall (p :: * -> *).
Copointed p =>
[Key] -> LivenessMap -> [p ControlAnn] -> [p NLiveness]
reconstruct [Key]
is LivenessMap
li [p ControlAnn]
asms = {-# SCC "reconstructL" #-} (p ControlAnn -> p NLiveness) -> [p ControlAnn] -> [p NLiveness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ControlAnn -> NLiveness) -> p ControlAnn -> p NLiveness
forall a b. (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ControlAnn -> NLiveness
lookupL) [p ControlAnn]
asms
    where l :: LivenessMap
l = [Key] -> LivenessMap -> LivenessMap
liveness [Key]
is LivenessMap
li
          lookupL :: ControlAnn -> NLiveness
lookupL ControlAnn
x = let ni :: Key
ni = ControlAnn -> Key
node ControlAnn
x in Key -> Liveness -> NLiveness
NLiveness Key
ni ((ControlAnn, Liveness) -> Liveness
forall a b. (a, b) -> b
snd ((ControlAnn, Liveness) -> Liveness)
-> (ControlAnn, Liveness) -> Liveness
forall a b. (a -> b) -> a -> b
$ Key -> LivenessMap -> (ControlAnn, Liveness)
lookupNode Key
ni LivenessMap
l)

{-# SCC mkLiveness #-}
mkLiveness :: Copointed p => [Int] -> [p ControlAnn] -> LivenessMap
mkLiveness :: forall (p :: * -> *).
Copointed p =>
[Key] -> [p ControlAnn] -> LivenessMap
mkLiveness [Key]
is [p ControlAnn]
asms = [Key] -> LivenessMap -> LivenessMap
liveness [Key]
is ([p ControlAnn] -> LivenessMap
forall (p :: * -> *). Copointed p => [p ControlAnn] -> LivenessMap
initLiveness [p ControlAnn]
asms)

liveness :: [Int] -> LivenessMap -> LivenessMap
liveness :: [Key] -> LivenessMap -> LivenessMap
liveness [Key]
is LivenessMap
nSt =
    if LivenessMap -> LivenessMap -> Bool
done LivenessMap
nSt LivenessMap
nSt'
        then LivenessMap
nSt
        else [Key] -> LivenessMap -> LivenessMap
liveness [Key]
is LivenessMap
nSt'
    where nSt' :: LivenessMap
nSt' = {-# SCC "iterNodes" #-} [Key] -> LivenessMap -> LivenessMap
iterNodes [Key]
is LivenessMap
nSt

iterNodes :: [Int] -> LivenessMap -> LivenessMap
iterNodes :: [Key] -> LivenessMap -> LivenessMap
iterNodes [Key]
is = [LivenessMap -> LivenessMap] -> LivenessMap -> LivenessMap
forall {b}. [b -> b] -> b -> b
thread ((Key -> LivenessMap -> LivenessMap)
-> [Key] -> [LivenessMap -> LivenessMap]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Key -> LivenessMap -> LivenessMap
stepNode [Key]
is)
    where thread :: [b -> b] -> b -> b
thread = ((b -> b) -> (b -> b) -> b -> b) -> (b -> b) -> [b -> b] -> b -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) b -> b
forall a. a -> a
id

stepNode :: Int -> LivenessMap -> LivenessMap
stepNode :: Key -> LivenessMap -> LivenessMap
stepNode Key
n LivenessMap
ns = {-# SCC "stepNode" #-} Key -> (ControlAnn, Liveness) -> LivenessMap -> LivenessMap
forall a. Key -> a -> IntMap a -> IntMap a
IM.insert Key
n (ControlAnn
c, IntSet -> IntSet -> IntSet -> IntSet -> Liveness
Liveness IntSet
ins' IntSet
out' IntSet
fins' IntSet
fout') LivenessMap
ns
    where (ControlAnn
c, Liveness
l) = Key -> LivenessMap -> (ControlAnn, Liveness)
lookupNode Key
n LivenessMap
ns; u :: UD
u = ControlAnn -> UD
ud ControlAnn
c
          ins' :: IntSet
ins' = UD -> IntSet
usesNode UD
u IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> (Liveness -> IntSet
out Liveness
l IntSet -> IntSet -> IntSet
IS.\\ UD -> IntSet
defsNode UD
u)
          fins' :: IntSet
fins' = UD -> IntSet
usesFNode UD
u IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> (Liveness -> IntSet
fout Liveness
l IntSet -> IntSet -> IntSet
IS.\\ UD -> IntSet
defsFNode UD
u)
          out' :: IntSet
out' = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions ((Liveness -> IntSet) -> [Liveness] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Liveness -> IntSet
ins (ControlAnn -> LivenessMap -> [Liveness]
succNode ControlAnn
c LivenessMap
ns))
          fout' :: IntSet
fout' = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions ((Liveness -> IntSet) -> [Liveness] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Liveness -> IntSet
fins (ControlAnn -> LivenessMap -> [Liveness]
succNode ControlAnn
c LivenessMap
ns))