[Git][ghc/ghc][wip/andreask/typedUniqFM] Cleanup, remove some untyped UniqFM operations
Andreas Klebinger
gitlab at gitlab.haskell.org
Wed Jun 24 14:10:07 UTC 2020
Andreas Klebinger pushed to branch wip/andreask/typedUniqFM at Glasgow Haskell Compiler / GHC
Commits:
874e5c65 by Andreas Klebinger at 2020-06-24T16:09:41+02:00
Cleanup, remove some untyped UniqFM operations
- - - - -
7 changed files:
- compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- + compiler/GHC/CmmToAsm/Reg/Utils.hs
- compiler/GHC/CmmToAsm/X86/RegInfo.hs
- compiler/GHC/Data/Graph/Ops.hs
- compiler/GHC/Types/Literal.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
=====================================
@@ -282,7 +282,7 @@ spillModify regSlotMap instr reg
= do (instr', nReg) <- patchInstr reg instr
modify $ \s -> s
- { stateSpillSL = addToUFM_C_Directly accSpillSL (stateSpillSL s) (getUnique reg) (reg, 1, 1) }
+ { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
return ( instr'
, ( [LiveInstr (RELOAD slot nReg) Nothing]
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -545,18 +545,16 @@ emptyAssoc = emptyUFM
addAssoc :: Store -> Store -> Assoc Store -> Assoc Store
addAssoc a b m
- = let m1 = addToUFM_C_Directly unionUniqSets m (getUnique a) (unitUniqSet b)
- m2 = addToUFM_C_Directly unionUniqSets m1 (getUnique b) (unitUniqSet a)
+ = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
+ m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
in m2
-- | Delete all associations to a node.
-delAssoc :: (Uniquable a)
- => a -> Assoc a -> Assoc a
-
+delAssoc :: Store -> Assoc Store -> Assoc Store
delAssoc a m
- | Just aSet <- lookupUFM_U m a
- , m1 <- delFromUFM_U m a
+ | Just aSet <- lookupUFM m a
+ , m1 <- delFromUFM m a
= nonDetStrictFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
-- It's OK to use a non-deterministic fold here because deletion is
-- commutative
@@ -565,9 +563,7 @@ delAssoc a m
-- | Delete a single association edge (a -> b).
-delAssoc1 :: Uniquable a
- => a -> a -> Assoc a -> Assoc a
-
+delAssoc1 :: Store -> Store -> Assoc Store -> Assoc Store
delAssoc1 a b m
| Just aSet <- lookupUFM_U m a
= addToUFM_U m a (delOneFromUniqSet aSet b)
@@ -576,22 +572,17 @@ delAssoc1 a b m
-- | Check if these two things are associated.
-elemAssoc :: (Uniquable a)
- => a -> a -> Assoc a -> Bool
+elemAssoc :: Store -> Store -> Assoc Store -> Bool
elemAssoc a b m
= elementOfUniqSet b (closeAssoc a m)
-- | Find the refl. trans. closure of the association from this point.
-closeAssoc :: (Uniquable a)
- => a -> Assoc a -> UniqSet a
-
+closeAssoc :: Store -> Assoc Store -> UniqSet Store
closeAssoc a assoc
= closeAssoc' assoc emptyUniqSet (unitUniqSet a)
where
- -- closeAssoc' :: UniqFM Unique (UniqSet Unique)
- -- -> UniqSet Unique -> UniqSet Unique -> UniqSet Unique
closeAssoc' assoc visited toVisit
= case nonDetEltsUniqSet toVisit of
-- See Note [Unique Determinism and code generation]
@@ -617,6 +608,6 @@ closeAssoc a assoc
(unionUniqSets toVisit neighbors)
-- | Intersect two associations.
-intersectAssoc :: Assoc a -> Assoc a -> Assoc a
+intersectAssoc :: Assoc Store -> Assoc Store -> Assoc Store
intersectAssoc a b
= intersectUFM_C (intersectUniqSets) a b
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -678,7 +678,7 @@ saveClobberedTemps [] _
saveClobberedTemps clobbered dying
= do
- assig <- getAssigR
+ assig <- getAssigR :: RegM freeRegs (UniqFM Reg Loc)
-- Unique represents the VirtualReg
let to_spill :: [(Unique, RealReg)]
to_spill
=====================================
compiler/GHC/CmmToAsm/Reg/Utils.hs
=====================================
@@ -0,0 +1,12 @@
+module GHC.CmmToAsm.Reg.Utils
+ ( toRegMap
+ , toVRegMap
+ )
+where
+
+import GHC.Types.Unique.FM
+
+toRegMap :: UniqFM anyKey -> UniqFM Reg elt
+toRegMap = unsafeCastUFMKey
+
+-- toVRegMap
\ No newline at end of file
=====================================
compiler/GHC/CmmToAsm/X86/RegInfo.hs
=====================================
@@ -38,15 +38,6 @@ regDotColor platform reg
Just str -> text str
_ -> panic "Register not assigned a color"
--- regColors :: Platform -> UniqFM RealReg [Char]
--- regColors platform = listToUFM_Directly (normalRegColors platform)
-
-
--- normalRegColors :: Platform -> [(Unique,String)]
--- normalRegColors platform =
--- zip (map (getUnique . regSingle) [0..lastint platform]) colors
--- ++ zip (map (getUnique . regSingle) [firstxmm..lastxmm platform]) greys
-
regColors :: Platform -> UniqFM RealReg [Char]
regColors platform = listToUFM (normalRegColors platform)
=====================================
compiler/GHC/Data/Graph/Ops.hs
=====================================
@@ -645,15 +645,15 @@ checkNode graph node
slurpNodeConflictCount
:: Graph k cls color
- -> UniqFM Unique (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts)
+ -> UniqFM Int (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts)
slurpNodeConflictCount graph
- = addListToUFM_C_Directly
+ = addListToUFM_C
(\(c1, n1) (_, n2) -> (c1, n1 + n2))
emptyUFM
$ map (\node
-> let count = sizeUniqSet $ nodeConflicts node
- in (getUnique count, (count, 1)))
+ in (count, (count, 1)))
$ nonDetEltsUFM
-- See Note [Unique Determinism and code generation]
$ graphMap graph
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -643,12 +643,13 @@ absentLiteralOf :: TyCon -> Maybe Literal
-- Rubbish literals are handled in GHC.Core.Opt.WorkWrap.Utils, because
-- 1. Looking at the TyCon is not enough, we need the actual type
-- 2. This would need to return a type application to a literal
-absentLiteralOf tc = lookupUFM absent_lits (getUnique $ tyConName tc)
+absentLiteralOf tc = lookupUFM absent_lits tc
--- TODO: This should be a map from TyCon -> Literal. But I don't want
--- to make semantic changes while I refactor UniqFM
-absent_lits :: UniqFM Unique Literal
-absent_lits = listToUFM [ (addrPrimTyConKey, LitNullAddr)
+absent_lits :: UniqFM TyCon Literal
+absent_lits = listToUFM_Directly
+ -- Explicitly construct the mape from the known
+ -- keys of these tyCons.
+ [ (addrPrimTyConKey, LitNullAddr)
, (charPrimTyConKey, LitChar 'x')
, (intPrimTyConKey, mkLitIntUnchecked 0)
, (int64PrimTyConKey, mkLitInt64Unchecked 0)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/874e5c6598d1526f0cb55c914056371338ec7f82
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/874e5c6598d1526f0cb55c914056371338ec7f82
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200624/b0a5043c/attachment-0001.html>
More information about the ghc-commits
mailing list