ghc/compiler/main/MkIface.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[MkIface]{Print an interface for a module}
   5
   6 \begin{code}
   7 module MkIface (
   8         mkModDetails, mkModDetailsFromIface, completeIface,
   9         writeIface, pprIface
  10   ) where
  11
  12 #include "HsVersions.h"
  13
  14 import HsSyn
  15 import HsCore           ( HsIdInfo(..), UfExpr(..), toUfExpr, toUfBndr )
  16 import HsTypes          ( toHsTyVars )
  17 import BasicTypes       ( Fixity(..), NewOrData(..),
  18                           Version, initialVersion, bumpVersion, isLoopBreaker
  19                         )
  20 import RnMonad
  21 import RnHsSyn          ( RenamedInstDecl, RenamedTyClDecl )
  22 import TcHsSyn          ( TypecheckedRuleDecl )
  23 import HscTypes         ( VersionInfo(..), ModIface(..), ModDetails(..),
  24                           IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
  25                           TyThing(..), DFunId, TypeEnv, Avails,
  26                           WhatsImported(..), GenAvailInfo(..),
  27                           ImportVersion, AvailInfo, Deprecations(..),
  28                           extendTypeEnvList
  29                         )
  30
  31 import CmdLineOpts
  32 import Id               ( Id, idType, idInfo, omitIfaceSigForId, isDictFunId,
  33                           idSpecialisation, setIdInfo, isLocalId, idName, hasNoBinding
  34                         )
  35 import Var              ( isId )
  36 import VarSet
  37 import DataCon          ( StrictnessMark(..), dataConSig, dataConFieldLabels, dataConStrictMarks )
  38 import IdInfo           -- Lots
  39 import CoreSyn          ( CoreBind, CoreRule(..), IdCoreRule,
  40                           isBuiltinRule, rulesRules,
  41                           bindersOf, bindersOfBinds
  42                         )
  43 import CoreFVs          ( ruleSomeLhsFreeVars )
  44 import CoreUnfold       ( neverUnfold, unfoldingTemplate )
  45 import Name             ( getName, nameModule, Name, NamedThing(..) )
  46 import Name     -- Env
  47 import OccName          ( pprOccName )
  48 import TyCon            ( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
  49                           tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize, isClassTyCon
  50                         )
  51 import Class            ( classExtraBigSig, DefMeth(..) )
  52 import FieldLabel       ( fieldLabelType )
  53 import Type             ( splitSigmaTy, tidyTopType, deNoteType )
  54 import SrcLoc           ( noSrcLoc )
  55 import Outputable
  56 import Module           ( ModuleName )
  57
  58 import IO               ( IOMode(..), openFile, hClose )
  59 \end{code}
  60
  61
  62 %************************************************************************
  63 %*                                                                      *
  64 \subsection{Write a new interface file}
  65 %*                                                                      *
  66 %************************************************************************
  67
  68 \begin{code}
  69 mkModDetails :: TypeEnv         -- From typechecker
  70              -> [CoreBind]      -- Final bindings
  71              -> [Id]            -- Top-level Ids from the code generator;
  72                                 -- they have authoritative arity info
  73              -> [IdCoreRule]    -- Tidy orphan rules
  74              -> ModDetails
  75 mkModDetails type_env tidy_binds stg_ids orphan_rules
  76   = ModDetails { md_types = new_type_env,
  77                  md_rules = rule_dcls,
  78                  md_insts = filter isDictFunId final_ids }
  79   where
  80         -- The competed type environment is gotten from
  81         --      a) keeping the types and classes
  82         --      b) removing all Ids,
  83         --      c) adding Ids with correct IdInfo, including unfoldings,
  84         --              gotten from the bindings
  85         -- From (c) we keep only those Ids with Global names;
  86         --          the CoreTidy pass makes sure these are all and only
  87         --          the externally-accessible ones
  88         -- This truncates the type environment to include only the
  89         -- exported Ids and things needed from them, which saves space
  90         --
  91         -- However, we do keep things like constructors, which should not appear
  92         -- in interface files, because they are needed by importing modules when
  93         -- using the compilation manager
  94     new_type_env = extendTypeEnvList (filterNameEnv keep_it type_env)
  95                                      (map AnId final_ids)
  96
  97         -- We keep constructor workers, because they won't appear
  98         -- in the bindings from which final_ids are derived!
  99     keep_it (AnId id) = hasNoBinding id
 100     keep_it other     = True
 101
 102     stg_id_set = mkVarSet stg_ids
 103     final_ids  = [addStgInfo stg_id_set id | bind <- tidy_binds
 104                                            , id <- bindersOf bind
 105                                            , isGlobalName (idName id)]
 106
 107         -- The complete rules are gotten by combining
 108         --      a) the orphan rules
 109         --      b) rules embedded in the top-level Ids
 110     rule_dcls | opt_OmitInterfacePragmas = []
 111               | otherwise                = getRules orphan_rules tidy_binds (mkVarSet final_ids)
 112
 113 -- This version is used when we are re-linking a module
 114 -- so we've only run the type checker on its previous interface
 115 mkModDetailsFromIface :: TypeEnv
 116                       -> [TypecheckedRuleDecl]
 117                       -> ModDetails
 118 mkModDetailsFromIface type_env rules
 119   = ModDetails { md_types = type_env,
 120                  md_rules = rule_dcls,
 121                  md_insts = dfun_ids }
 122   where
 123     dfun_ids  = [dfun_id | AnId dfun_id <- nameEnvElts type_env, isDictFunId dfun_id]
 124     rule_dcls = [(id,rule) | IfaceRuleOut id rule <- rules]
 125         -- All the rules from an interface are of the IfaceRuleOut form
 126 \end{code}
 127
 128
 129 We have to add on the arity and CAF info computed by the code generator
 130 This is also the moment at which we may forget that this function has
 131 a worker: see the comments below
 132
 133 \begin{code}
 134 addStgInfo :: IdSet     -- Ids used at code-gen time; they have better pragma info!
 135            -> Id -> Id
 136 addStgInfo stg_ids id
 137   = id `setIdInfo` final_idinfo
 138   where
 139     idinfo  = idInfo id
 140     idinfo' = idinfo `setArityInfo` stg_arity
 141                      `setCafInfo`   cafInfo stg_idinfo
 142     final_idinfo | worker_ok = idinfo'
 143                  | otherwise = idinfo' `setWorkerInfo` NoWorker
 144
 145     stg_idinfo = case lookupVarSet stg_ids id of
 146                         Just id' -> idInfo id'
 147                         Nothing  -> pprTrace "ifaceBinds not found:" (ppr id) $
 148                                     idInfo id
 149
 150     stg_arity = arityInfo stg_idinfo
 151
 152     ------------  Worker  --------------
 153         -- We only treat a function as having a worker if
 154         -- the exported arity (which is now the number of visible lambdas)
 155         -- is the same as the arity at the moment of the w/w split
 156         -- If so, we can safely omit the unfolding inside the wrapper, and
 157         -- instead re-generate it from the type/arity/strictness info
 158         -- But if the arity has changed, we just take the simple path and
 159         -- put the unfolding into the interface file, forgetting the fact
 160         -- that it's a wrapper.
 161         --
 162         -- How can this happen?  Sometimes we get
 163         --      f = coerce t (\x y -> $wf x y)
 164         -- at the moment of w/w split; but the eta reducer turns it into
 165         --      f = coerce t $wf
 166         -- which is perfectly fine except that the exposed arity so far as
 167         -- the code generator is concerned (zero) differs from the arity
 168         -- when we did the split (2).
 169         --
 170         -- All this arises because we use 'arity' to mean "exactly how many
 171         -- top level lambdas are there" in interface files; but during the
 172         -- compilation of this module it means "how many things can I apply
 173         -- this to".
 174     worker_ok = case workerInfo idinfo of
 175                      NoWorker                     -> True
 176                      HasWorker work_id wrap_arity -> wrap_arity == arityLowerBound stg_arity
 177 \end{code}
 178
 179
 180 \begin{code}
 181 getRules :: [IdCoreRule]        -- Orphan rules
 182          -> [CoreBind]          -- Bindings, with rules in the top-level Ids
 183          -> IdSet               -- Ids that are exported, so we need their rules
 184          -> [IdCoreRule]
 185 getRules orphan_rules binds emitted
 186   = orphan_rules ++ local_rules
 187   where
 188     local_rules  = [ (fn, rule)
 189                    | fn <- bindersOfBinds binds,
 190                      fn `elemVarSet` emitted,
 191                      rule <- rulesRules (idSpecialisation fn),
 192                      not (isBuiltinRule rule),
 193                                 -- We can't print builtin rules in interface files
 194                                 -- Since they are built in, an importing module
 195                                 -- will have access to them anyway
 196
 197                         -- Sept 00: I've disabled this test.  It doesn't stop many, if any, rules
 198                         -- from coming out, and to make it work properly we need to add ????
 199                         --      (put it back in for now)
 200                      all (`elemVarSet` emitted) (varSetElems (ruleSomeLhsFreeVars interestingId rule))
 201                                 -- Spit out a rule only if all its lhs free vars are emitted
 202                                 -- This is a good reason not to do it when we emit the Id itself
 203                    ]
 204
 205 interestingId id = isId id && isLocalId id
 206 \end{code}
 207
 208
 209 %************************************************************************
 210 %*                                                                      *
 211 \subsection{Completing an interface}
 212 %*                                                                      *
 213 %************************************************************************
 214
 215 \begin{code}
 216 completeIface :: Maybe ModIface         -- The old interface, if we have it
 217               -> ModIface               -- The new one, minus the decls and versions
 218               -> ModDetails             -- The ModDetails for this module
 219               -> (ModIface, Maybe SDoc) -- The new one, complete with decls and versions
 220                                         -- The SDoc is a debug document giving differences
 221                                         -- Nothing => no change
 222
 223         -- NB: 'Nothing' means that even the usages havn't changed, so there's no
 224         --     need to write a new interface file.  But even if the usages have
 225         --     changed, the module version may not have.
 226 completeIface maybe_old_iface new_iface mod_details
 227   = addVersionInfo maybe_old_iface (new_iface { mi_decls = new_decls })
 228   where
 229      new_decls   = mkIfaceDecls ty_cls_dcls rule_dcls inst_dcls
 230      inst_dcls   = map ifaceInstance (md_insts mod_details)
 231      ty_cls_dcls = foldNameEnv ifaceTyCls [] (md_types mod_details)
 232      rule_dcls   = map ifaceRule (md_rules mod_details)
 233 \end{code}
 234
 235
 236 \begin{code}
 237 ifaceTyCls :: TyThing -> [RenamedTyClDecl] -> [RenamedTyClDecl]
 238 ifaceTyCls (AClass clas) so_far
 239   = cls_decl : so_far
 240   where
 241     cls_decl = ClassDecl { tcdCtxt      = toHsContext sc_theta,
 242                            tcdName      = getName clas,
 243                            tcdTyVars    = toHsTyVars clas_tyvars,
 244                            tcdFDs       = toHsFDs clas_fds,
 245                            tcdSigs      = map toClassOpSig op_stuff,
 246                            tcdMeths     = Nothing,
 247                            tcdSysNames  = bogus_sysnames,
 248                            tcdLoc       = noSrcLoc }
 249
 250     (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
 251
 252     toClassOpSig (sel_id, def_meth)
 253         = ASSERT(sel_tyvars == clas_tyvars)
 254           ClassOpSig (getName sel_id) def_meth' (toHsType op_ty) noSrcLoc
 255         where
 256           (sel_tyvars, _, op_ty) = splitSigmaTy (idType sel_id)
 257           def_meth' = case def_meth of
 258                          NoDefMeth  -> NoDefMeth
 259                          GenDefMeth -> GenDefMeth
 260                          DefMeth id -> DefMeth (getName id)
 261
 262 ifaceTyCls (ATyCon tycon) so_far
 263   | isClassTyCon tycon = so_far
 264   | otherwise          = ty_decl : so_far
 265   where
 266     ty_decl | isSynTyCon tycon
 267             = TySynonym { tcdName   = getName tycon,
 268                           tcdTyVars = toHsTyVars tyvars,
 269                           tcdSynRhs = toHsType syn_ty,
 270                           tcdLoc    = noSrcLoc }
 271
 272             | isAlgTyCon tycon
 273             = TyData {  tcdND     = new_or_data,
 274                         tcdCtxt   = toHsContext (tyConTheta tycon),
 275                         tcdName   = getName tycon,
 276                         tcdTyVars = toHsTyVars tyvars,
 277                         tcdCons   = map ifaceConDecl (tyConDataCons tycon),
 278                         tcdNCons  = tyConFamilySize tycon,
 279                         tcdDerivs = Nothing,
 280                         tcdSysNames  = bogus_sysnames,
 281                         tcdLoc    = noSrcLoc }
 282
 283             | otherwise = pprPanic "ifaceTyCls" (ppr tycon)
 284
 285     tyvars      = tyConTyVars tycon
 286     (_, syn_ty) = getSynTyConDefn tycon
 287     new_or_data | isNewTyCon tycon = NewType
 288                 | otherwise        = DataType
 289
 290     ifaceConDecl data_con
 291         = ConDecl (getName data_con) (error "ifaceConDecl")
 292                   (toHsTyVars ex_tyvars)
 293                   (toHsContext ex_theta)
 294                   details noSrcLoc
 295         where
 296           (tyvars1, _, ex_tyvars, ex_theta, arg_tys, tycon1) = dataConSig data_con
 297           field_labels   = dataConFieldLabels data_con
 298           strict_marks   = dataConStrictMarks data_con
 299           details | null field_labels
 300                   = ASSERT( tycon == tycon1 && tyvars == tyvars1 )
 301                     VanillaCon (zipWith mk_bang_ty strict_marks arg_tys)
 302
 303                   | otherwise
 304                   = RecCon (zipWith mk_field strict_marks field_labels)
 305
 306     mk_bang_ty NotMarkedStrict     ty = Unbanged (toHsType ty)
 307     mk_bang_ty (MarkedUnboxed _ _) ty = Unpacked (toHsType ty)
 308     mk_bang_ty MarkedStrict        ty = Banged   (toHsType ty)
 309
 310     mk_field strict_mark field_label
 311         = ([getName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
 312
 313 ifaceTyCls (AnId id) so_far
 314   | omitIfaceSigForId id = so_far
 315   | otherwise            = iface_sig : so_far
 316   where
 317     iface_sig = IfaceSig { tcdName   = getName id,
 318                            tcdType   = toHsType id_type,
 319                            tcdIdInfo = hs_idinfo,
 320                            tcdLoc    =  noSrcLoc }
 321
 322     id_type = idType id
 323     id_info = idInfo id
 324
 325     hs_idinfo | opt_OmitInterfacePragmas = []
 326               | otherwise                = arity_hsinfo  ++ caf_hsinfo  ++ cpr_hsinfo ++
 327                                            strict_hsinfo ++ wrkr_hsinfo ++ unfold_hsinfo
 328
 329     ------------  Arity  --------------
 330     arity_hsinfo = case arityInfo id_info of
 331                         a@(ArityExactly n) -> [HsArity a]
 332                         other              -> []
 333
 334     ------------ Caf Info --------------
 335     caf_hsinfo = case cafInfo id_info of
 336                    NoCafRefs -> [HsNoCafRefs]
 337                    otherwise -> []
 338
 339     ------------ CPR Info --------------
 340     cpr_hsinfo = case cprInfo id_info of
 341                    ReturnsCPR -> [HsCprInfo]
 342                    NoCPRInfo  -> []
 343
 344     ------------  Strictness  --------------
 345     strict_hsinfo = case strictnessInfo id_info of
 346                         NoStrictnessInfo -> []
 347                         info             -> [HsStrictness info]
 348
 349
 350     ------------  Worker  --------------
 351     work_info   = workerInfo id_info
 352     has_worker  = case work_info of { HasWorker _ _ -> True; other -> False }
 353     wrkr_hsinfo = case work_info of
 354                     HasWorker work_id wrap_arity -> [HsWorker (getName work_id)]
 355                     NoWorker                     -> []
 356
 357     ------------  Unfolding  --------------
 358         -- The unfolding is redundant if there is a worker
 359     unfold_info = unfoldingInfo id_info
 360     inline_prag = inlinePragInfo id_info
 361     rhs         = unfoldingTemplate unfold_info
 362     unfold_hsinfo |  neverUnfold unfold_info
 363                   || has_worker = []
 364                   | otherwise   = [HsUnfold inline_prag (toUfExpr rhs)]
 365 \end{code}
 366
 367 \begin{code}
 368 ifaceInstance :: DFunId -> RenamedInstDecl
 369 ifaceInstance dfun_id
 370   = InstDecl (toHsType tidy_ty) EmptyMonoBinds [] (Just (getName dfun_id)) noSrcLoc
 371   where
 372     tidy_ty = tidyTopType (deNoteType (idType dfun_id))
 373                 -- The deNoteType is very important.   It removes all type
 374                 -- synonyms from the instance type in interface files.
 375                 -- That in turn makes sure that when reading in instance decls
 376                 -- from interface files that the 'gating' mechanism works properly.
 377                 -- Otherwise you could have
 378                 --      type Tibble = T Int
 379                 --      instance Foo Tibble where ...
 380                 -- and this instance decl wouldn't get imported into a module
 381                 -- that mentioned T but not Tibble.
 382
 383 ifaceRule (id, BuiltinRule _)
 384   = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule id)
 385
 386 ifaceRule (id, Rule name bndrs args rhs)
 387   = IfaceRule name (map toUfBndr bndrs) (getName id)
 388               (map toUfExpr args) (toUfExpr rhs) noSrcLoc
 389
 390 bogus_sysnames = panic "Bogus sys names"
 391
 392 bogusIfaceRule id
 393   = IfaceRule SLIT("bogus") [] (getName id) [] (UfVar (getName id)) noSrcLoc
 394 \end{code}
 395
 396
 397 %************************************************************************
 398 %*                                                                      *
 399 \subsection{Checking if the new interface is up to date
 400 %*                                                                      *
 401 %************************************************************************
 402
 403 \begin{code}
 404 addVersionInfo :: Maybe ModIface                -- The old interface, read from M.hi
 405                -> ModIface                      -- The new interface decls
 406                -> (ModIface, Maybe SDoc)        -- Nothing => no change; no need to write new Iface
 407                                                 -- Just mi => Here is the new interface to write
 408                                                 --            with correct version numbers
 409
 410 -- NB: the fixities, declarations, rules are all assumed
 411 -- to be sorted by increasing order of hsDeclName, so that
 412 -- we can compare for equality
 413
 414 addVersionInfo Nothing new_iface
 415 -- No old interface, so definitely write a new one!
 416   = (new_iface, Just (text "No old interface available"))
 417
 418 addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
 419                                            mi_decls   = old_decls,
 420                                            mi_fixities = old_fixities }))
 421                new_iface@(ModIface { mi_decls = new_decls,
 422                                      mi_fixities = new_fixities })
 423
 424   | no_output_change && no_usage_change
 425   = (new_iface, Nothing)
 426         -- don't return the old iface because it may not have an
 427         -- mi_globals field set to anything reasonable.
 428
 429   | otherwise           -- Add updated version numbers
 430   = pprTrace "completeIface" (ppr (dcl_tycl old_decls))
 431     (final_iface, Just pp_tc_diffs)
 432
 433   where
 434     final_iface = new_iface { mi_version = new_version }
 435     new_version = VersionInfo { vers_module  = bumpVersion no_output_change (vers_module  old_version),
 436                                 vers_exports = bumpVersion no_export_change (vers_exports old_version),
 437                                 vers_rules   = bumpVersion no_rule_change   (vers_rules   old_version),
 438                                 vers_decls   = tc_vers }
 439
 440     no_output_change = no_tc_change && no_rule_change && no_export_change
 441     no_usage_change  = mi_usages old_iface == mi_usages new_iface
 442
 443     no_export_change = mi_exports old_iface == mi_exports new_iface             -- Kept sorted
 444     no_rule_change   = dcl_rules old_decls  == dcl_rules  new_decls             -- Ditto
 445
 446         -- Fill in the version number on the new declarations by looking at the old declarations.
 447         -- Set the flag if anything changes.
 448         -- Assumes that the decls are sorted by hsDeclName.
 449     old_vers_decls = vers_decls old_version
 450     (no_tc_change,  pp_tc_diffs,  tc_vers) = diffDecls old_vers_decls old_fixities new_fixities
 451                                                        (dcl_tycl old_decls) (dcl_tycl new_decls)
 452
 453
 454
 455 diffDecls :: NameEnv Version                            -- Old version map
 456           -> NameEnv Fixity -> NameEnv Fixity           -- Old and new fixities
 457           -> [RenamedTyClDecl] -> [RenamedTyClDecl]     -- Old and new decls
 458           -> (Bool,             -- True <=> no change
 459               SDoc,             -- Record of differences
 460               NameEnv Version)  -- New version
 461
 462 diffDecls old_vers old_fixities new_fixities old new
 463   = diff True empty emptyNameEnv old new
 464   where
 465         -- When seeing if two decls are the same,
 466         -- remember to check whether any relevant fixity has changed
 467     eq_tc  d1 d2 = d1 == d2 && all (same_fixity . fst) (tyClDeclNames d1)
 468     same_fixity n = lookupNameEnv old_fixities n == lookupNameEnv new_fixities n
 469
 470     diff ok_so_far pp new_vers []  []      = (ok_so_far, pp, new_vers)
 471     diff ok_so_far pp new_vers (od:ods) [] = diff False (pp $$ only_old od) new_vers ods []
 472     diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers [] nds
 473     diff ok_so_far pp new_vers (od:ods) (nd:nds)
 474         = case od_name `compare` nd_name of
 475                 LT -> diff False (pp $$ only_old od) new_vers ods      (nd:nds)
 476                 GT -> diff False (pp $$ only_new nd) new_vers (od:ods) nds
 477                 EQ | od `eq_tc` nd -> diff ok_so_far pp                    new_vers  ods nds
 478                    | otherwise     -> diff False     (pp $$ changed od nd) new_vers' ods nds
 479         where
 480           od_name = tyClDeclName od
 481           nd_name = tyClDeclName nd
 482           new_vers' = extendNameEnv new_vers nd_name
 483                                     (bumpVersion False (lookupNameEnv_NF old_vers od_name))
 484
 485     only_old d   = ptext SLIT("Only in old iface:") <+> ppr d
 486     only_new d   = ptext SLIT("Only in new iface:") <+> ppr d
 487     changed d nd = ptext SLIT("Changed in iface: ") <+> ((ptext SLIT("Old:") <+> ppr d) $$
 488                                                          (ptext SLIT("New:") <+> ppr nd))
 489 \end{code}
 490
 491
 492
 493 %************************************************************************
 494 %*                                                                      *
 495 \subsection{Writing an interface file}
 496 %*                                                                      *
 497 %************************************************************************
 498
 499 \begin{code}
 500 writeIface :: FilePath -> ModIface -> IO ()
 501 writeIface hi_path mod_iface
 502   = do  { if_hdl <- openFile hi_path WriteMode
 503         ; printForIface if_hdl from_this_mod (pprIface mod_iface)
 504         ; hClose if_hdl
 505         }
 506   where
 507         -- Print names unqualified if they are from this module
 508     from_this_mod n = nameModule n == this_mod
 509     this_mod = mi_module mod_iface
 510
 511 pprIface :: ModIface -> SDoc
 512 pprIface iface
 513  = vcat [ ptext SLIT("__interface")
 514                 <+> doubleQuotes (ptext opt_InPackage)
 515                 <+> ppr (mi_module iface) <+> ppr (vers_module version_info)
 516                 <+> pp_sub_vers
 517                 <+> (if mi_orphan iface then char '!' else empty)
 518                 <+> int opt_HiVersion
 519                 <+> ptext SLIT("where")
 520
 521         , vcat (map pprExport (mi_exports iface))
 522         , vcat (map pprUsage (mi_usages iface))
 523
 524         , pprFixities (mi_fixities iface) (dcl_tycl decls)
 525         , pprIfaceDecls (vers_decls version_info) decls
 526         , pprDeprecs (mi_deprecs iface)
 527         ]
 528   where
 529     version_info = mi_version iface
 530     decls        = mi_decls iface
 531     exp_vers     = vers_exports version_info
 532     rule_vers    = vers_rules version_info
 533
 534     pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
 535                 | otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
 536 \end{code}
 537
 538 When printing export lists, we print like this:
 539         Avail   f               f
 540         AvailTC C [C, x, y]     C(x,y)
 541         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
 542
 543 \begin{code}
 544 pprExport :: (ModuleName, Avails) -> SDoc
 545 pprExport (mod, items)
 546  = hsep [ ptext SLIT("__export "), ppr mod, hsep (map pp_avail items) ] <> semi
 547   where
 548     pp_avail :: AvailInfo -> SDoc
 549     pp_avail (Avail name)                    = pprOcc name
 550     pp_avail (AvailTC n [])                  = empty
 551     pp_avail (AvailTC n (n':ns)) | n==n'     = pprOcc n             <> pp_export ns
 552                                  | otherwise = pprOcc n <> char '|' <> pp_export (n':ns)
 553
 554     pp_export []    = empty
 555     pp_export names = braces (hsep (map pprOcc names))
 556
 557 pprOcc :: Name -> SDoc  -- Print the occurrence name only
 558 pprOcc n = pprOccName (nameOccName n)
 559 \end{code}
 560
 561
 562 \begin{code}
 563 pprUsage :: ImportVersion Name -> SDoc
 564 pprUsage (m, has_orphans, is_boot, whats_imported)
 565   = hsep [ptext SLIT("import"), ppr m,
 566           pp_orphan, pp_boot,
 567           pp_versions whats_imported
 568     ] <> semi
 569   where
 570     pp_orphan | has_orphans = char '!'
 571               | otherwise   = empty
 572     pp_boot   | is_boot     = char '@'
 573               | otherwise   = empty
 574
 575         -- Importing the whole module is indicated by an empty list
 576     pp_versions NothingAtAll                = empty
 577     pp_versions (Everything v)              = dcolon <+> int v
 578     pp_versions (Specifically vm ve nvs vr) = dcolon <+> int vm <+> pp_export_version ve <+> int vr
 579                                               <+> hsep [ pprOcc n <+> int v | (n,v) <- nvs ]
 580
 581     pp_export_version Nothing  = empty
 582     pp_export_version (Just v) = int v
 583 \end{code}
 584
 585 \begin{code}
 586 pprIfaceDecls version_map decls
 587   = vcat [ vcat [ppr i <+> semi | i <- dcl_insts decls]
 588          , vcat (map ppr_decl (dcl_tycl decls))
 589          , pprRules (dcl_rules decls)
 590          ]
 591   where
 592     ppr_decl d  = ppr_vers d <+> ppr d <> semi
 593
 594         -- Print the version for the decl
 595     ppr_vers d = case lookupNameEnv version_map (tyClDeclName d) of
 596                    Nothing -> empty
 597                    Just v  -> int v
 598 \end{code}
 599
 600 \begin{code}
 601 pprFixities fixity_map decls
 602   = hsep [ ppr fix <+> ppr n
 603          | d <- decls,
 604            (n,_) <- tyClDeclNames d,
 605            Just fix <- [lookupNameEnv fixity_map n]] <> semi
 606
 607 pprRules []    = empty
 608 pprRules rules = hsep [ptext SLIT("{-## __R"), vcat (map ppr rules), ptext SLIT("##-}")]
 609
 610 pprDeprecs NoDeprecs = empty
 611 pprDeprecs deprecs   = ptext SLIT("{-## __D") <+> guts <+> ptext SLIT("##-}")
 612                      where
 613                        guts = case deprecs of
 614                                 DeprecAll txt  -> doubleQuotes (ptext txt)
 615                                 DeprecSome env -> pp_deprecs env
 616
 617 pp_deprecs env = vcat (punctuate semi (map pp_deprec (nameEnvElts env)))
 618                where
 619                  pp_deprec (name, txt) = pprOcc name <+> doubleQuotes (ptext txt)
 620 \end{code}