Make a new type synonym CoreProgram = [CoreBind]
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 23 Sep 2011 08:57:42 +0000 (09:57 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 23 Sep 2011 08:57:42 +0000 (09:57 +0100)
and comment its invariants in Note [CoreProgram] in CoreSyn

I'm not totally convinced that CoreProgram is the right name
(perhaps CoreTopBinds might better), but it is useful to have
a clue that you are looking at the top-level bindings.

This is only a matter of a type synonym change; no deep
refactoring here.

23 files changed:
compiler/coreSyn/CoreLint.lhs
compiler/coreSyn/CorePrep.lhs
compiler/coreSyn/CoreSubst.lhs
compiler/coreSyn/CoreSyn.lhs
compiler/ghci/ByteCodeGen.lhs
compiler/iface/TcIface.lhs
compiler/main/GHC.hs
compiler/main/HscMain.lhs
compiler/main/HscTypes.lhs
compiler/main/TidyPgm.lhs
compiler/simplCore/CSE.lhs
compiler/simplCore/CoreMonad.lhs
compiler/simplCore/FloatIn.lhs
compiler/simplCore/FloatOut.lhs
compiler/simplCore/LiberateCase.lhs
compiler/simplCore/OccurAnal.lhs
compiler/simplCore/SAT.lhs
compiler/simplCore/SetLevels.lhs
compiler/simplCore/SimplCore.lhs
compiler/specialise/Rules.lhs
compiler/stgSyn/CoreToStg.lhs
compiler/stranal/DmdAnal.lhs
compiler/stranal/WorkWrap.lhs

index 4478a18..34e294f 100644 (file)
@@ -99,7 +99,7 @@ find an occurence of an Id, we fetch it from the in-scope set.
 
 
 \begin{code}
-lintCoreBindings :: [CoreBind] -> (Bag Message, Bag Message)
+lintCoreBindings :: CoreProgram -> (Bag Message, Bag Message)
 --   Returns (warnings, errors)
 lintCoreBindings binds
   = initL $ 
index 718a38c..9a344be 100644 (file)
@@ -144,7 +144,7 @@ type CpeRhs  = CoreExpr        -- Non-terminal 'rhs'
 %************************************************************************
 
 \begin{code}
-corePrepPgm :: DynFlags -> [CoreBind] -> [TyCon] -> IO [CoreBind]
+corePrepPgm :: DynFlags -> CoreProgram -> [TyCon] -> IO CoreProgram
 corePrepPgm dflags binds data_tycons = do
     showPass dflags "CorePrep"
     us <- mkSplitUniqSupply 's'
index 84092c2..fd40456 100644 (file)
@@ -436,7 +436,7 @@ substBind subst (Rec pairs) = (subst', Rec (bndrs' `zip` rhss'))
 --
 -- [Aug 09] This function is not used in GHC at the moment, but seems so 
 --          short and simple that I'm going to leave it here
-deShadowBinds :: [CoreBind] -> [CoreBind]
+deShadowBinds :: CoreProgram -> CoreProgram
 deShadowBinds binds = snd (mapAccumL substBind emptySubst binds)
 \end{code}
 
@@ -860,8 +860,8 @@ simpleOptExprWith subst expr = simple_opt_expr subst (occurAnalyseExpr expr)
 
 ----------------------
 simpleOptPgm :: DynFlags -> Module 
-             -> [CoreBind] -> [CoreRule] -> [CoreVect] 
-             -> IO ([CoreBind], [CoreRule], [CoreVect])
+             -> CoreProgram -> [CoreRule] -> [CoreVect] 
+             -> IO (CoreProgram, [CoreRule], [CoreVect])
 simpleOptPgm dflags this_mod binds rules vects
   = do { dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
                        (pprCoreBindings occ_anald_binds $$ pprRules rules );
index 32aafd4..2d5331a 100644 (file)
@@ -10,7 +10,7 @@
 module CoreSyn (
        -- * Main data types
        Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
-       CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
+       CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
        TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
 
         -- ** 'Expr' construction
@@ -831,7 +831,29 @@ cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
 %*                                                                     *
 %************************************************************************
 
+Note [CoreProgram]
+~~~~~~~~~~~~~~~~~~
+The top level bindings of a program, a CoreProgram, are represented as
+a list of CoreBind
+
+ * Later bindings in the list can refer to earlier ones, but not vice
+   versa.  So this is OK
+      NonRec { x = 4 }
+      Rec { p = ...q...x...
+          ; q = ...p...x }
+      Rec { f = ...p..x..f.. }
+      NonRec { g = ..f..q...x.. }
+   But it would NOT be ok for 'f' to refer to 'g'.
+
+ * The occurrence analyser does strongly-connected component analysis
+   on each Rec binding, and splits it into a sequence of smaller
+   bindings where possible.  So the program typically starts life as a
+   single giant Rec, which is then dependency-analysed into smaller
+   chunks.  
+
 \begin{code}
+type CoreProgram = [CoreBind]  -- See Note [CoreProgram]
+
 -- | The common case for the type of binders and variables when
 -- we are manipulating the Core language within GHC
 type CoreBndr = Var
index 66ad5a6..71a21c1 100644 (file)
@@ -65,7 +65,7 @@ import qualified FiniteMap as Map
 -- Generating byte code for a complete module
 
 byteCodeGen :: DynFlags
-            -> [CoreBind]
+            -> CoreProgram
             -> [TyCon]
             -> ModBreaks
             -> IO CompiledByteCode
index f0e09b4..328770b 100644 (file)
@@ -1028,7 +1028,7 @@ tcIfaceDataAlt con inst_tys arg_strs rhs
 
 
 \begin{code}
-tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind]  -- Used for external core
+tcExtCoreBindings :: [IfaceBinding] -> IfL CoreProgram -- Used for external core
 tcExtCoreBindings []     = return []
 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
 
index 928f21e..5e1eaac 100644 (file)
@@ -769,7 +769,7 @@ data CoreModule
       -- | Type environment for types declared in this module
       cm_types    :: !TypeEnv,
       -- | Declarations
-      cm_binds    :: [CoreBind]
+      cm_binds    :: CoreProgram
     }
 
 instance Outputable CoreModule where
index 1842799..445a9ca 100644 (file)
@@ -1211,7 +1211,7 @@ tryNewCodeGen hsc_env this_mod data_tycons
         ; return prog' }
 
 
-myCoreToStg :: DynFlags -> Module -> [CoreBind]
+myCoreToStg :: DynFlags -> Module -> CoreProgram
             -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program
                  , CollectedCCs) -- cost centre info (declared and used)
 
@@ -1473,7 +1473,7 @@ hscParseThingWithLocation source linenumber parser str
 hscCompileCore :: HscEnv
                -> Bool
                -> ModSummary
-               -> [CoreBind]
+               -> CoreProgram
                -> IO ()
 
 hscCompileCore hsc_env simplify mod_summary binds
@@ -1487,7 +1487,7 @@ hscCompileCore hsc_env simplify mod_summary binds
       return ()
 
 -- Makes a "vanilla" ModGuts.
-mkModGuts :: Module -> [CoreBind] -> ModGuts
+mkModGuts :: Module -> CoreProgram -> ModGuts
 mkModGuts mod binds = ModGuts {
   mg_module = mod,
   mg_boot = False,
index 79c5c13..c14544c 100644 (file)
@@ -121,7 +121,7 @@ import Module
 import InstEnv          ( InstEnv, Instance )
 import FamInstEnv
 import Rules            ( RuleBase )
-import CoreSyn          ( CoreBind )
+import CoreSyn          ( CoreProgram )
 import VarEnv
 import VarSet
 import Var
@@ -757,7 +757,7 @@ data ModGuts
        mg_fam_insts :: ![FamInst],      -- ^ Family instances declared in this module
         mg_rules     :: ![CoreRule],    -- ^ Before the core pipeline starts, contains 
                                         -- See Note [Overall plumbing for rules] in Rules.lhs
-       mg_binds     :: ![CoreBind],     -- ^ Bindings for this module
+       mg_binds     :: !CoreProgram,    -- ^ Bindings for this module
        mg_foreign   :: !ForeignStubs,   -- ^ Foreign exports declared in this module
        mg_warns     :: !Warnings,       -- ^ Warnings declared in the module
         mg_anns      :: [Annotation],    -- ^ Annotations declared in this module
@@ -813,7 +813,7 @@ data CgGuts
                -- tables. Includes newtypes, just for the benefit of
                -- External Core
 
-       cg_binds    :: [CoreBind],
+       cg_binds    :: CoreProgram,
                -- ^ The tidied main bindings, including
                -- previously-implicit bindings for record and class
                -- selectors, and data construtor wrappers.  But *not*
index 95a0871..980b46c 100644 (file)
@@ -997,8 +997,8 @@ rules are externalised (see init_ext_ids in function
 tidyTopBinds :: HscEnv
             -> UnfoldEnv
              -> TidyOccEnv
-            -> [CoreBind]
-            -> (TidyEnv, [CoreBind])
+            -> CoreProgram
+            -> (TidyEnv, CoreProgram)
 
 tidyTopBinds hsc_env unfold_env init_occ_env binds
   = tidy init_env binds
index b5fc41f..2f5c38e 100644 (file)
@@ -185,7 +185,7 @@ happen now that we don't look inside INLINEs (which wrappers are).
 %************************************************************************
 
 \begin{code}
-cseProgram :: [CoreBind] -> [CoreBind]
+cseProgram :: CoreProgram -> CoreProgram
 cseProgram binds = cseBinds emptyCSEnv binds
 
 cseBinds :: CSEnv -> [CoreBind] -> [CoreBind]
index df515d1..6ad402c 100644 (file)
@@ -128,7 +128,7 @@ stuff before and after core passes, and do Core Lint when necessary.
 showPass :: DynFlags -> CoreToDo -> IO ()
 showPass dflags pass = Err.showPass dflags (showSDoc (ppr pass))
 
-endPass :: DynFlags -> CoreToDo -> [CoreBind] -> [CoreRule] -> IO ()
+endPass :: DynFlags -> CoreToDo -> CoreProgram -> [CoreRule] -> IO ()
 endPass dflags pass binds rules
   = do { dumpPassResult dflags mb_flag (ppr pass) empty binds rules
        ; lintPassResult dflags pass binds }      
@@ -147,7 +147,7 @@ dumpPassResult :: DynFlags
                                        --            name is specified by df
                -> SDoc                         -- Header
                -> SDoc                         -- Extra info to appear after header
-               -> [CoreBind] -> [CoreRule] 
+               -> CoreProgram -> [CoreRule] 
                -> IO ()
 dumpPassResult dflags mb_flag hdr extra_info binds rules
   | Just dflag <- mb_flag
@@ -169,7 +169,7 @@ dumpPassResult dflags mb_flag hdr extra_info binds rules
                     , ptext (sLit "------ Local rules for imported ids --------")
                     , pprRules rules ]
 
-lintPassResult :: DynFlags -> CoreToDo -> [CoreBind] -> IO ()
+lintPassResult :: DynFlags -> CoreToDo -> CoreProgram -> IO ()
 lintPassResult dflags pass binds
   = when (dopt Opt_DoCoreLinting dflags) $
     do { let (warns, errs) = lintCoreBindings binds
@@ -177,7 +177,7 @@ lintPassResult dflags pass binds
        ; displayLintResults dflags pass warns errs binds  }
 
 displayLintResults :: DynFlags -> CoreToDo
-                   -> Bag Err.Message -> Bag Err.Message -> [CoreBind]
+                   -> Bag Err.Message -> Bag Err.Message -> CoreProgram
                    -> IO ()
 displayLintResults dflags pass warns errs binds
   | not (isEmptyBag errs)
@@ -444,7 +444,7 @@ defaultPlugin = Plugin {
 -- | A description of the plugin pass itself
 type PluginPass = ModGuts -> CoreM ModGuts
 
-bindsOnlyPass :: ([CoreBind] -> CoreM [CoreBind]) -> ModGuts -> CoreM ModGuts
+bindsOnlyPass :: (CoreProgram -> CoreM CoreProgram) -> ModGuts -> CoreM ModGuts
 bindsOnlyPass pass guts
   = do { binds' <- pass (mg_binds guts)
        ; return (guts { mg_binds = binds' }) }
index 48daf78..0e49f16 100644 (file)
@@ -32,7 +32,7 @@ Top-level interface function, @floatInwards@.  Note that we do not
 actually float any bindings downwards from the top-level.
 
 \begin{code}
-floatInwards :: [CoreBind] -> [CoreBind]
+floatInwards :: CoreProgram -> CoreProgram
 floatInwards = map fi_top_bind
   where
     fi_top_bind (NonRec binder rhs)
index e6195e9..bcd118a 100644 (file)
@@ -114,7 +114,7 @@ Well, maybe.  We don't do this at the moment.
 floatOutwards :: FloatOutSwitches
              -> DynFlags
              -> UniqSupply 
-             -> [CoreBind] -> IO [CoreBind]
+             -> CoreProgram -> IO CoreProgram
 
 floatOutwards float_sws dflags us pgm
   = do {
index fe1f758..8caa29a 100644 (file)
@@ -117,7 +117,7 @@ and the level of @h@ is zero (NB not one).
 %************************************************************************
 
 \begin{code}
-liberateCase :: DynFlags -> [CoreBind] -> [CoreBind]
+liberateCase :: DynFlags -> CoreProgram -> CoreProgram
 liberateCase dflags binds = do_prog (initEnv dflags) binds
   where
     do_prog _   [] = []
index 8a5327e..b53c98f 100644 (file)
@@ -55,7 +55,7 @@ Here's the externally-callable interface:
 occurAnalysePgm :: Module      -- Used only in debug output
                 -> (Activation -> Bool) 
                 -> [CoreRule] -> [CoreVect]
-                -> [CoreBind] -> [CoreBind]
+                -> CoreProgram -> CoreProgram
 occurAnalysePgm this_mod active_rule imp_rules vects binds
   | isEmptyVarEnv final_usage
   = binds'
index 6118289..acc11ca 100644 (file)
@@ -75,7 +75,7 @@ import FastString
 \end{code}
 
 \begin{code}
-doStaticArgs :: UniqSupply -> [CoreBind] -> [CoreBind]
+doStaticArgs :: UniqSupply -> CoreProgram -> CoreProgram
 doStaticArgs us binds = snd $ mapAccumL sat_bind_threaded_us us binds
   where
     sat_bind_threaded_us us bind =
index 3f665fc..bbeb5d3 100644 (file)
@@ -206,7 +206,7 @@ instance Eq Level where
 
 \begin{code}
 setLevels :: FloatOutSwitches
-         -> [CoreBind]
+         -> CoreProgram
          -> UniqSupply
          -> [LevelledBind]
 
index 3c89b0f..5075075 100644 (file)
@@ -409,7 +409,7 @@ doCorePass pass = pprPanic "doCorePass" (ppr pass)
 %************************************************************************
 
 \begin{code}
-printCore :: a -> [CoreBind] -> IO ()
+printCore :: a -> CoreProgram -> IO ()
 printCore _ binds = Err.dumpIfSet True "Print Core" (pprCoreBindings binds)
 
 ruleCheckPass :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts
@@ -421,36 +421,36 @@ ruleCheckPass current_phase pat guts = do
     return guts
 
 
-doPassDUM :: (DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind]) -> ModGuts -> CoreM ModGuts
+doPassDUM :: (DynFlags -> UniqSupply -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts
 doPassDUM do_pass = doPassM $ \binds -> do
     dflags <- getDynFlags
     us     <- getUniqueSupplyM
     liftIO $ do_pass dflags us binds
 
-doPassDM :: (DynFlags -> [CoreBind] -> IO [CoreBind]) -> ModGuts -> CoreM ModGuts
+doPassDM :: (DynFlags -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts
 doPassDM do_pass = doPassDUM (\dflags -> const (do_pass dflags))
 
-doPassD :: (DynFlags -> [CoreBind] -> [CoreBind]) -> ModGuts -> CoreM ModGuts
+doPassD :: (DynFlags -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
 doPassD do_pass = doPassDM (\dflags -> return . do_pass dflags)
 
-doPassDU :: (DynFlags -> UniqSupply -> [CoreBind] -> [CoreBind]) -> ModGuts -> CoreM ModGuts
+doPassDU :: (DynFlags -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
 doPassDU do_pass = doPassDUM (\dflags us -> return . do_pass dflags us)
 
-doPassU :: (UniqSupply -> [CoreBind] -> [CoreBind]) -> ModGuts -> CoreM ModGuts
+doPassU :: (UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
 doPassU do_pass = doPassDU (const do_pass)
 
 -- Most passes return no stats and don't change rules: these combinators
 -- let us lift them to the full blown ModGuts+CoreM world
-doPassM :: Monad m => ([CoreBind] -> m [CoreBind]) -> ModGuts -> m ModGuts
+doPassM :: Monad m => (CoreProgram -> m CoreProgram) -> ModGuts -> m ModGuts
 doPassM bind_f guts = do
     binds' <- bind_f (mg_binds guts)
     return (guts { mg_binds = binds' })
 
-doPass :: ([CoreBind] -> [CoreBind]) -> ModGuts -> CoreM ModGuts
+doPass :: (CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
 doPass bind_f guts = return $ guts { mg_binds = bind_f (mg_binds guts) }
 
 -- Observer passes just peek; don't modify the bindings at all
-observe :: (DynFlags -> [CoreBind] -> IO a) -> ModGuts -> CoreM ModGuts
+observe :: (DynFlags -> CoreProgram -> IO a) -> ModGuts -> CoreM ModGuts
 observe do_pass = doPassM $ \binds -> do
     dflags <- getDynFlags
     _ <- liftIO $ do_pass dflags binds
@@ -559,7 +559,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
     do_iteration :: UniqSupply
                  -> Int                 -- Counts iterations
                 -> [SimplCount] -- Counts from earlier iterations, reversed
-                -> [CoreBind]   -- Bindings in
+                -> CoreProgram  -- Bindings in
                 -> [CoreRule]   -- and orphan rules
                 -> IO (String, Int, SimplCount, ModGuts)
 
@@ -664,7 +664,7 @@ simplifyPgmIO _ _ _ _ _ = panic "simplifyPgmIO"
 
 -------------------
 end_iteration :: DynFlags -> CoreToDo -> Int 
-             -> SimplCount -> [CoreBind] -> [CoreRule] -> IO ()
+             -> SimplCount -> CoreProgram -> [CoreRule] -> IO ()
 end_iteration dflags pass iteration_no counts binds rules
   = do { dumpPassResult dflags mb_flag hdr pp_counts binds rules
        ; lintPassResult dflags pass binds }
@@ -807,7 +807,7 @@ unfolding for something.
 \begin{code}
 type IndEnv = IdEnv Id         -- Maps local_id -> exported_id
 
-shortOutIndirections :: [CoreBind] -> [CoreBind]
+shortOutIndirections :: CoreProgram -> CoreProgram
 shortOutIndirections binds
   | isEmptyVarEnv ind_env = binds
   | no_need_to_flatten   = binds'                      -- See Note [Rules and indirect-zapping]
index f9d02e5..a439f2a 100644 (file)
@@ -1014,7 +1014,7 @@ is so important.
 ruleCheckProgram :: CompilerPhase               -- ^ Rule activation test
                  -> String                      -- ^ Rule pattern
                  -> RuleBase                    -- ^ Database of rules
-                 -> [CoreBind]                  -- ^ Bindings to check in
+                 -> CoreProgram                 -- ^ Bindings to check in
                  -> SDoc                        -- ^ Resulting check message
 ruleCheckProgram phase rule_pat rule_base binds 
   | isEmptyBag results
index 1ebb564..1705f0e 100644 (file)
@@ -140,7 +140,7 @@ for x, solely to put in the SRTs lower down.
 %************************************************************************
 
 \begin{code}
-coreToStg :: PackageId -> [CoreBind] -> IO [StgBinding]
+coreToStg :: PackageId -> CoreProgram -> IO [StgBinding]
 coreToStg this_pkg pgm
   = return pgm'
   where (_, _, pgm') = coreTopBindsToStg this_pkg emptyVarEnv pgm
@@ -153,7 +153,7 @@ coreExprToStg expr
 coreTopBindsToStg
     :: PackageId
     -> IdEnv HowBound           -- environment for the bindings
-    -> [CoreBind]
+    -> CoreProgram
     -> (IdEnv HowBound, FreeVarsInfo, [StgBinding])
 
 coreTopBindsToStg _        env [] = (env, emptyFVInfo, [])
index fab75a0..9955490 100644 (file)
@@ -62,14 +62,14 @@ To think about
 %************************************************************************
 
 \begin{code}
-dmdAnalPgm :: DynFlags -> [CoreBind] -> IO [CoreBind]
+dmdAnalPgm :: DynFlags -> CoreProgram -> IO CoreProgram
 dmdAnalPgm _ binds
   = do {
        let { binds_plus_dmds = do_prog binds } ;
        return binds_plus_dmds
     }
   where
-    do_prog :: [CoreBind] -> [CoreBind]
+    do_prog :: CoreProgram -> CoreProgram
     do_prog binds = snd $ mapAccumL dmdAnalTopBind emptySigEnv binds
 
 dmdAnalTopBind :: SigEnv
index ac10b1b..c1e9c48 100644 (file)
@@ -54,7 +54,7 @@ info for exported values).
 \end{enumerate}
 
 \begin{code}
-wwTopBinds :: UniqSupply -> [CoreBind] -> [CoreBind]
+wwTopBinds :: UniqSupply -> CoreProgram -> CoreProgram
 
 wwTopBinds us top_binds
   = initUs_ us $ do