summaryrefslogtreecommitdiff
path: root/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2015-12-11 18:19:53 -0500
committerRichard Eisenberg <eir@cis.upenn.edu>2015-12-11 18:23:12 -0500
commit6746549772c5cc0ac66c0fce562f297f4d4b80a2 (patch)
tree96869fcfb5757651462511d64d99a3712f09e7fb /compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
parent6e56ac58a6905197412d58e32792a04a63b94d7e (diff)
downloadhaskell-6746549772c5cc0ac66c0fce562f297f4d4b80a2.tar.gz
Add kind equalities to GHC.
This implements the ideas originally put forward in "System FC with Explicit Kind Equality" (ICFP'13). There are several noteworthy changes with this patch: * We now have casts in types. These change the kind of a type. See new constructor `CastTy`. * All types and all constructors can be promoted. This includes GADT constructors. GADT pattern matches take place in type family equations. In Core, types can now be applied to coercions via the `CoercionTy` constructor. * Coercions can now be heterogeneous, relating types of different kinds. A coercion proving `t1 :: k1 ~ t2 :: k2` proves both that `t1` and `t2` are the same and also that `k1` and `k2` are the same. * The `Coercion` type has been significantly enhanced. The documentation in `docs/core-spec/core-spec.pdf` reflects the new reality. * The type of `*` is now `*`. No more `BOX`. * Users can write explicit kind variables in their code, anywhere they can write type variables. For backward compatibility, automatic inference of kind-variable binding is still permitted. * The new extension `TypeInType` turns on the new user-facing features. * Type families and synonyms are now promoted to kinds. This causes trouble with parsing `*`, leading to the somewhat awkward new `HsAppsTy` constructor for `HsType`. This is dispatched with in the renamer, where the kind `*` can be told apart from a type-level multiplication operator. Without `-XTypeInType` the old behavior persists. With `-XTypeInType`, you need to import `Data.Kind` to get `*`, also known as `Type`. * The kind-checking algorithms in TcHsType have been significantly rewritten to allow for enhanced kinds. * The new features are still quite experimental and may be in flux. * TODO: Several open tickets: #11195, #11196, #11197, #11198, #11203. * TODO: Update user manual. Tickets addressed: #9017, #9173, #7961, #10524, #8566, #11142. Updates Haddock submodule.
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Graph/Coalesce.hs')
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Coalesce.hs32
1 files changed, 16 insertions, 16 deletions
diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
index 69f0745dc3..7e8047f29f 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
@@ -23,26 +23,26 @@ import Data.List
-- second reg is born then the mov only serves to join live ranges.
-- The two regs can be renamed to be the same and the move instruction
-- safely erased.
-regCoalesce
+regCoalesce
:: Instruction instr
- => [LiveCmmDecl statics instr]
+ => [LiveCmmDecl statics instr]
-> UniqSM [LiveCmmDecl statics instr]
regCoalesce code
- = do
+ = do
let joins = foldl' unionBags emptyBag
$ map slurpJoinMovs code
- let alloc = foldl' buildAlloc emptyUFM
+ let alloc = foldl' buildAlloc emptyUFM
$ bagToList joins
let patched = map (patchEraseLive (sinkReg alloc)) code
-
+
return patched
-- | Add a v1 = v2 register renaming to the map.
--- The register with the lowest lexical name is set as the
+-- The register with the lowest lexical name is set as the
-- canonical version.
buildAlloc :: UniqFM Reg -> (Reg, Reg) -> UniqFM Reg
buildAlloc fm (r1, r2)
@@ -57,23 +57,23 @@ sinkReg :: UniqFM Reg -> Reg -> Reg
sinkReg fm r
= case lookupUFM fm r of
Nothing -> r
- Just r' -> sinkReg fm r'
-
+ Just r' -> sinkReg fm r'
+
-- | Slurp out mov instructions that only serve to join live ranges.
--
-- During a mov, if the source reg dies and the destiation reg is
-- born then we can rename the two regs to the same thing and
-- eliminate the move.
-slurpJoinMovs
+slurpJoinMovs
:: Instruction instr
- => LiveCmmDecl statics instr
+ => LiveCmmDecl statics instr
-> Bag (Reg, Reg)
slurpJoinMovs live
= slurpCmm emptyBag live
- where
- slurpCmm rs CmmData{}
+ where
+ slurpCmm rs CmmData{}
= rs
slurpCmm rs (CmmProc _ _ _ sccs)
@@ -81,7 +81,7 @@ slurpJoinMovs live
slurpBlock rs (BasicBlock _ instrs)
= foldl' slurpLI rs instrs
-
+
slurpLI rs (LiveInstr _ Nothing) = rs
slurpLI rs (LiveInstr instr (Just live))
| Just (r1, r2) <- takeRegRegMoveInstr instr
@@ -90,10 +90,10 @@ slurpJoinMovs live
-- only coalesce movs between two virtuals for now,
-- else we end up with allocatable regs in the live
- -- regs list..
+ -- regs list..
, isVirtualReg r1 && isVirtualReg r2
= consBag (r1, r2) rs
-
+
| otherwise
= rs
-
+