[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