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 ( completeIface ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn
  12 import HsCore           ( HsIdInfo(..), toUfExpr, ifaceSigName )
  13 import HsTypes          ( toHsTyVars )
  14 import BasicTypes       ( Fixity(..), NewOrData(..),
  15                           Version, bumpVersion, isLoopBreaker
  16                         )
  17 import RnMonad
  18 import RnHsSyn          ( RenamedInstDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedIfaceSig )
  19 import HscTypes         ( VersionInfo(..), IfaceDecls(..), ModIface(..), ModDetails(..),
  20                           TyThing(..), DFunId )
  21
  22 import CmdLineOpts
  23 import Id               ( Id, idType, idInfo, omitIfaceSigForId, isUserExportedId, hasNoBinding,
  24                           idSpecialisation
  25                         )
  26 import Var              ( isId )
  27 import VarSet
  28 import DataCon          ( StrictnessMark(..), dataConSig, dataConFieldLabels, dataConStrictMarks )
  29 import IdInfo           ( IdInfo, StrictnessInfo(..), ArityInfo(..),
  30                           CprInfo(..), CafInfo(..),
  31                           inlinePragInfo, arityInfo, arityLowerBound,
  32                           strictnessInfo, isBottomingStrictness,
  33                           cafInfo, specInfo, cprInfo,
  34                           occInfo, isNeverInlinePrag,
  35                           workerInfo, WorkerInfo(..)
  36                         )
  37 import CoreSyn          ( CoreExpr, CoreBind, Bind(..), isBuiltinRule, rulesRules, rulesRhsFreeVars )
  38 import CoreFVs          ( exprSomeFreeVars, ruleSomeLhsFreeVars, ruleSomeFreeVars )
  39 import CoreUnfold       ( okToUnfoldInHiFile, couldBeSmallEnoughToInline )
  40 import Name             ( isLocallyDefined, getName, nameModule,
  41                           Name, NamedThing(..),
  42                           plusNameEnv, lookupNameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv_NF, nameEnvElts
  43                         )
  44 import TyCon            ( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
  45                           tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize
  46                         )
  47 import Class            ( classExtraBigSig, DefMeth(..) )
  48 import FieldLabel       ( fieldLabelType )
  49 import Type             ( splitSigmaTy, tidyTopType, deNoteType )
  50
  51 import Rules            ( ProtoCoreRule(..) )
  52
  53 import Bag              ( bagToList )
  54 import UniqFM           ( lookupUFM, listToUFM )
  55 import SrcLoc           ( noSrcLoc )
  56 import Bag
  57 import Outputable
  58
  59 import List             ( partition )
  60 \end{code}
  61
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection{Write a new interface file}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 completeModDetails :: ModDetails
  71                    -> [CoreBind] -> [Id]        -- Final bindings, plus the top-level Ids from the
  72                                                 -- code generator; they have authoritative arity info
  73                    -> [ProtoCoreRule]           -- Tidy orphan rules
  74                    -> ModDetails
  75
  76 completeIface :: Maybe ModIface         -- The old interface, if we have it
  77               -> ModIface               -- The new one, minus the decls and versions
  78               -> ModDetails             -- The ModDetails for this module
  79               -> Maybe (ModIface, SDoc) -- The new one, complete with decls and versions
  80                                         -- The SDoc is a debug document giving differences
  81                                         -- Nothing => no change
  82
  83         -- NB: 'Nothing' means that even the usages havn't changed, so there's no
  84         --     need to write a new interface file.  But even if the usages have
  85         --     changed, the module version may not have.
  86         --
  87         -- The IO in the type is solely for debug output
  88         -- In particular, dumping a record of what has changed
  89 completeIface maybe_old_iface new_iface mod_details
  90               tidy_binds final_ids tidy_orphan_rules
  91   = let
  92         new_decls = declsFromDetails mod_details tidy_binds final_ids tidy_orphan_rules
  93     in
  94     addVersionInfo maybe_old_iface (new_iface { mi_decls = new_decls })
  95
  96 declsFromDetails :: ModDetails -> [CoreBind] -> [Id] -> [ProtoCoreRule] -> IfaceDecls
  97 declsFromDetails details tidy_binds final_ids tidy_orphan_rules
  98    = IfaceDecls { dcl_tycl  = ty_cls_dcls ++ bagToList val_dcls,
  99                   dcl_insts = inst_dcls,
 100                   dcl_rules = rule_dcls }
 101    where
 102      dfun_ids    = md_insts details
 103      inst_dcls   = map ifaceInstance dfun_ids
 104      ty_cls_dcls = map ifaceTyCls (filter emitTyCls (nameEnvElts (md_types details)))
 105
 106      (val_dcls, emitted_ids) = ifaceBinds (mkVarSet dfun_ids `unionVarSet` orphan_rule_ids)
 107                                           final_ids tidy_binds
 108
 109      rule_dcls | opt_OmitInterfacePragmas = []
 110                | otherwise                = ifaceRules tidy_orphan_rules emitted_ids
 111
 112      orphan_rule_ids = unionVarSets [ ruleSomeFreeVars interestingId rule
 113                                     | ProtoCoreRule _ _ rule <- tidy_orphan_rules]
 114
 115 \end{code}
 116
 117 %************************************************************************
 118 %*                                                                      *
 119 \subsection{Types and classes}
 120 %*                                                                      *
 121 %************************************************************************
 122
 123 \begin{code}
 124 emitTyCls :: TyThing -> Bool
 125 emitTyCls (ATyCon tc) = True    -- Could filter out wired in ones, but it's not
 126                                 -- strictly necessary, and it costs extra time
 127 emitTyCls (AClass cl) = True
 128 emitTyCls (AnId   _)  = False
 129
 130
 131 ifaceTyCls :: TyThing -> RenamedTyClDecl
 132 ifaceTyCls (AClass clas)
 133   = ClassDecl (toHsContext sc_theta)
 134               (getName clas)
 135               (toHsTyVars clas_tyvars)
 136               (toHsFDs clas_fds)
 137               (map toClassOpSig op_stuff)
 138               EmptyMonoBinds
 139               [] noSrcLoc
 140   where
 141      (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
 142
 143      toClassOpSig (sel_id, def_meth)
 144         = ASSERT(sel_tyvars == clas_tyvars)
 145           ClassOpSig (getName sel_id) (Just def_meth') (toHsType op_ty) noSrcLoc
 146         where
 147           (sel_tyvars, _, op_ty) = splitSigmaTy (idType sel_id)
 148           def_meth' = case def_meth of
 149                          NoDefMeth  -> NoDefMeth
 150                          GenDefMeth -> GenDefMeth
 151                          DefMeth id -> DefMeth (getName id)
 152
 153 ifaceTyCls (ATyCon tycon)
 154   | isSynTyCon tycon
 155   = TySynonym (getName tycon)(toHsTyVars tyvars) (toHsType ty) noSrcLoc
 156   where
 157     (tyvars, ty) = getSynTyConDefn tycon
 158
 159 ifaceTyCls (ATyCon tycon)
 160   | isAlgTyCon tycon
 161   = TyData new_or_data (toHsContext (tyConTheta tycon))
 162            (getName tycon)
 163            (toHsTyVars tyvars)
 164            (map ifaceConDecl (tyConDataCons tycon))
 165            (tyConFamilySize tycon)
 166            Nothing noSrcLoc (panic "gen1") (panic "gen2")
 167   where
 168     tyvars = tyConTyVars tycon
 169     new_or_data | isNewTyCon tycon = NewType
 170                 | otherwise        = DataType
 171
 172     ifaceConDecl data_con
 173         = ConDecl (getName data_con) (error "ifaceConDecl")
 174                   (toHsTyVars ex_tyvars)
 175                   (toHsContext ex_theta)
 176                   details noSrcLoc
 177         where
 178           (tyvars1, _, ex_tyvars, ex_theta, arg_tys, tycon1) = dataConSig data_con
 179           field_labels   = dataConFieldLabels data_con
 180           strict_marks   = dataConStrictMarks data_con
 181           details | null field_labels
 182                   = ASSERT( tycon == tycon1 && tyvars == tyvars1 )
 183                     VanillaCon (zipWith mk_bang_ty strict_marks arg_tys)
 184
 185                   | otherwise
 186                   = RecCon (zipWith mk_field strict_marks field_labels)
 187
 188     mk_bang_ty NotMarkedStrict     ty = Unbanged (toHsType ty)
 189     mk_bang_ty (MarkedUnboxed _ _) ty = Unpacked (toHsType ty)
 190     mk_bang_ty MarkedStrict        ty = Banged   (toHsType ty)
 191
 192     mk_field strict_mark field_label
 193         = ([getName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
 194
 195 ifaceTyCls (ATyCon tycon) = pprPanic "ifaceTyCls" (ppr tycon)
 196 \end{code}
 197
 198
 199 %************************************************************************
 200 %*                                                                      *
 201 \subsection{Instances and rules}
 202 %*                                                                      *
 203 %************************************************************************
 204
 205 \begin{code}
 206 ifaceInstance :: DFunId -> RenamedInstDecl
 207 ifaceInstance dfun_id
 208   = InstDecl (toHsType tidy_ty) EmptyMonoBinds [] (Just (getName dfun_id)) noSrcLoc
 209   where
 210     tidy_ty = tidyTopType (deNoteType (idType dfun_id))
 211                 -- The deNoteType is very important.   It removes all type
 212                 -- synonyms from the instance type in interface files.
 213                 -- That in turn makes sure that when reading in instance decls
 214                 -- from interface files that the 'gating' mechanism works properly.
 215                 -- Otherwise you could have
 216                 --      type Tibble = T Int
 217                 --      instance Foo Tibble where ...
 218                 -- and this instance decl wouldn't get imported into a module
 219                 -- that mentioned T but not Tibble.
 220 \end{code}
 221
 222 \begin{code}
 223 ifaceRules :: [ProtoCoreRule] -> IdSet -> [RenamedRuleDecl]
 224 ifaceRules rules emitted
 225   = orphan_rules ++ local_rules
 226   where
 227     orphan_rules = [ toHsRule fn rule | ProtoCoreRule _ fn rule <- rules ]
 228     local_rules  = [ toHsRule fn rule
 229                    | fn <- varSetElems emitted,
 230                      rule <- rulesRules (idSpecialisation fn),
 231                      not (isBuiltinRule rule),
 232                                 -- We can't print builtin rules in interface files
 233                                 -- Since they are built in, an importing module
 234                                 -- will have access to them anyway
 235
 236                         -- Sept 00: I've disabled this test.  It doesn't stop many, if any, rules
 237                         -- from coming out, and to make it work properly we need to add ????
 238                         --      (put it back in for now)
 239                      all (`elemVarSet` emitted) (varSetElems (ruleSomeLhsFreeVars interestingId rule))
 240                                 -- Spit out a rule only if all its lhs free vars are emitted
 241                                 -- This is a good reason not to do it when we emit the Id itself
 242                    ]
 243 \end{code}
 244
 245
 246 %************************************************************************
 247 %*                                                                      *
 248 \subsection{Value bindings}
 249 %*                                                                      *
 250 %************************************************************************
 251
 252 \begin{code}
 253 ifaceBinds :: IdSet             -- These Ids are needed already
 254            -> [Id]              -- Ids used at code-gen time; they have better pragma info!
 255            -> [CoreBind]        -- In dependency order, later depend on earlier
 256            -> (Bag RenamedIfaceSig, IdSet)              -- Set of Ids actually spat out
 257
 258 ifaceBinds needed_ids final_ids binds
 259   = go needed_ids (reverse binds) emptyBag emptyVarSet
 260                 -- Reverse so that later things will
 261                 -- provoke earlier ones to be emitted
 262   where
 263     final_id_map  = listToUFM [(id,id) | id <- final_ids]
 264     get_idinfo id = case lookupUFM final_id_map id of
 265                         Just id' -> idInfo id'
 266                         Nothing  -> pprTrace "ifaceBinds not found:" (ppr id) $
 267                                     idInfo id
 268
 269         -- The 'needed' set contains the Ids that are needed by earlier
 270         -- interface file emissions.  If the Id isn't in this set, and isn't
 271         -- exported, there's no need to emit anything
 272     need_id needed_set id = id `elemVarSet` needed_set || isUserExportedId id
 273
 274     go needed [] decls emitted
 275         | not (isEmptyVarSet needed) = pprTrace "ifaceBinds: free vars:"
 276                                           (sep (map ppr (varSetElems needed)))
 277                                        (decls, emitted)
 278         | otherwise                  = (decls, emitted)
 279
 280     go needed (NonRec id rhs : binds) decls emitted
 281         | need_id needed id
 282         = if omitIfaceSigForId id then
 283             go (needed `delVarSet` id) binds decls (emitted `extendVarSet` id)
 284           else
 285             go ((needed `unionVarSet` extras) `delVarSet` id)
 286                binds
 287                (decl `consBag` decls)
 288                (emitted `extendVarSet` id)
 289         | otherwise
 290         = go needed binds decls emitted
 291         where
 292           (decl, extras) = ifaceId get_idinfo False id rhs
 293
 294         -- Recursive groups are a bit more of a pain.  We may only need one to
 295         -- start with, but it may call out the next one, and so on.  So we
 296         -- have to look for a fixed point.  We don't want necessarily them all,
 297         -- because without -O we may only need the first one (if we don't emit
 298         -- its unfolding)
 299     go needed (Rec pairs : binds) decls emitted
 300         = go needed' binds decls' emitted'
 301         where
 302           (new_decls, new_emitted, extras) = go_rec needed pairs
 303           decls'   = new_decls `unionBags` decls
 304           needed'  = (needed `unionVarSet` extras) `minusVarSet` mkVarSet (map fst pairs)
 305           emitted' = emitted `unionVarSet` new_emitted
 306
 307     go_rec :: IdSet -> [(Id,CoreExpr)] -> (Bag RenamedIfaceSig, IdSet, IdSet)
 308     go_rec needed pairs
 309         | null decls = (emptyBag, emptyVarSet, emptyVarSet)
 310         | otherwise  = (more_decls   `unionBags`   listToBag decls,
 311                         more_emitted `unionVarSet` mkVarSet (map fst needed_prs),
 312                         more_extras  `unionVarSet` extras)
 313         where
 314           (needed_prs,leftover_prs) = partition is_needed pairs
 315           (decls, extras_s)         = unzip [ifaceId get_idinfo True id rhs
 316                                             | (id,rhs) <- needed_prs, not (omitIfaceSigForId id)]
 317           extras                    = unionVarSets extras_s
 318           (more_decls, more_emitted, more_extras) = go_rec extras leftover_prs
 319           is_needed (id,_) = need_id needed id
 320 \end{code}
 321
 322
 323 \begin{code}
 324 ifaceId :: (Id -> IdInfo)       -- This function "knows" the extra info added
 325                                 -- by the STG passes.  Sigh
 326         -> Bool                 -- True <=> recursive, so don't print unfolding
 327         -> Id
 328         -> CoreExpr             -- The Id's right hand side
 329         -> (RenamedTyClDecl, IdSet)     -- The emitted stuff, plus any *extra* needed Ids
 330
 331 ifaceId get_idinfo is_rec id rhs
 332   = (IfaceSig (getName id) (toHsType id_type) hs_idinfo noSrcLoc,  new_needed_ids)
 333   where
 334     id_type     = idType id
 335     core_idinfo = idInfo id
 336     stg_idinfo  = get_idinfo id
 337
 338     hs_idinfo | opt_OmitInterfacePragmas = []
 339               | otherwise                = arity_hsinfo  ++ caf_hsinfo  ++ cpr_hsinfo ++
 340                                            strict_hsinfo ++ wrkr_hsinfo ++ unfold_hsinfo
 341
 342     ------------  Arity  --------------
 343     arity_info   = arityInfo stg_idinfo
 344     stg_arity    = arityLowerBound arity_info
 345     arity_hsinfo = case arityInfo stg_idinfo of
 346                         a@(ArityExactly n) -> [HsArity a]
 347                         other              -> []
 348
 349     ------------ Caf Info --------------
 350     caf_hsinfo = case cafInfo stg_idinfo of
 351                    NoCafRefs -> [HsNoCafRefs]
 352                    otherwise -> []
 353
 354     ------------ CPR Info --------------
 355     cpr_hsinfo = case cprInfo core_idinfo of
 356                    ReturnsCPR -> [HsCprInfo]
 357                    NoCPRInfo  -> []
 358
 359     ------------  Strictness  --------------
 360     strict_info   = strictnessInfo core_idinfo
 361     bottoming_fn  = isBottomingStrictness strict_info
 362     strict_hsinfo = case strict_info of
 363                         NoStrictnessInfo -> []
 364                         info             -> [HsStrictness info]
 365
 366
 367     ------------  Worker  --------------
 368         -- We only treat a function as having a worker if
 369         -- the exported arity (which is now the number of visible lambdas)
 370         -- is the same as the arity at the moment of the w/w split
 371         -- If so, we can safely omit the unfolding inside the wrapper, and
 372         -- instead re-generate it from the type/arity/strictness info
 373         -- But if the arity has changed, we just take the simple path and
 374         -- put the unfolding into the interface file, forgetting the fact
 375         -- that it's a wrapper.
 376         --
 377         -- How can this happen?  Sometimes we get
 378         --      f = coerce t (\x y -> $wf x y)
 379         -- at the moment of w/w split; but the eta reducer turns it into
 380         --      f = coerce t $wf
 381         -- which is perfectly fine except that the exposed arity so far as
 382         -- the code generator is concerned (zero) differs from the arity
 383         -- when we did the split (2).
 384         --
 385         -- All this arises because we use 'arity' to mean "exactly how many
 386         -- top level lambdas are there" in interface files; but during the
 387         -- compilation of this module it means "how many things can I apply
 388         -- this to".
 389     work_info           = workerInfo core_idinfo
 390     HasWorker work_id _ = work_info
 391
 392     has_worker = case work_info of
 393                   HasWorker work_id wrap_arity
 394                    | wrap_arity == stg_arity -> True
 395                    | otherwise               -> pprTrace "ifaceId: arity change:" (ppr id)
 396                                                 False
 397
 398                   other                      -> False
 399
 400     wrkr_hsinfo | has_worker = [HsWorker (getName work_id)]
 401                 | otherwise  = []
 402
 403     ------------  Unfolding  --------------
 404     inline_pragma  = inlinePragInfo core_idinfo
 405     dont_inline    = isNeverInlinePrag inline_pragma
 406
 407     unfold_hsinfo | show_unfold = [HsUnfold inline_pragma (toUfExpr rhs)]
 408                   | otherwise   = []
 409
 410     show_unfold = not has_worker         &&     -- Not unnecessary
 411                   not bottoming_fn       &&     -- Not necessary
 412                   not dont_inline        &&
 413                   not loop_breaker       &&
 414                   rhs_is_small           &&     -- Small enough
 415                   okToUnfoldInHiFile rhs        -- No casms etc
 416
 417     rhs_is_small = couldBeSmallEnoughToInline opt_UF_HiFileThreshold rhs
 418
 419     ------------  Specialisations --------------
 420     spec_info   = specInfo core_idinfo
 421
 422     ------------  Occ info  --------------
 423     loop_breaker  = isLoopBreaker (occInfo core_idinfo)
 424
 425     ------------  Extra free Ids  --------------
 426     new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet
 427                    | otherwise                = worker_ids      `unionVarSet`
 428                                                 unfold_ids      `unionVarSet`
 429                                                 spec_ids
 430
 431     worker_ids | has_worker && interestingId work_id = unitVarSet work_id
 432                         -- Conceivably, the worker might come from
 433                         -- another module
 434                | otherwise = emptyVarSet
 435
 436     spec_ids = filterVarSet interestingId (rulesRhsFreeVars spec_info)
 437
 438     unfold_ids | show_unfold = find_fvs rhs
 439                | otherwise   = emptyVarSet
 440
 441     find_fvs expr = exprSomeFreeVars interestingId expr
 442
 443 interestingId id = isId id && isLocallyDefined id && not (hasNoBinding id)
 444 \end{code}
 445
 446
 447 %************************************************************************
 448 %*                                                                      *
 449 \subsection{Checking if the new interface is up to date
 450 %*                                                                      *
 451 %************************************************************************
 452
 453 \begin{code}
 454 addVersionInfo :: Maybe ModIface                -- The old interface, read from M.hi
 455                -> ModIface                      -- The new interface decls
 456                -> Maybe (ModIface, SDoc)        -- Nothing => no change; no need to write new Iface
 457                                                 -- Just mi => Here is the new interface to write
 458                                                 --            with correct version numbers
 459
 460 -- NB: the fixities, declarations, rules are all assumed
 461 -- to be sorted by increasing order of hsDeclName, so that
 462 -- we can compare for equality
 463
 464 addVersionInfo Nothing new_iface
 465 -- No old interface, so definitely write a new one!
 466   = Just (new_iface, text "No old interface available")
 467
 468 addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
 469                                            mi_decls   = old_decls,
 470                                            mi_fixities = old_fixities }))
 471                new_iface@(ModIface { mi_decls = new_decls,
 472                                      mi_fixities = new_fixities })
 473
 474   | no_output_change && no_usage_change
 475   = Nothing
 476
 477   | otherwise           -- Add updated version numbers
 478   = Just (final_iface, pp_tc_diffs $$ pp_sig_diffs)
 479
 480   where
 481     final_iface = new_iface { mi_version = new_version }
 482     new_version = VersionInfo { vers_module  = bumpVersion no_output_change (vers_module  old_version),
 483                                 vers_exports = bumpVersion no_export_change (vers_exports old_version),
 484                                 vers_rules   = bumpVersion no_rule_change   (vers_rules   old_version),
 485                                 vers_decls   = sig_vers `plusNameEnv` tc_vers }
 486
 487     no_output_change = no_tc_change && no_rule_change && no_export_change
 488     no_usage_change  = mi_usages old_iface == mi_usages new_iface
 489
 490     no_export_change = mi_exports old_iface == mi_exports new_iface             -- Kept sorted
 491     no_rule_change   = dcl_rules old_decls  == dcl_rules  new_decls             -- Ditto
 492
 493         -- Fill in the version number on the new declarations by looking at the old declarations.
 494         -- Set the flag if anything changes.
 495         -- Assumes that the decls are sorted by hsDeclName.
 496     old_vers_decls = vers_decls old_version
 497     (no_tc_change,  pp_tc_diffs,  tc_vers) = diffDecls old_vers_decls (dcl_tycl old_decls) (dcl_tycl new_decls)
 498
 499
 500
 501 diffDecls :: NameEnv Version                            -- Old version map
 502           -> [RenamedTyClDecl] -> [RenamedTyClDecl]     -- Old and new decls
 503           -> (Bool,             -- True <=> no change
 504               SDoc,             -- Record of differences
 505               NameEnv Version)  -- New version
 506
 507 diffDecls old_vers old new
 508   = diff True empty emptyNameEnv old new
 509   where
 510         -- When seeing if two decls are the same,
 511         -- remember to check whether any relevant fixity has changed
 512     eq_tc  d1 d2 = d1 == d2 && all (same_fixity . fst) (tyClDeclNames d1)
 513     same_fixity n = lookupNameEnv old_fixities n == lookupNameEnv new_fixities n
 514
 515     diff ok_so_far pp new_vers []  []      = (ok_so_far, pp, new_vers)
 516     diff ok_so_far pp new_vers old []      = (False,     pp, new_vers)
 517     diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers [] nds
 518     diff ok_so_far pp new_vers (od:ods) (nd:nds)
 519         = case od_name `compare` nd_name of
 520                 LT -> diff False (pp $$ only_old od) new_vers ods      (nd:nds)
 521                 GT -> diff False (pp $$ only_new nd) new_vers (od:ods) nds
 522                 EQ | od `eq` nd -> diff ok_so_far pp                     new_vers  ods nds
 523                    | otherwise  -> diff False      (pp $$ changed od nd) new_vers' ods nds
 524         where
 525           od_name = get_name od
 526           nd_name = get_name nd
 527           new_vers' = extendNameEnv new_vers nd_name
 528                                     (bumpVersion True (lookupNameEnv_NF old_vers od_name))
 529
 530     only_old d   = ptext SLIT("Only in old iface:") <+> ppr d
 531     only_new d   = ptext SLIT("Only in new iface:") <+> ppr d
 532     changed d nd = ptext SLIT("Changed in iface: ") <+> ((ptext SLIT("Old:") <+> ppr d) $$
 533                                                          (ptext SLIT("New:") <+> ppr nd))
 534 \end{code}