X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscMain.lhs;h=bf5857eafdd09475dc638d5e1d626d42999e1dcd;hb=2ffefc1bfca0c8924825cd15750e7ced457f3c81;hp=7612f78f4c9a63653353a2edaad412b8a5f43907;hpb=156d91339295539a2b3461efc1ac8c83f29d83f0;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 7612f78..bf5857e 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -57,7 +57,8 @@ import InterpSyn	( UnlinkedIBind )
 import StgInterp	( ItblEnv )
 import FiniteMap	( FiniteMap, plusFM, emptyFM, addToFM )
 import OccName		( OccName )
-import Name		( Name, nameModule, emptyNameEnv, nameOccName, getName  )
+import Name		( Name, nameModule, nameOccName, getName  )
+import Name		( emptyNameEnv )
 import Module		( Module, lookupModuleEnvByName )
 
 \end{code}
@@ -94,8 +95,7 @@ hscMain
 
 hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
  = do {
-      putStrLn ( "hscMain: location =\n" ++ show location);
-      putStrLn "checking old iface ...";
+      putStrLn "CHECKING OLD IFACE";
       (pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
          <- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain")
 			  source_unchanged maybe_old_iface;
@@ -107,7 +107,6 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
           what_next | recomp_reqd || no_old_iface = hscRecomp 
                     | otherwise                   = hscNoRecomp
       ;
-      putStrLn "doing what_next ...";
       what_next dflags location maybe_checked_iface
                 hst hit pcs_ch
       }}
@@ -115,6 +114,7 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
 
 hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
  = do {
+      hPutStrLn stderr "COMPILATION NOT REQUIRED";
       -- we definitely expect to have the old interface available
       let old_iface = case maybe_checked_iface of 
                          Just old_if -> old_if
@@ -153,10 +153,11 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
 
 hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
  = do {
+      hPutStrLn stderr "COMPILATION IS REQUIRED";
+
       -- what target are we shooting for?
       let toInterp = dopt_HscLang dflags == HscInterpreted
       ;
---      putStrLn ("toInterp = " ++ show toInterp);
       -- PARSE
       maybe_parsed 
          <- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp");
@@ -200,15 +201,9 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
       let new_details = mkModDetails env_tc local_insts tidy_binds 
 			             top_level_ids orphan_rules
       ;
-      -- and possibly create a new ModIface
-      let maybe_final_iface_and_sdoc 
-             = completeIface maybe_checked_iface new_iface new_details 
-          maybe_final_iface
-             = case maybe_final_iface_and_sdoc of 
-                  Just (fif, sdoc) -> Just fif; Nothing -> Nothing
-      ;
-      -- Write the interface file
-      writeIface (unJust (ml_hi_file location) "hscRecomp:hi") maybe_final_iface
+      -- and the final interface
+      final_iface 
+         <- mkFinalIface dflags location maybe_checked_iface new_iface new_details
       ;
       -- do the rest of code generation/emission
       (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
@@ -218,12 +213,27 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
                hit (pcs_PIT pcs_tc)       
       ;
       -- and the answer is ...
-      return (HscOK new_details maybe_final_iface 
+      return (HscOK new_details (Just final_iface)
 		    maybe_stub_h_filename maybe_stub_c_filename
                     maybe_ibinds pcs_tc)
       }}}}}}}
 
 
+
+mkFinalIface dflags location maybe_old_iface new_iface new_details
+ = case completeIface maybe_old_iface new_iface new_details of
+      (new_iface, Nothing) -- no change in the interfacfe
+         -> do if dopt Opt_D_dump_hi_diffs dflags  then
+		 	printDump (text "INTERFACE UNCHANGED")
+		  else  return ()
+	       return new_iface
+      (new_iface, Just sdoc)
+         -> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "NEW INTERFACE" sdoc
+               -- Write the interface file
+               writeIface (unJust (ml_hi_file location) "hscRecomp:hi") new_iface
+               return new_iface
+
+
 myParseModule dflags src_filename
  = do --------------------------  Parser  ----------------
       show_pass dflags "Parser"
@@ -258,22 +268,22 @@ restOfCodeGeneration dflags toInterp this_mod imported_module_names cost_centre_
  = do (ibinds,itbl_env) 
          <- stgToInterpSyn (map fst stg_binds) local_tycons local_classes
       return (Nothing, Nothing, Just (ibinds,itbl_env))
+
  | otherwise
  = do --------------------------  Code generation -------------------------------
       show_pass dflags "CodeGen"
       -- _scc_     "CodeGen"
       abstractC <- codeGen dflags this_mod imported_modules
                            cost_centre_info fe_binders
-                           local_tycons local_classes stg_binds
+                           local_tycons stg_binds
 
       --------------------------  Code output -------------------------------
       show_pass dflags "CodeOutput"
       -- _scc_     "CodeOutput"
-      ncg_uniqs <- mkSplitUniqSupply 'n'
       (maybe_stub_h_name, maybe_stub_c_name)
-         <- codeOutput dflags this_mod local_tycons local_classes
+         <- codeOutput dflags this_mod local_tycons
                        oa_tidy_binds stg_binds
-                       c_code h_code abstractC ncg_uniqs
+                       c_code h_code abstractC
 
       return (maybe_stub_h_name, maybe_stub_c_name, Nothing)
  where