From 489bb10302c0df435a340003b9e4e754963292b9 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Mon, 13 Nov 2000 16:16:05 +0000
Subject: [PATCH] [project @ 2000-11-13 16:16:05 by sewardj] Implement
 -ddump-hi.

---
 ghc/compiler/main/CmdLineOpts.lhs |    1 +
 ghc/compiler/main/DriverFlags.hs  |    4 ++--
 ghc/compiler/main/HscMain.lhs     |   17 ++++++++++-------
 3 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index a1012cd..c2e3614 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -247,6 +247,7 @@ data DynFlag
    | Opt_D_source_stats
    | Opt_D_verbose_core2core
    | Opt_D_verbose_stg2stg
+   | Opt_D_dump_hi
    | Opt_D_dump_hi_diffs
    | Opt_D_dump_minimal_imports
    | Opt_DoCoreLinting
diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 75462ca..50e516c 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.17 2000/11/10 14:29:21 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.18 2000/11/13 16:16:05 sewardj Exp $
 --
 -- Driver flags
 --
@@ -18,7 +18,6 @@ import TmpFiles 	( v_TmpDir )
 import CmdLineOpts
 import Config
 import Util
-import CmdLineOpts
 
 import Exception
 import IOExts
@@ -360,6 +359,7 @@ dynamic_flags = [
   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
+  ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
   ,  ( "dcore-lint",       	 NoArg (setDynFlag Opt_DoCoreLinting) )
   ,  ( "dstg-lint",        	 NoArg (setDynFlag Opt_DoStgLinting) )
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index b2ba003..eb10440 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -23,7 +23,7 @@ import Rules		( emptyRuleBase )
 import PrelInfo		( wiredInThingEnv, wiredInThings )
 import PrelNames	( knownKeyNames )
 import MkIface		( completeIface, mkModDetailsFromIface, mkModDetails,
-			  writeIface )
+			  writeIface, pprIface )
 import TcModule		( TcResults(..), typecheckModule )
 import InstEnv		( emptyInstEnv )
 import Desugar		( deSugar )
@@ -58,6 +58,7 @@ import Name		( Name, nameModule, nameOccName, getName  )
 import Name		( emptyNameEnv )
 import Module		( Module, lookupModuleEnvByName )
 
+import Monad		( when )
 \end{code}
 
 
@@ -182,7 +183,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
 	; maybe_tc_result <- typecheckModule dflags this_mod pcs_rn hst new_iface 
 					     print_unqualified rn_hs_decls
 	; case maybe_tc_result of {
-      	     Nothing -> do { hPutStrLn stderr "Typechecked failed" 
+      	     Nothing -> do { hPutStrLn stderr "Typecheck failed" 
  			   ; return (HscFail pcs_rn) } ;
       	     Just tc_result -> do {
     
@@ -233,12 +234,14 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
 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 ()
+         -> do when (dopt Opt_D_dump_hi_diffs dflags)
+                    (printDump (text "INTERFACE UNCHANGED"))
+               dumpIfSet_dyn dflags Opt_D_dump_hi
+                             "UNCHANGED FINAL INTERFACE" (pprIface new_iface)
 	       return new_iface
-      (new_iface, Just sdoc)
-         -> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "NEW INTERFACE" sdoc
+      (new_iface, Just sdoc_diffs)
+         -> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "INTERFACE HAS CHANGED" sdoc_diffs
+               dumpIfSet_dyn dflags Opt_D_dump_hi "NEW FINAL INTERFACE" (pprIface new_iface)
                -- Write the interface file
                writeIface (unJust (ml_hi_file location) "hscRecomp:hi") new_iface
                return new_iface
-- 
1.7.10.4