[project @ 2000-10-31 13:01:46 by sewardj]

* Stop pipeline when recompilation not needed.
* Check OPTIONS pragmas for non-dynamic flags.
* Misc wibbles.

ghc/compiler/main/CodeOutput.lhs

@@ -33,6 +33,7 @@ import ErrUtils		( dumpIfSet_dyn )
 import Outputable
 import CmdLineOpts	( DynFlags, HscLang(..), dopt_OutName )
 import TmpFiles		( newTempName )
+import UniqSupply	( mkSplitUniqSupply )
 
 import IO		( IOMode(..), hClose, openFile, Handle )
 \end{code}
@@ -108,9 +109,7 @@ outputAsm dflags filenm flat_absC
 #ifndef OMIT_NATIVE_CODEGEN
 
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
-       let
-	    (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
-       in
+       let (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
        dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
        dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d
        doOutput filenm ( \f -> printForAsm f ncg_output_d)

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.13 2000/10/30 18:13:15 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.14 2000/10/31 13:01:46 sewardj Exp $
 --
 -- GHC Driver
 --
@@ -294,9 +294,15 @@ run_phase Unlit _basename _suff input_fn output_fn
 -------------------------------------------------------------------------------
 -- Cpp phase 
 
-run_phase Cpp _basename _suff input_fn output_fn
+run_phase Cpp basename suff input_fn output_fn
   = do src_opts <- getOptionsFromSource input_fn
-       _ <- processArgs dynamic_flags src_opts []
+       unhandled_flags <- processArgs dynamic_flags src_opts []
+
+       when (not (null unhandled_flags)) 
+            (throwDyn (OtherError (
+                          basename ++ "." ++ suff 
+                          ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
+                          ++ unwords unhandled_flags)) (ExitFailure 1))
 
        do_cpp <- readState cpp_flag
        if do_cpp
@@ -349,7 +355,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
    
    hdl <- readIORef v_Dep_tmp_hdl
 
-	-- std dependeny of the object(s) on the source file
+	-- std dependency of the object(s) on the source file
    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 
    let genDep (dep, False {- not an hi file -}) = 
@@ -412,27 +418,27 @@ run_phase Hsc basename suff input_fn output_fn
   -- only do this if we're eventually going to generate a .o file.
   -- (ToDo: do when generating .hc files too?)
   --
-  -- Setting source_unchanged to "-fsource-unchanged" means that M.o seems
+  -- Setting source_unchanged to True means that M.o seems
   -- to be up to date wrt M.hs; so no need to recompile unless imports have
   -- changed (which the compiler itself figures out).
-  -- Setting source_unchanged to "" tells the compiler that M.o is out of
+  -- Setting source_unchanged to False tells the compiler that M.o is out of
   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 	do_recomp <- readIORef v_Recomp
 	todo <- readIORef v_GhcMode
         o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
 	source_unchanged <- 
           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
-	     then return ""
+	     then return False
 	     else do t1 <- getModificationTime (basename ++ '.':suff)
 		     o_file_exists <- doesFileExist o_file
 		     if not o_file_exists
-		        then return ""	-- Need to recompile
+		        then return False	-- Need to recompile
 			else do t2 <- getModificationTime o_file
 			        if t2 > t1
-				  then return "-fsource-unchanged"
-				  else return ""
+				  then return True
+				  else return False
 
-   -- build a bogus ModuleLocation to pass to hscMain.
+   -- build a ModuleLocation to pass to hscMain.
         let location = ModuleLocation {
                           ml_hs_file   = Nothing,
                           ml_hspp_file = Just input_fn,
@@ -446,7 +452,7 @@ run_phase Hsc basename suff input_fn output_fn
   -- run the compiler!
         pcs <- initPersistentCompilerState
 	result <- hscMain dyn_flags{ hscOutName = output_fn }
-			  (source_unchanged == "-fsource-unchanged")
+			  source_unchanged
 			  location
 			  Nothing	 -- no iface
 			  emptyModuleEnv -- HomeSymbolTable
@@ -460,13 +466,14 @@ run_phase Hsc basename suff input_fn output_fn
 	    HscOK details maybe_iface maybe_stub_h maybe_stub_c 
 			_maybe_interpreted_code pcs -> do
 
-    -- deal with stubs
+	    -- deal with stubs
 	maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 	case maybe_stub_o of
 		Nothing -> return ()
 		Just stub_o -> add v_Ld_inputs stub_o
 
-	return True
+        let keep_going = case maybe_iface of Just _ -> True; Nothing -> False
+	return keep_going
     }
 
 -----------------------------------------------------------------------------

ghc/compiler/main/HscMain.lhs

@@ -95,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;
@@ -108,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
       }}
@@ -116,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
@@ -154,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");
@@ -201,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)
@@ -219,12 +213,24 @@ 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
+         -> 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"

ghc/compiler/main/MkIface.lhs

@@ -23,8 +23,7 @@ import TcHsSyn		( TypecheckedRuleDecl )
 import HscTypes		( VersionInfo(..), IfaceDecls(..), ModIface(..), ModDetails(..),
 			  TyThing(..), DFunId, TypeEnv, isTyClThing, Avails,
 			  WhatsImported(..), GenAvailInfo(..), 
-			  ImportVersion, AvailInfo, Deprecations(..), 
-			  ModuleLocation(..)
+			  ImportVersion, AvailInfo, Deprecations(..)
 			)
 
 import CmdLineOpts
@@ -54,8 +53,7 @@ import FieldLabel	( fieldLabelType )
 import Type		( splitSigmaTy, tidyTopType, deNoteType )
 import SrcLoc		( noSrcLoc )
 import Outputable
-import Module		( ModuleName, moduleName )
-import Finder		( findModule )
+import Module		( ModuleName )
 
 import List		( partition )
 import IO		( IOMode(..), openFile, hClose )
@@ -128,7 +126,7 @@ mkModDetailsFromIface type_env dfun_ids rules
 completeIface :: Maybe ModIface		-- The old interface, if we have it
 	      -> ModIface		-- The new one, minus the decls and versions
 	      -> ModDetails		-- The ModDetails for this module
-	      -> Maybe (ModIface, SDoc)	-- The new one, complete with decls and versions
+	      -> (ModIface, Maybe SDoc)	-- The new one, complete with decls and versions
 					-- The SDoc is a debug document giving differences
 					-- Nothing => no change
 
@@ -225,6 +223,8 @@ ifaceTyCls (ATyCon tycon) so_far
     mk_field strict_mark field_label
 	= ([getName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
 
+ifaceTyCls (ATyCon tycon) so_far = pprPanic "ifaceTyCls" (ppr tycon)
+
 ifaceTyCls (AnId id) so_far
   | omitIfaceSigForId id = so_far
   | otherwise 		 = iface_sig : so_far
@@ -522,7 +522,7 @@ getRules orphan_rules binds emitted
 \begin{code}
 addVersionInfo :: Maybe ModIface		-- The old interface, read from M.hi
 	       -> ModIface			-- The new interface decls
-	       -> Maybe (ModIface, SDoc)	-- Nothing => no change; no need to write new Iface
+	       -> (ModIface, Maybe SDoc)	-- Nothing => no change; no need to write new Iface
 						-- Just mi => Here is the new interface to write
 						-- 	      with correct version numbers
 
@@ -532,7 +532,7 @@ addVersionInfo :: Maybe ModIface		-- The old interface, read from M.hi
 
 addVersionInfo Nothing new_iface
 -- No old interface, so definitely write a new one!
-  = Just (new_iface, text "No old interface available")
+  = (new_iface, Just (text "No old interface available"))
 
 addVersionInfo (Just old_iface@(ModIface { mi_version = old_version, 
 				       	   mi_decls   = old_decls,
@@ -541,10 +541,10 @@ addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
 				     mi_fixities = new_fixities })
 
   | no_output_change && no_usage_change
-  = Nothing
+  = (old_iface, Nothing)
 
   | otherwise		-- Add updated version numbers
-  = Just (final_iface, pp_tc_diffs)
+  = (final_iface, Just pp_tc_diffs)
 	
   where
     final_iface = new_iface { mi_version = new_version }
@@ -613,11 +613,8 @@ diffDecls old_vers old_fixities new_fixities old new
 %************************************************************************
 
 \begin{code}
-writeIface :: FilePath -> Maybe ModIface -> IO ()
-writeIface hi_path Nothing
-  = return ()
-
-writeIface hi_path (Just mod_iface)
+writeIface :: FilePath -> ModIface -> IO ()
+writeIface hi_path mod_iface
   = do	{ if_hdl <- openFile hi_path WriteMode
 	; printForIface if_hdl (pprIface mod_iface)
 	; hClose if_hdl