+
+-- collateJoinPoints:
+--
+-- | Look at information about what regs were valid across jumps and work out
+-- whether it's safe to avoid reloads after join points.
+--
+collateJoinPoints :: CleanM ()
+collateJoinPoints
+ = modify $ \s -> s
+ { sJumpValid = mapUFM intersects (sJumpValidAcc s)
+ , sJumpValidAcc = emptyUFM }
+
+intersects :: [Assoc Reg Slot] -> Assoc Reg Slot
+intersects [] = emptyAssoc
+intersects assocs = foldl1' intersectAssoc assocs
+
+
+
+---------------
+type CleanM = State CleanS
+data CleanS
+ = CleanS
+ { -- regs which are valid at the start of each block.
+ sJumpValid :: UniqFM (Assoc Reg Slot)
+
+ -- collecting up what regs were valid across each jump.
+ -- in the next pass we can collate these and write the results
+ -- to sJumpValid.
+ , sJumpValidAcc :: UniqFM [Assoc Reg Slot]
+
+ -- spills/reloads cleaned each pass (latest at front)
+ , sCleanedCount :: [(Int, Int)]
+
+ -- spills/reloads that have been cleaned in this pass so far.
+ , sCleanedSpillsAcc :: Int
+ , sCleanedReloadsAcc :: Int }
+
+initCleanS
+ = CleanS
+ { sJumpValid = emptyUFM
+ , sJumpValidAcc = emptyUFM
+
+ , sCleanedCount = []
+
+ , sCleanedSpillsAcc = 0
+ , sCleanedReloadsAcc = 0 }
+
+
+-- | Remember that these regs were valid before a jump to this block
+accJumpValid :: Assoc Reg Slot -> BlockId -> CleanM ()
+accJumpValid regs target
+ = modify $ \s -> s {
+ sJumpValidAcc = addToUFM_C (++)
+ (sJumpValidAcc s)
+ target
+ [regs] }
+
+
+--------------
+-- An association table / many to many mapping.
+-- TODO: implement this better than a simple association list.
+-- two maps of sets, one for each direction would be better
+--
+data Assoc a b
+ = Assoc
+ { aList :: [(a, b)] }
+
+-- | an empty association
+emptyAssoc :: Assoc a b
+emptyAssoc = Assoc { aList = [] }
+
+
+-- | add an association to the table.
+addAssoc
+ :: (Eq a, Eq b)
+ => a -> b -> Assoc a b -> Assoc a b
+
+addAssoc a b m = m { aList = (a, b) : aList m }
+
+
+-- | check if these two things are associated
+elemAssoc
+ :: (Eq a, Eq b)
+ => a -> b -> Assoc a b -> Bool
+elemAssoc a b m = elem (a, b) $ aList m
+
+
+-- | delete all associations with this A element
+deleteAAssoc
+ :: Eq a
+ => a -> Assoc a b -> Assoc a b
+
+deleteAAssoc x m
+ = m { aList = [ (a, b) | (a, b) <- aList m
+ , a /= x ] }
+
+
+-- | delete all associations with this B element
+deleteBAssoc
+ :: Eq b
+ => b -> Assoc a b -> Assoc a b
+
+deleteBAssoc x m
+ = m { aList = [ (a, b) | (a, b) <- aList m
+ , b /= x ] }
+
+
+-- | intersect two associations
+intersectAssoc
+ :: (Eq a, Eq b)
+ => Assoc a b -> Assoc a b -> Assoc a b
+
+intersectAssoc a1 a2
+ = emptyAssoc
+ { aList = intersect (aList a1) (aList a2) }
+