[project @ 2000-11-01 17:15:28 by simonpj]

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

diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 6fbf4ae..8540f9f 100644 (file)
--- a/ghc/compiler/main/MkIface.lhs
+++ b/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
 
@@ -522,7 +520,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 +530,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 +539,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 +611,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
@@ -660,20 +655,17 @@ pprExport :: (ModuleName, Avails) -> SDoc
 pprExport (mod, items)
  = hsep [ ptext SLIT("__export "), ppr mod, hsep (map pp_avail items) ] <> semi
   where
-    ppr_name :: Name -> SDoc   -- Print the occurrence name only
-    ppr_name n = ppr (nameOccName n)
-
     pp_avail :: AvailInfo -> SDoc
-    pp_avail (Avail name)      = ppr_name name
-    pp_avail (AvailTC name []) = empty
-    pp_avail (AvailTC name ns) = hcat [ppr_name name, bang, pp_export ns']
-                               where
-                                 bang | name `elem` ns = empty
-                                      | otherwise      = char '|'
-                                 ns' = filter (/= name) ns
+    pp_avail (Avail name)                   = pprOcc name
+    pp_avail (AvailTC n [])                 = empty
+    pp_avail (AvailTC n (n':ns)) | n==n'     = pprOcc n                    <> pp_export ns
+                                | otherwise = pprOcc n <> char '|' <> pp_export (n':ns)
     
     pp_export []    = empty
-    pp_export names = braces (hsep (map ppr_name names))
+    pp_export names = braces (hsep (map pprOcc names))
+
+pprOcc :: Name -> SDoc -- Print the occurrence name only
+pprOcc n = pprOccName (nameOccName n)
 \end{code}
 
 
@@ -694,7 +686,7 @@ pprUsage (m, has_orphans, is_boot, whats_imported)
     pp_versions NothingAtAll                       = empty
     pp_versions (Everything v)                     = dcolon <+> int v
     pp_versions (Specifically vm ve nvs vr) = dcolon <+> int vm <+> pp_export_version ve <+> int vr 
-                                             <+> hsep [ ppr n <+> int v | (n,v) <- nvs ]
+                                             <+> hsep [ pprOcc n <+> int v | (n,v) <- nvs ]
 
        -- HACK for the moment: print the export-list version even if
        -- we don't use it, so that syntax of interface files doesn't change
@@ -736,5 +728,5 @@ pprDeprecs deprecs   = ptext SLIT("{-## __D") <+> guts <+> ptext SLIT("##-}")
 
 pp_deprecs env = vcat (punctuate semi (map pp_deprec (nameEnvElts env)))
               where
-                pp_deprec (name, txt) = pprOccName (nameOccName name) <+> ptext txt
+                pp_deprec (name, txt) = pprOcc name <+> ptext txt
 \end{code}