[project @ 2004-12-22 12:04:14 by simonpj]

--------------------------
	Add -fwarn-orphans flag
	--------------------------

This gives a decent report for modules that contain 'orphan' instance and
rule declarations.  These are to be avoided, because GHC has to proactively
read the interface file every single time, just in case the instance/rule is
needed.

The flag just gives a convenient way of identifying the culprits.

diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs
index ea571d1..d57994e 100644 (file)
--- a/ghc/compiler/iface/MkIface.lhs
+++ b/ghc/compiler/iface/MkIface.lhs
@@ -234,7 +234,7 @@ import FastString
 import DATA_IOREF      ( writeIORef )
 import Monad           ( when )
 import List            ( insert )
-import Maybes          ( orElse, mapCatMaybes, isNothing, fromJust, expectJust )
+import Maybes          ( orElse, mapCatMaybes, isNothing, isJust, fromJust, expectJust )
 \end{code}
 
 
@@ -317,7 +317,7 @@ mkIface hsc_env location maybe_old_iface
                        mi_fix_fn = mkIfaceFixCache fixities }
 
                -- Add version information
-               ; (new_iface, no_change_at_all, pp_diffs) 
+               ; (new_iface, no_change_at_all, pp_diffs, pp_orphs) 
                        = _scc_ "versioninfo" 
                         addVersionInfo maybe_old_iface intermediate_iface decls
                }
@@ -328,6 +328,8 @@ mkIface hsc_env location maybe_old_iface
                writeBinIface hi_file_path new_iface
 
                -- Debug printing
+       ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags) 
+              (printDump (fromJust pp_orphs))
        ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
        ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
                        (pprModIface new_iface)
@@ -424,7 +426,8 @@ addVersionInfo :: Maybe ModIface    -- The old interface, read from M.hi
               -> [IfaceDecl]           -- The new decls
               -> (ModIface, 
                   Bool,                -- True <=> no changes at all; no need to write new Iface
-                  SDoc)                -- Differences
+                  SDoc,                -- Differences
+                  Maybe SDoc)          -- Warnings about orphans
 
 addVersionInfo Nothing new_iface new_decls
 -- No old interface, so definitely write a new one!
@@ -432,8 +435,9 @@ addVersionInfo Nothing new_iface new_decls
                          || anyNothing getRuleKey (mi_rules new_iface),
                 mi_decls  = [(initialVersion, decl) | decl <- new_decls],
                 mi_ver_fn = \n -> Just initialVersion },
-     False, ptext SLIT("No old interface file") $$ 
-           pprOrphans orph_insts orph_rules)
+     False, 
+     ptext SLIT("No old interface file"),
+     pprOrphans orph_insts orph_rules)
   where
     orph_insts = filter (isNothing . getInstKey) (mi_insts new_iface)
     orph_rules = filter (isNothing . getRuleKey) (mi_rules new_iface)
@@ -447,10 +451,9 @@ addVersionInfo (Just old_iface@(ModIface { mi_mod_vers  = old_mod_vers,
               new_iface@(ModIface { mi_fix_fn = new_fixities })
               new_decls
 
-  | no_change_at_all = (old_iface,   True,  ptext SLIT("Interface file unchanged") $$ pp_orphs)
+  | no_change_at_all = (old_iface,   True,  ptext SLIT("Interface file unchanged"), pp_orphs)
   | otherwise       = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
-                                                 nest 2 pp_diffs,
-                                                 text "" $$ pp_orphs])
+                                                 nest 2 pp_diffs], pp_orphs)
   where
     final_iface = new_iface { mi_mod_vers  = bump_unless no_output_change old_mod_vers,
                              mi_exp_vers  = bump_unless no_export_change old_exp_vers,
@@ -574,10 +577,16 @@ addVersionInfo (Just old_iface@(ModIface { mi_mod_vers  = old_mod_vers,
     pp_orphs = pprOrphans new_orph_insts new_orph_rules
 
 pprOrphans insts rules
-  = vcat [if null insts then empty else
-            ptext SLIT("Orphan instances:") <+> vcat (map ppr insts),
-         if null rules then empty else
-            ptext SLIT("Orphan rules:") <+> vcat (map ppr rules)]
+  | null insts && null rules = Nothing
+  | otherwise
+  = Just $ vcat [
+       if null insts then empty else
+            hang (ptext SLIT("Warning: orphan instances:"))
+               2 (vcat (map ppr insts)),
+       if null rules then empty else
+            hang (ptext SLIT("Warning: orphan rules:"))
+               2 (vcat (map ppr rules))
+    ]
 
 computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet
 computeChangedOccs eq_info

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 1e282a0..0e9f29b 100644 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -260,6 +260,7 @@ data DynFlag
    | Opt_WarnUnusedMatches
    | Opt_WarnDeprecations
    | Opt_WarnDodgyImports
+   | Opt_WarnOrphans
 
    -- language opts
    | Opt_AllowOverlappingInstances
@@ -648,7 +649,8 @@ minusWallOpts
       [        Opt_WarnTypeDefaults,
        Opt_WarnNameShadowing,
        Opt_WarnMissingSigs,
-       Opt_WarnHiShadows
+       Opt_WarnHiShadows,
+       Opt_WarnOrphans
       ]
 \end{code}
 

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 9f9749d..0f53bd4 100644 (file)
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -460,6 +460,7 @@ fFlags = [
   ( "warn-unused-imports",             Opt_WarnUnusedImports ),
   ( "warn-unused-matches",             Opt_WarnUnusedMatches ),
   ( "warn-deprecations",               Opt_WarnDeprecations ),
+  ( "warn-orphans",                    Opt_WarnOrphans ),
   ( "fi",                              Opt_FFI ),  -- support `-ffi'...
   ( "ffi",                             Opt_FFI ),  -- ...and also `-fffi'
   ( "arrows",                          Opt_Arrows ), -- arrow syntax

diff --git a/ghc/docs/users_guide/flags.xml b/ghc/docs/users_guide/flags.xml
index f92c9ba..ee3f19b 100644 (file)
--- a/ghc/docs/users_guide/flags.xml
+++ b/ghc/docs/users_guide/flags.xml
@@ -639,6 +639,14 @@
          </row>
 
          <row>
+           <entry><option>-fwarn-oprhans</option></entry>
+           <entry>warn when the module contains "orphan" instance declarations
+           or rewrite rules</entry>
+           <entry>dynamic</entry>
+           <entry><option>-fno-warn-orphans</option></entry>
+         </row>
+
+         <row>
            <entry><option>-fwarn-overlapping-patterns</option></entry>
            <entry>warn about overlapping patterns</entry>
            <entry>dynamic</entry>

diff --git a/ghc/docs/users_guide/using.xml b/ghc/docs/users_guide/using.xml
index cc4f366..bbf539a 100644 (file)
--- a/ghc/docs/users_guide/using.xml
+++ b/ghc/docs/users_guide/using.xml
@@ -950,6 +950,27 @@ f foo = foo { x = 6 }
       </varlistentry>
 
       <varlistentry>
+       <term><option>-fwarn-orphans</option>:</term>
+       <listitem>
+         <indexterm><primary><option>-fwarn-orphans</option></primary></indexterm>
+         <indexterm><primary>orphan instances, warning</primary></indexterm>
+         <indexterm><primary>orphan rules, warning</primary></indexterm>
+         
+         <para>This option causes a warning to be emitted whenever the 
+           module contains an "orphan" instance declaration or rewrite rule.
+           An instance declartion is an orphan if it appears in a module in
+           which neither the class nor the type being instanced are declared
+           in the same module.  A rule is an orphan if it is a rule for a
+           function declared in another module.  A module containing any
+         orphans is called an orphan module.</para>
+         <para>The trouble with orphans is that GHC must pro-actively read the interface
+           files for all orphan modules, just in case their instances or rules
+           play a role, whether or not the module's interface would otherwise 
+           be of any use.  Other things being equal, avoid orphan modules.</para>
+       </listitem>
+      </varlistentry>
+
+      <varlistentry>
        <term>
           <option>-fwarn-overlapping-patterns</option>:
           <indexterm><primary><option>-fwarn-overlapping-patterns</option></primary></indexterm>