remove empty dir

[ghc-hetmet.git] / ghc / compiler / main / HscMain.lhs

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 577142a..e170f8f 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -274,12 +274,12 @@ hscMkCompiler norecomp messenger frontend backend
 hscCompileOneShot :: Compiler HscStatus
 hscCompileOneShot hsc_env mod_summary =
     compiler hsc_env mod_summary
-    where mkComp = hscMkCompiler (norecompOneShot HscNoRecomp) oneShotMsg
+    where mkComp = hscMkCompiler norecompOneShot oneShotMsg
           -- How to compile nonBoot files.
           nonBootComp inp = hscSimplify inp >>= hscNormalIface >>=
                             hscWriteIface >>= hscOneShot
           -- How to compile boot files.
-          bootComp inp = hscBootIface inp >>= hscWriteIface >>= hscConst (HscRecomp False)
+          bootComp inp = hscSimpleIface inp >>= hscWriteIface >>= hscConst (HscRecomp False)
           compiler
               = case ms_hsc_src mod_summary of
                 ExtCoreFile
@@ -293,10 +293,10 @@ hscCompileOneShot hsc_env mod_summary =
 hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails)
 hscCompileBatch hsc_env mod_summary
     = compiler hsc_env mod_summary
-    where mkComp = hscMkCompiler norecompBatch (batchMsg False)
+    where mkComp = hscMkCompiler norecompBatch batchMsg
           nonBootComp inp = hscSimplify inp >>= hscNormalIface >>=
                             hscWriteIface >>= hscBatch
-          bootComp inp = hscBootIface inp >>= hscWriteIface >>= hscNothing
+          bootComp inp = hscSimpleIface inp >>= hscWriteIface >>= hscNothing
           compiler
               = case ms_hsc_src mod_summary of
                 ExtCoreFile
@@ -307,25 +307,25 @@ hscCompileBatch hsc_env mod_summary
                     -> mkComp hscFileFrontEnd bootComp
 
 -- Type-check Haskell, boot and extCore.
+-- Does it make sense to compile extCore to nothing?
 hscCompileNothing :: Compiler (HscStatus, ModIface, ModDetails)
 hscCompileNothing hsc_env mod_summary
     = compiler hsc_env mod_summary
-    where mkComp = hscMkCompiler norecompBatch (batchMsg False)
-          nonBootComp inp = hscNormalIface inp >>= hscIgnoreIface >>= hscNothing
-          bootComp inp = hscBootIface inp >>= hscIgnoreIface >>= hscNothing
+    where mkComp = hscMkCompiler norecompBatch batchMsg
+          pipeline inp = hscSimpleIface inp >>= hscIgnoreIface >>= hscNothing
           compiler
               = case ms_hsc_src mod_summary of
                 ExtCoreFile
-                    -> mkComp hscCoreFrontEnd nonBootComp
+                    -> mkComp hscCoreFrontEnd pipeline
                 HsSrcFile
-                    -> mkComp hscFileFrontEnd nonBootComp
+                    -> mkComp hscFileFrontEnd pipeline
                 HsBootFile
-                    -> mkComp hscFileFrontEnd bootComp
+                    -> mkComp hscFileFrontEnd pipeline
 
 -- Compile Haskell, extCore to bytecode.
 hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails)
 hscCompileInteractive hsc_env mod_summary =
-    hscMkCompiler norecompInteractive (batchMsg True)
+    hscMkCompiler norecompInteractive batchMsg
                   frontend backend
                   hsc_env mod_summary
     where backend inp = hscSimplify inp >>= hscNormalIface >>= hscIgnoreIface >>= hscInteractive
@@ -340,12 +340,12 @@ hscCompileInteractive hsc_env mod_summary =
 -- NoRecomp handlers
 --------------------------------------------------------------
 
-norecompOneShot :: a -> NoRecomp a
-norecompOneShot a old_iface
+norecompOneShot :: NoRecomp HscStatus
+norecompOneShot old_iface
     = do hsc_env <- gets compHscEnv
          liftIO $ do
          dumpIfaceStats hsc_env
-         return a
+         return HscNoRecomp
 
 norecompBatch :: NoRecomp (HscStatus, ModIface, ModDetails)
 norecompBatch = norecompWorker HscNoRecomp False
@@ -377,13 +377,13 @@ oneShotMsg _mb_mod_index recomp
             else compilationProgressMsg (hsc_dflags hsc_env) $
                      "compilation IS NOT required"
 
-batchMsg :: Bool -> Maybe (Int,Int) -> Bool -> Comp ()
-batchMsg toInterp mb_mod_index recomp
+batchMsg :: Maybe (Int,Int) -> Bool -> Comp ()
+batchMsg mb_mod_index recomp
     = do hsc_env <- gets compHscEnv
          mod_summary <- gets compModSummary
          let showMsg msg = compilationProgressMsg (hsc_dflags hsc_env) $
                            (showModuleIndex mb_mod_index ++
-                            msg ++ showModMsg (not toInterp) mod_summary)
+                            msg ++ showModMsg (hscTarget (hsc_dflags hsc_env)) recomp mod_summary)
          liftIO $ do
          if recomp
             then showMsg "Compiling "
@@ -403,7 +403,7 @@ hscCoreFrontEnd =
             -------------------
             -- PARSE
             -------------------
-       inp <- readFile (expectJust "hscCoreFrontEnd" (ms_hspp_file mod_summary))
+       inp <- readFile (ms_hspp_file mod_summary)
        case parseCore inp 1 of
          FailP s
              -> do errorMsg (hsc_dflags hsc_env) (text s{-ToDo: wrong-})
@@ -429,7 +429,7 @@ hscFileFrontEnd =
              -- PARSE
              -------------------
        let dflags = hsc_dflags hsc_env
-           hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
+           hspp_file = ms_hspp_file mod_summary
            hspp_buf  = ms_hspp_buf  mod_summary
        maybe_parsed <- myParseModule dflags hspp_file hspp_buf
        case maybe_parsed of
@@ -480,8 +480,8 @@ hscSimplify ds_result
 -- HACK: we return ModGuts even though we know it's not gonna be used.
 --       We do this because the type signature needs to be identical
 --       in structure to the type of 'hscNormalIface'.
-hscBootIface :: ModGuts -> Comp (ModIface, Bool, ModDetails, ModGuts)
-hscBootIface ds_result
+hscSimpleIface :: ModGuts -> Comp (ModIface, Bool, ModDetails, ModGuts)
+hscSimpleIface ds_result
   = do hsc_env <- gets compHscEnv
        mod_summary <- gets compModSummary
        maybe_old_iface <- gets compOldIface
@@ -517,6 +517,7 @@ hscNormalIface simpl_result
                   mkIface hsc_env maybe_old_iface simpl_result details
        -- Emit external core
        emitExternalCore (hsc_dflags hsc_env) cg_guts -- Move this? --Lemmih 03/07/2006
+       dumpIfaceStats hsc_env
 
            -------------------
            -- Return the prepared code.
@@ -641,7 +642,7 @@ hscFileCheck hsc_env mod_summary = do {
            -- PARSE
            -------------------
        ; let dflags    = hsc_dflags hsc_env
-             hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
+             hspp_file = ms_hspp_file mod_summary
              hspp_buf  = ms_hspp_buf  mod_summary
 
        ; maybe_parsed <- myParseModule dflags hspp_file hspp_buf