Liveness analysislower-to-isa

5 files changed, 133 insertions, 13 deletions

diff --git a/DataFlow.hs b/DataFlow.hs
index 78ec018..98cf65d 100644
--- a/DataFlow.hs
+++ b/DataFlow.hs
@@ -1,30 +1,53 @@
-module DataFlow(dataFlowAnalysis, Direction(..)) where
+{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
+module DataFlow(dataFlowAnalysis, Direction(..), module Lattice) where
 
 import Data.Function
 import Data.List
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import Lattice
 
 
 data Direction = Forwards | Backwards
   deriving (Show, Eq)
 
 dataFlowAnalysis
-        :: Ord id
+        :: forall id state. (Ord id, Lattice state)
         -- | The direction of the dataflow analysis
-        => Direction               
+        => Direction
         -- | The control flow graph of basic blocks
-        -> Map.Map id [id]         
-        -- | The initial values
-        -> (id -> state)           
+        -> Map.Map id [id]
+        -- | The initial nodes in the analysis (i.e. either the initial
+        -- node or the final nodes)
+        -> [id]
+        -- | The initial value for sources in the analysis
+        -> state
         -- | The transfer function; note that the meaning of the states
         -- depends on the direction
-        -> (state -> id -> state)  
-        -- | For each block, the incoming state and the outgoing state
+        -> (state -> id -> state)
+        -- | For each block that is reachable from 'entryNodes', the
+        -- incoming state and the outgoing state (in CFG order, not
+        -- analysis order)
         -> Map.Map id (state, state)
-dataFlowAnalysis Backwards cfg initF transF =
+dataFlowAnalysis Backwards cfg entryNodes initValue transF =
     Map.map (\(a, b) -> (b, a)) $
-        dataFlowAnalysis Forwards (reverseGraph cfg) initF transF
-dataFlowAnalysis Forwards cfg initF transF = undefined
+        dataFlowAnalysis Forwards (reverseGraph cfg) entryNodes initValue transF
+dataFlowAnalysis Forwards cfg entryNodes initValue transF =
+    let initWorklist = [(from, to) | (from, tos) <- Map.assocs cfg, to <- tos]
+        reachable = floodFill entryNodes cfg
+        initStates = Map.fromList
+            [(lab, if lab `elem` entryNodes then initValue else bottom)
+            | lab <- reachable]
+    in Map.mapWithKey (\k s -> (s, transF s k)) $ flowFixpoint initWorklist initStates
+  where
+    flowFixpoint :: [(id, id)] -> Map.Map id state -> Map.Map id state
+    flowFixpoint [] stateMap = stateMap
+    flowFixpoint ((from, to) : worklist) stateMap =
+        let after = transF (stateMap Map.! from) from `join` (stateMap Map.! to)
+        in if after /= stateMap Map.! to
+               then flowFixpoint (map (to,) (cfg Map.! to) ++ worklist)
+                                 (Map.insert to after stateMap)
+               else flowFixpoint worklist stateMap
 
 
 reverseGraph :: Ord a => Map.Map a [a] -> Map.Map a [a]
@@ -36,3 +59,12 @@ reverseGraph graph =
     $ [(to, from)
       | (from, tos) <- Map.assocs graph
       , to <- tos]
+
+floodFill :: Ord a => [a] -> Map.Map a [a] -> [a]
+floodFill startNodes graph = Set.toList $ go $ Set.fromList startNodes
+  where
+    go seen =
+        let front = Set.fromList (concatMap (graph Map.!) seen) Set.\\ seen
+        in if Set.size front > 0
+               then go (Set.union seen front)
+               else seen
diff --git a/Lattice.hs b/Lattice.hs
new file mode 100644
index 0000000..574c123
--- /dev/null
+++ b/Lattice.hs
@@ -0,0 +1,9 @@
+module Lattice where
+
+
+class Eq a => Lattice a where
+    join :: a -> a -> a
+    bottom :: a
+
+    joinList :: [a] -> a
+    joinList = foldl join bottom
diff --git a/LivenessAnalysis.hs b/LivenessAnalysis.hs
new file mode 100644
index 0000000..fbb3a19
--- /dev/null
+++ b/LivenessAnalysis.hs
@@ -0,0 +1,77 @@
+module LivenessAnalysis(livenessAnalysis) where
+
+import Data.List
+import qualified Data.Map.Strict as Map
+import DataFlow
+
+
+livenessAnalysis :: (Ord id, Ord var)
+                 -- | The basic blocks, containing a list of statements and
+                 -- a list of possible subsequent blocks
+                 => Map.Map id ([stmt], [id])
+                 -- | The blocks that can exit the program
+                 -> [id]
+                 -- | The gen set for a statement: the variables required
+                 -- to be live right before the statement
+                 -> (stmt -> [var])
+                 -- | The kill set for a statement: the variables that are
+                 -- assigned a new value in the statement; note that
+                 -- a variable may be in both the gen and kill sets, in
+                 -- which case the kill entry is ignored
+                 -> (stmt -> [var])
+                 -- | The list of live variables before and after each
+                 -- statement; if a block contains n statements, then its
+                 -- entry in the returned map contains (n+1) lists of
+                 -- variables. These lists are to be placed in between the
+                 -- n statements.
+                 -> Map.Map id [[var]]
+livenessAnalysis cfg exitNodes genF killF =
+    let cfg' = Map.map snd cfg
+        stmtTransF lives stmt = (lives \\ nub (killF stmt)) `union` nub (genF stmt)
+        gkMap = Map.fromList
+            [(i, (g, k))
+            | (i, (stmts, _)) <- Map.assocs cfg
+            , let (g, k) = foldl' (\(g1, k1) stmt ->
+                                        let (g2, k2) = (genF stmt, killF stmt)
+                                        in (k1 `union` k2, (g1 \\ k1) `union` g2))
+                                  ([], [])
+                                  (reverse stmts)]
+        genF' = fst . (gkMap Map.!)
+        killF' = snd . (gkMap Map.!)
+        blockEnds = liveness cfg' exitNodes genF' killF'
+    in Map.mapWithKey (\i endLives ->
+                            scanl stmtTransF
+                                  endLives
+                                  (fst $ cfg Map.! i))
+                      blockEnds
+
+data LivenessLattice var = Lives { getLives :: [var] }
+
+instance Ord var => Eq (LivenessLattice var) where
+    Lives v1 == Lives v2 = sort v1 == sort v2
+
+instance Ord var => Lattice (LivenessLattice var) where
+    bottom = Lives []
+    Lives v1 `join` Lives v2 = Lives (union v1 v2)
+
+liveness :: (Ord id, Ord var)
+         -- | The control flow graph of basic blocks
+         => Map.Map id [id]
+         -- | The blocks that can exit the program
+         -> [id]
+         -- | The gen set for a basic block
+         -> (id -> [var])
+         -- | The kill set for a basic block
+         -> (id -> [var])
+         -- | The list of live variables at the end of the blocks
+         -> Map.Map id [var]
+liveness cfg exitNodes genF killF =
+    -- Nothing is considered to be live at the end of the program, so
+    -- exitValue is bottom
+    let exitValue = bottom
+        genMap = Map.mapWithKey (\k _ -> nub (genF k)) cfg
+        killMap = Map.mapWithKey (\k _ -> nub (killF k)) cfg
+        transF (Lives vars) i =
+            Lives $ (vars \\ (killMap Map.! i)) `union` (genMap Map.! i)
+    in Map.map (getLives . snd) $
+        dataFlowAnalysis Backwards cfg exitNodes exitValue transF
diff --git a/Lower.hs b/Lower.hs
index 8fbe0da..44369b3 100644
--- a/Lower.hs
+++ b/Lower.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE TupleSections, MultiWayIf, GeneralizedNewtypeDeriving #-}
-module Lower(lowerIR) where
+module Lower(lowerIR,
+             AsmProgram'(..), AsmInstr'(..), ARef(..), Immediate(..), Label(..), CCond(..)) where
 
 import AST (Name)
 import Control.Monad.State.Strict
@@ -152,7 +153,6 @@ genTemp = liftM AReg genId
 -- - R15 = stack pointer
 -- - R14 = link register
 -- - R13 = return register
--- - R12 = administration-temporary (TODO can this be eliminated)
 -- - Further registers: available for allocation
 -- R13 and R14 can also be used as administration-temporary if they are not
 -- otherwise occupied.
diff --git a/lisphs.cabal b/lisphs.cabal
index 66dc3c8..75738c2 100644
--- a/lisphs.cabal
+++ b/lisphs.cabal
@@ -18,6 +18,8 @@ executable            lisp
         Compiler
         DataFlow
         Intermediate
+        Lattice
+        LivenessAnalysis
         Lower
         Optimiser
         Parser