[commit: ghc] wip/T10137: CmmSwitch: Integrate jstolarekâs wording improvements (537ddb0)
git at git.haskell.org
git at git.haskell.org
Thu Mar 19 14:18:27 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T10137
Link : http://ghc.haskell.org/trac/ghc/changeset/537ddb011de858990aadab4ea6a08f10ec2cbd05/ghc
>---------------------------------------------------------------
commit 537ddb011de858990aadab4ea6a08f10ec2cbd05
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Thu Mar 19 15:18:17 2015 +0100
CmmSwitch: Integrate jstolarek’s wording improvements
>---------------------------------------------------------------
537ddb011de858990aadab4ea6a08f10ec2cbd05
...{CmmCreateSwitchPlans.hs => CmmImplementSwitchPlans.hs} | 8 ++++----
compiler/cmm/CmmPipeline.hs | 4 ++--
compiler/cmm/CmmSwitch.hs | 14 +++++++-------
compiler/codeGen/StgCmmUtils.hs | 2 +-
compiler/ghc.cabal.in | 2 +-
5 files changed, 15 insertions(+), 15 deletions(-)
diff --git a/compiler/cmm/CmmCreateSwitchPlans.hs b/compiler/cmm/CmmImplementSwitchPlans.hs
similarity index 94%
rename from compiler/cmm/CmmCreateSwitchPlans.hs
rename to compiler/cmm/CmmImplementSwitchPlans.hs
index 1ca0cd4..a321489 100644
--- a/compiler/cmm/CmmCreateSwitchPlans.hs
+++ b/compiler/cmm/CmmImplementSwitchPlans.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE GADTs #-}
-module CmmCreateSwitchPlans
- ( cmmCreateSwitchPlans
+module CmmImplementSwitchPlans
+ ( cmmImplementSwitchPlans
)
where
@@ -28,8 +28,8 @@ import DynFlags
-- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for
-- code generation.
-cmmCreateSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph
-cmmCreateSwitchPlans dflags g
+cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph
+cmmImplementSwitchPlans dflags g
| targetSupportsSwitch (hscTarget dflags) = return g
| otherwise = do
blocks' <- concat `fmap` mapM (visitSwitches dflags) (toBlockList g)
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index eb89325..37dbd12 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -11,7 +11,7 @@ import Cmm
import CmmLint
import CmmBuildInfoTables
import CmmCommonBlockElim
-import CmmCreateSwitchPlans
+import CmmImplementSwitchPlans
import CmmProcPoint
import CmmContFlowOpt
import CmmLayoutStack
@@ -73,7 +73,7 @@ cpsTop hsc_env proc =
-- elimCommonBlocks
g <- {-# SCC "createSwitchPlans" #-}
- runUniqSM $ cmmCreateSwitchPlans dflags g
+ runUniqSM $ cmmImplementSwitchPlans dflags g
dump Opt_D_dump_cmm_switch "Post switch plan" g
----------- Proc points -------------------------------------------------
diff --git a/compiler/cmm/CmmSwitch.hs b/compiler/cmm/CmmSwitch.hs
index e58b049..e96b64b 100644
--- a/compiler/cmm/CmmSwitch.hs
+++ b/compiler/cmm/CmmSwitch.hs
@@ -32,7 +32,7 @@ import qualified Data.Map as M
-- * The Stg → Cmm transformation creates a single `SwitchTargets` in
-- emitSwitch and emitCmmLitSwitch in StgCmmUtils.hs.
-- At this stage, they are unsuitable for code generation.
--- * A dedicated Cmm transformation (CmmCreateSwitchPlans) replaces these
+-- * A dedicated Cmm transformation (CmmImplementSwitchPlans) replaces these
-- switch statements with code that is suitable for code generation, i.e.
-- a nice balanced tree of decisions with dense jump tables in the leafs.
-- The actual planning of this tree is performed in pure code in createSwitchPlan
@@ -40,11 +40,11 @@ import qualified Data.Map as M
-- * The actual code generation will not do any further processing and
-- implement each CmmSwitch with a jump tables.
--
--- When compiling to LLVM or C, CmmCreateSwitchPlans leaves the switch
+-- When compiling to LLVM or C, CmmImplementSwitchPlans leaves the switch
-- statements alone, as we can turn a SwitchTargets value into a nice
-- switch-statement in LLVM resp. C, and leave the rest to the compiler.
--
--- See Note [CmmSwitch vs. CmmCreateSwitchPlans] why the two module are
+-- See Note [CmmSwitch vs. CmmImplementSwitchPlans] why the two module are
-- separated.
-----------------------------------------------------------------------------
@@ -393,23 +393,23 @@ reassocTuples initial [] last
reassocTuples initial ((a,b):tuples) last
= (initial,a) : reassocTuples b tuples last
--- Note [CmmSwitch vs. CmmCreateSwitchPlans]
+-- Note [CmmSwitch vs. CmmImplementSwitchPlans]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- I (Joachim) separated the two somewhat closely related modules
--
-- - CmmSwitch, which provides the CmmSwitchTargets type and contains the strategy
-- for implementing a Cmm switch (createSwitchPlan), and
--- - CmmCreateSwitchPlans, which contains the actuall Cmm graph modification,
+-- - CmmImplementSwitchPlans, which contains the actuall Cmm graph modification,
--
-- for these reasons:
--
-- * CmmSwitch is very low in the dependency tree, i.e. does not depend on any
-- GHC specific modules at all (with the exception of Output and Hoople
--- (Literal)). CmmCreateSwitchPlans is the Cmm transformation and hence very
+-- (Literal)). CmmImplementSwitchPlans is the Cmm transformation and hence very
-- high in the dependency tree.
-- * CmmSwitch provides the CmmSwitchTargets data type, which is abstract, but
-- used in CmmNodes.
-- * Because CmmSwitch is low in the dependency tree, the separation allows
-- for more parallelism when building GHC.
-- * The interaction between the modules is very explicit and easy to
--- understande, due to the small and simple interface.
+-- understand, due to the small and simple interface.
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index b9b8016..9e05658 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -494,7 +494,7 @@ mk_discrete_switch _ _tag_expr [(_tag,lbl)] Nothing _
-- In that situation we can be sure the (:) case
-- can't happen, so no need to test
--- SOMETHING MORE COMPLICATED: defer to CmmCreateSwitchPlans
+-- SOMETHING MORE COMPLICATED: defer to CmmImplementSwitchPlans
-- See Note [Cmm Switches, the general plan] in CmmSwitch
mk_discrete_switch signed tag_expr branches mb_deflt range
= mkSwitch tag_expr $ mkSwitchTargets signed range mb_deflt (M.fromList branches)
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 9bbaed7..11c366d 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -197,7 +197,7 @@ Library
CmmPipeline
CmmCallConv
CmmCommonBlockElim
- CmmCreateSwitchPlans
+ CmmImplementSwitchPlans
CmmContFlowOpt
CmmExpr
CmmInfo
More information about the ghc-commits
mailing list