diff options
| -rw-r--r-- | LifetimeAnalysis.hs | 111 |
1 files changed, 60 insertions, 51 deletions
diff --git a/LifetimeAnalysis.hs b/LifetimeAnalysis.hs index 0921a8a..aaf0c30 100644 --- a/LifetimeAnalysis.hs +++ b/LifetimeAnalysis.hs @@ -1,6 +1,11 @@ -module LifetimeAnalysis(lifetimeAnalysis, Access(..), unAccess) where +{-# LANGUAGE ScopedTypeVariables #-} +module LifetimeAnalysis(fullLifetimeAnalysis, lifetimeAnalysis, Access(..), unAccess) where + +import Data.List import Data.Maybe +import qualified Data.Map.Strict as Map +import Debug.Trace import Utils @@ -14,55 +19,59 @@ unAccess (Read x) = x type BB a = ([[Access a]], [Int]) -lifetimeAnalysis :: Eq a => a -> [BB a] -> [[Bool]] -lifetimeAnalysis target bbs = - foldOr2 $ map (\p -> markAliveFrom bbs target p (emptyMark bbs)) occurrences +data DUIO a = DUIO {defs :: [a], uses :: [a], ins :: [a], outs :: [a]} + deriving Eq + +lifetimeAnalysis :: (Eq a, Ord a) => a -> [BB a] -> [[Bool]] +lifetimeAnalysis target bbs = map (map (target `elem`)) $ fullLifetimeAnalysis bbs + +fullLifetimeAnalysis :: (Eq a, Ord a) => [BB a] -> [[[a]]] +fullLifetimeAnalysis bbs = + let duios = map fst $ eqFixpoint analysisIterator $ flip map bbs $ + \bb@(_, nexts) -> let (d,u) = defUseAnalysis bb + in (DUIO d u [] [], nexts) + in map markLive $ zip bbs duios + +markLive :: forall a. (Eq a, Ord a) => (BB a, DUIO a) -> [[a]] +markLive ((inaccs, _), duio) = init $ go fullaccs 0 (ins duio) + where + fullaccs = inaccs ++ [map Read (outs duio)] + allvars = nub $ concatMap (map unAccess) fullaccs + lastreads = Map.fromList $ map (\v -> (v, lastReadOf v)) allvars + + lastReadOf v = fromMaybe (-1) $ fmap ((length fullaccs - 1) -) $ + findIndex (Read v `elem`) (reverse fullaccs) + + go :: (Eq a, Ord a) => [[Access a]] -> Int -> [a] -> [[a]] + go [] _ _ = [] + go (acl : rest) i lives = + let (ws, rs) = partitionAccess acl + newlives = union rs $ flip filter (union ws lives) $ \v -> case Map.lookup v lastreads of + Nothing -> False + Just j -> j > i + in lives : go rest (i+1) newlives + +analysisIterator :: (Eq a, Ord a) => [(DUIO a, [Int])] -> [(DUIO a, [Int])] +analysisIterator toplist = map updateIns $ map updateOuts (zip toplist [0..]) where - occurrences :: [(Int, Int)] - occurrences = do - (i, bb) <- zip [0..] bbs - (j, ins) <- zip [0..] (fst bb) - if ins `contains` Write target || ins `contains` Read target - then [(i, j)] - else [] - -emptyMark :: [BB a] -> [[Bool]] -emptyMark bbs = flip map bbs $ \(inss, _) -> map (const False) inss - --- Assumes `target` is known to be alive at `pos`. -markAliveFrom :: Eq a => [BB a] -> a -> (Int, Int) -> [[Bool]] -> [[Bool]] -markAliveFrom bbs target pos topmark = setAt2 (maybe topmark id $ goNoCheck pos topmark) pos True + updateIns (duio, nexts) = (duio {ins = sort $ union (uses duio) (outs duio \\ defs duio)}, nexts) + updateOuts ((duio, nexts), idx) = (duio {outs = sort $ foldl union [] (insAfter idx)}, nexts) + + insAfter = map (ins . fst . (toplist !!)) . snd . (toplist !!) + +defUseAnalysis :: Eq a => BB a -> ([a], [a]) +defUseAnalysis (inss, _) = foldl foldfunc ([], []) inss where - goNoCheck :: (Int, Int) -> [[Bool]] -> Maybe [[Bool]] - goNoCheck (i, j) mark = - let suc = flip filter (successors bbs (i, j)) $ \(i', j') -> - not $ mark !! i' !! j' - markset = setAt2 mark (i, j) True - in case catMaybes [go s markset | s <- suc] of - [] -> Nothing - l -> Just $ foldOr2 l - - go :: (Int, Int) -> [[Bool]] -> Maybe [[Bool]] - go (i, j) mark - | fst (bbs !! i) !! j `contains` Write target = Nothing - | fst (bbs !! i) !! j `contains` Read target = Just $ setAt2 mark (i, j) True - | otherwise = goNoCheck (i, j) mark - -successors :: [BB a] -> (Int, Int) -> [(Int, Int)] -successors bbs (i, j) = - let (inss, nexts) = bbs !! i - in if j < length inss - 1 - then [(i, j + 1)] - else [(n, 0) | n <- nexts] - -modifyAt2 :: [[a]] -> (Int, Int) -> (a -> a) -> [[a]] -modifyAt2 l (i, j) f = modifyAt l i $ \li -> modifyAt li j f - -modifyAt :: [a] -> Int -> (a -> a) -> [a] -modifyAt l i f = let (pre, v : post) = splitAt i l in pre ++ f v : post - -setAt2 :: [[a]] -> (Int, Int) -> a -> [[a]] -setAt2 l p v = modifyAt2 l p (const v) - -foldOr2 :: [[[Bool]]] -> [[Bool]] -foldOr2 = foldl1 (\m1 m2 -> map (map (uncurry (||)) . uncurry zip) (zip m1 m2)) + foldfunc (d, u) accs = + let (ws, rs) = partitionAccess accs + newds = filter (not . (`elem` u)) ws + newus = filter (not . (`elem` d)) rs + in (union d newds, union u newus) + +partitionAccess :: [Access a] -> ([a], [a]) +partitionAccess [] = ([], []) +partitionAccess (Write x : rest) = let (w, r) = partitionAccess rest in (x : w, r) +partitionAccess (Read x : rest) = let (w, r) = partitionAccess rest in (w, x : r) + +eqFixpoint :: Eq a => (a -> a) -> a -> a +eqFixpoint f x = let y = f x in if y == x then x else eqFixpoint f y |