Comments and esthetical changes.

2 files changed, 113 insertions, 87 deletions

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index bbc5a485c6..bbc8051246 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -171,10 +171,10 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
            = do stub_o <- compileStub dflags' this_mod location
                 return [ DotO stub_o ]
 
-       handleMake (NewHscNoRecomp, iface, details)
+       handleMake (HscNoRecomp, iface, details)
            = ASSERT (isJust maybe_old_linkable)
              return (CompOK details iface maybe_old_linkable)
-       handleMake (NewHscRecomp hasStub, iface, details)
+       handleMake (HscRecomp hasStub, iface, details)
            | isHsBoot src_flavour
                = return (CompOK details iface Nothing)
            | otherwise
@@ -757,13 +757,13 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
 
 	case mbResult of
           Nothing -> throwDyn (PhaseFailed "hsc" (ExitFailure 1))
-          Just NewHscNoRecomp
+          Just HscNoRecomp
               -> do SysTools.touch dflags' "Touching object file" o_file
                     -- The .o file must have a later modification date
                     -- than the source file (else we wouldn't be in HscNoRecomp)
                     -- but we touch it anyway, to keep 'make' happy (we think).
                     return (StopLn, dflags', Just location4, o_file)
-          Just (NewHscRecomp hasStub)
+          Just (HscRecomp hasStub)
               -> do when hasStub $
                          do stub_o <- compileStub dflags' mod_name location4
                             consIORef v_Ld_inputs stub_o
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 46bf3e8f7a..3885bd3665 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -168,14 +168,16 @@ data HscChecked
         (Maybe (LHsBinds Id, GlobalRdrEnv, ModDetails))
 
 
+-- Status of a compilation to hard-code or nothing.
 data HscStatus
-    = NewHscNoRecomp
-    | NewHscRecomp  Bool         -- Has stub files.
-                                 -- This is a hack. We can't compile C files here
-                                 -- since it's done in DriverPipeline. For now we
-                                 -- just return True if we want the caller to compile
-                                 -- it for us.
-
+    = HscNoRecomp
+    | HscRecomp  Bool -- Has stub files.
+                      -- This is a hack. We can't compile C files here
+                      -- since it's done in DriverPipeline. For now we
+                      -- just return True if we want the caller to compile
+                      -- it for us.
+
+-- Status of a compilation to byte-code.
 data InteractiveStatus
     = InteractiveNoRecomp
     | InteractiveRecomp Bool     -- Same as HscStatus
@@ -195,6 +197,9 @@ type Compiler result =  HscEnv
                      -> IO (Maybe result)
 
 
+-- This functions checks if recompilation is necessary and
+-- then combines the FrontEnd, BackEnd and CodeGen to a
+-- working compiler.
 hscMkCompiler :: NoRecomp result         -- What to do when recompilation isn't required.
               -> FrontEnd core
               -> BackEnd core prepCore
@@ -222,11 +227,15 @@ hscMkCompiler norecomp frontend backend codegen
                                  result <- codegen hsc_env mod_summary prepCore
                                  return (Just result)
 
+--------------------------------------------------------------
+-- Compilers
+--------------------------------------------------------------
+
 -- Compile Haskell, boot and extCore in OneShot mode.
 hscCompileOneShot :: Compiler HscStatus
 hscCompileOneShot hsc_env mod_summary =
     compiler hsc_env mod_summary
-    where mkComp = hscMkCompiler (norecompOneShot NewHscNoRecomp)
+    where mkComp = hscMkCompiler (norecompOneShot HscNoRecomp)
           compiler
               = case ms_hsc_src mod_summary of
                 ExtCoreFile
@@ -236,7 +245,7 @@ hscCompileOneShot hsc_env mod_summary =
                     -> mkComp hscFileFrontEnd hscNewBackEnd hscCodeGenOneShot
                 HsBootFile
                     -> mkComp hscFileFrontEnd hscNewBootBackEnd
-                              (hscCodeGenConst (NewHscRecomp False))
+                              (hscCodeGenConst (HscRecomp False))
 
 -- Compile Haskell, boot and extCore in --make mode.
 hscCompileMake :: Compiler (HscStatus, ModIface, ModDetails)
@@ -244,7 +253,7 @@ hscCompileMake hsc_env mod_summary
     = compiler hsc_env mod_summary
     where mkComp = hscMkCompiler norecompMake
           backend = case hscTarget (hsc_dflags hsc_env) of
-                      HscNothing -> hscCodeGenSimple (\(i, d, g) -> (NewHscRecomp False, i, d))
+                      HscNothing -> hscCodeGenSimple (\(i, d, g) -> (HscRecomp False, i, d))
                       _other     -> hscCodeGenMake
           compiler
               = case ms_hsc_src mod_summary of
@@ -268,6 +277,10 @@ hscCompileInteractive hsc_env mod_summary =
           bootErrorMsg = "Compiling a HsBootFile to bytecode doesn't make sense. " ++
                          "Use 'hscCompileMake' instead."
 
+--------------------------------------------------------------
+-- NoRecomp handlers
+--------------------------------------------------------------
+
 norecompOneShot :: a -> NoRecomp a
 norecompOneShot a hsc_env mod_summary 
                 have_object old_iface
@@ -278,7 +291,7 @@ norecompOneShot a hsc_env mod_summary
          return a
 
 norecompMake :: NoRecomp (HscStatus, ModIface, ModDetails)
-norecompMake = norecompWorker NewHscNoRecomp
+norecompMake = norecompWorker HscNoRecomp
 
 norecompInteractive :: NoRecomp (InteractiveStatus, ModIface, ModDetails)
 norecompInteractive = norecompWorker InteractiveNoRecomp
@@ -295,6 +308,83 @@ norecompWorker a hsc_env mod_summary have_object
          dumpIfaceStats hsc_env
          return (a, old_iface, new_details)
 
+--------------------------------------------------------------
+-- FrontEnds
+--------------------------------------------------------------
+
+hscCoreFrontEnd :: FrontEnd ModGuts
+hscCoreFrontEnd hsc_env mod_summary mb_mod_index = do {
+ 	    -------------------
+ 	    -- PARSE
+ 	    -------------------
+	; inp <- readFile (expectJust "hscCoreFrontEnd" (ms_hspp_file mod_summary))
+	; case parseCore inp 1 of
+	    FailP s        -> do errorMsg (hsc_dflags hsc_env) (text s{-ToDo: wrong-})
+                                 return Nothing
+	    OkP rdr_module -> do {
+    
+ 	    -------------------
+ 	    -- RENAME and TYPECHECK
+ 	    -------------------
+	; (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
+			      tcRnExtCore hsc_env rdr_module
+	; printErrorsAndWarnings (hsc_dflags hsc_env) tc_msgs
+	; case maybe_tc_result of
+      	     Nothing       -> return Nothing
+      	     Just mod_guts -> return (Just mod_guts)	-- No desugaring to do!
+	}}
+	 
+hscFileFrontEnd :: FrontEnd ModGuts
+hscFileFrontEnd hsc_env mod_summary mb_mod_index = do {
+ 	    -------------------
+ 	    -- DISPLAY PROGRESS MESSAGE
+ 	    -------------------
+	; let dflags    = hsc_dflags hsc_env
+	      one_shot  = isOneShot (ghcMode dflags)
+	      toInterp  = hscTarget dflags == HscInterpreted
+      	; when (not one_shot) $
+		 compilationProgressMsg dflags $
+		 (showModuleIndex mb_mod_index ++
+                  "Compiling " ++ showModMsg (not toInterp) mod_summary)
+			
+ 	    -------------------
+ 	    -- PARSE
+ 	    -------------------
+	; let hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
+	      hspp_buf  = ms_hspp_buf  mod_summary
+
+	; maybe_parsed <- myParseModule dflags hspp_file hspp_buf
+
+	; case maybe_parsed of {
+      	     Left err -> do { printBagOfErrors dflags (unitBag err)
+			    ; return Nothing } ;
+      	     Right rdr_module -> do {
+
+ 	    -------------------
+ 	    -- RENAME and TYPECHECK
+ 	    -------------------
+	  (tc_msgs, maybe_tc_result) 
+		<- {-# SCC "Typecheck-Rename" #-}
+		   tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
+
+	; printErrorsAndWarnings dflags tc_msgs
+	; case maybe_tc_result of {
+      	     Nothing -> return Nothing ;
+      	     Just tc_result -> do {
+
+ 	    -------------------
+ 	    -- DESUGAR
+ 	    -------------------
+	; (warns, maybe_ds_result) <- {-# SCC "DeSugar" #-}
+		 	     deSugar hsc_env tc_result
+	; printBagOfWarnings dflags warns
+	; return maybe_ds_result
+	}}}}}
+
+--------------------------------------------------------------
+-- BackEnds
+--------------------------------------------------------------
+
 hscNewBootBackEnd :: BackEnd ModGuts (HscStatus, ModIface, ModDetails)
 hscNewBootBackEnd hsc_env mod_summary maybe_old_iface ds_result
   = do details <- mkBootModDetails hsc_env ds_result
@@ -304,7 +394,7 @@ hscNewBootBackEnd hsc_env mod_summary maybe_old_iface ds_result
        writeIfaceFile hsc_env (ms_location mod_summary) new_iface no_change
        -- And the answer is ...
        dumpIfaceStats hsc_env
-       return (NewHscRecomp False, new_iface, details)
+       return (HscRecomp False, new_iface, details)
 
 hscNewBackEnd :: BackEnd ModGuts (ModIface, ModDetails, CgGuts)
 hscNewBackEnd hsc_env mod_summary maybe_old_iface ds_result
@@ -379,22 +469,26 @@ hscNewBackEnd hsc_env mod_summary maybe_old_iface ds_result
 	; return (new_iface, details, cg_guts)
       	 }
 
+--------------------------------------------------------------
+-- Code generators
+--------------------------------------------------------------
+
 -- Don't output any code.
 hscCodeGenNothing :: CodeGen (ModIface, ModDetails, CgGuts) (HscStatus, ModIface, ModDetails)
 hscCodeGenNothing hsc_env mod_summary (iface, details, cgguts)
-    = return (NewHscRecomp False, iface, details)
+    = return (HscRecomp False, iface, details)
 
 -- Generate code and return both the new ModIface and the ModDetails.
 hscCodeGenMake :: CodeGen (ModIface, ModDetails, CgGuts) (HscStatus, ModIface, ModDetails)
 hscCodeGenMake hsc_env mod_summary (iface, details, cgguts)
     = do hasStub <- hscCodeGenCompile hsc_env mod_summary cgguts
-         return (NewHscRecomp hasStub, iface, details)
+         return (HscRecomp hasStub, iface, details)
 
 -- Here we don't need the ModIface and ModDetails anymore.
 hscCodeGenOneShot :: CodeGen (ModIface, ModDetails, CgGuts) HscStatus
 hscCodeGenOneShot hsc_env mod_summary (_, _, cgguts)
     = do hasStub <- hscCodeGenCompile hsc_env mod_summary cgguts
-         return (NewHscRecomp hasStub)
+         return (HscRecomp hasStub)
 
 hscCodeGenCompile :: CodeGen CgGuts Bool
 hscCodeGenCompile hsc_env mod_summary cgguts
@@ -478,74 +572,6 @@ hscCodeGenInteractive hsc_env mod_summary (iface, details, cgguts)
 #endif
 
 
-hscCoreFrontEnd :: FrontEnd ModGuts
-hscCoreFrontEnd hsc_env mod_summary mb_mod_index = do {
- 	    -------------------
- 	    -- PARSE
- 	    -------------------
-	; inp <- readFile (expectJust "hscCoreFrontEnd" (ms_hspp_file mod_summary))
-	; case parseCore inp 1 of
-	    FailP s        -> errorMsg (hsc_dflags hsc_env) (text s{-ToDo: wrong-}) >> return Nothing
-	    OkP rdr_module -> do {
-    
- 	    -------------------
- 	    -- RENAME and TYPECHECK
- 	    -------------------
-	; (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
-			      tcRnExtCore hsc_env rdr_module
-	; printErrorsAndWarnings (hsc_dflags hsc_env) tc_msgs
-	; case maybe_tc_result of
-      	     Nothing       -> return Nothing
-      	     Just mod_guts -> return (Just mod_guts)	-- No desugaring to do!
-	}}
-	 
-hscFileFrontEnd :: FrontEnd ModGuts
-hscFileFrontEnd hsc_env mod_summary mb_mod_index = do {
- 	    -------------------
- 	    -- DISPLAY PROGRESS MESSAGE
- 	    -------------------
-	; let dflags    = hsc_dflags hsc_env
-	      one_shot  = isOneShot (ghcMode dflags)
-	      toInterp  = hscTarget dflags == HscInterpreted
-      	; when (not one_shot) $
-		 compilationProgressMsg dflags $
-		 (showModuleIndex mb_mod_index ++
-                  "Compiling " ++ showModMsg (not toInterp) mod_summary)
-			
- 	    -------------------
- 	    -- PARSE
- 	    -------------------
-	; let hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
-	      hspp_buf  = ms_hspp_buf  mod_summary
-
-	; maybe_parsed <- myParseModule dflags hspp_file hspp_buf
-
-	; case maybe_parsed of {
-      	     Left err -> do { printBagOfErrors dflags (unitBag err)
-			    ; return Nothing } ;
-      	     Right rdr_module -> do {
-
- 	    -------------------
- 	    -- RENAME and TYPECHECK
- 	    -------------------
-	  (tc_msgs, maybe_tc_result) 
-		<- {-# SCC "Typecheck-Rename" #-}
-		   tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
-
-	; printErrorsAndWarnings dflags tc_msgs
-	; case maybe_tc_result of {
-      	     Nothing -> return Nothing ;
-      	     Just tc_result -> do {
-
- 	    -------------------
- 	    -- DESUGAR
- 	    -------------------
-	; (warns, maybe_ds_result) <- {-# SCC "DeSugar" #-}
-		 	     deSugar hsc_env tc_result
-	; printBagOfWarnings dflags warns
-	; return maybe_ds_result
-	}}}}}
-
 ------------------------------
 
 hscFileCheck :: HscEnv -> ModSummary -> IO (Maybe HscChecked)