ghc/compiler/main/MkIface.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
   3 %
   4 \section[MkIface]{Print an interface for a module}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module MkIface (
  10         mkInterface,
  11
  12         -- and to make the interface self-sufficient...
  13         Bag, CE(..), GlobalSwitch, FixityDecl, Id,
  14         Name, PrettyRep, StgBinding, TCE(..), UniqFM, InstInfo
  15     ) where
  16
  17 IMPORT_Trace            -- ToDo: rm (debugging)
  18
  19 import AbsPrel          ( mkLiftTy, pRELUDE_CORE, pRELUDE_BUILTIN )
  20 import AbsSyn           ( FixityDecl(..), RenamedFixityDecl(..), MonoBinds,
  21                           RenamedMonoBinds(..), Name, RenamedPat(..), Sig
  22                         )
  23 import AbsUniType
  24 import Bag
  25 import CE
  26 import CmdLineOpts      -- ( GlobalSwitch(..) )
  27 import FiniteMap
  28 import Id
  29 import IdInfo           -- plenty from here
  30 import Maybes           ( catMaybes, Maybe(..) )
  31 import Outputable
  32 import Pretty
  33 import StgSyn
  34 import TCE
  35 import TcInstDcls       ( InstInfo(..) )
  36 import Util
  37 \end{code}
  38
  39 %************************************************************************
  40 %*                                                                      *
  41 \subsection[main-MkIface]{Main routine for making interfaces}
  42 %*                                                                      *
  43 %************************************************************************
  44
  45 Misc points:
  46 \begin{enumerate}
  47 \item
  48 We get the general what-to-export information from the ``environments''
  49 produced by the typechecker (the \tr{[RenamedFixityDecl]} through
  50 \tr{Bag InstInfo} arguments).
  51
  52 \item
  53 {\em However:} Whereas (for example) an \tr{InstInfo} will have
  54 \tr{Ids} in it that identify the constant methods for that instance,
  55 those particular \tr{Ids} {\em do not have} the best @IdInfos@!!!
  56 Those @IdInfos@ were figured out long after the \tr{InstInfo} was
  57 created.
  58
  59 That's why we actually look at the final \tr{PlainStgBindings} that go
  60 into the code-generator: they have the best @IdInfos@ on them.
  61 Whenever, we are about to print info about an @Id@, we look in the
  62 Ids-from-STG-bindings list to see if we have an ``equivalent'' @Id@
  63 with presumably-better @IdInfo@.
  64
  65 \item
  66 We play this same game whether for values, classes (for their
  67 method-selectors and default-methods), or instances (for their
  68 @DictFunIds@ or constant-methods).
  69
  70 Of course, for imported things, what we got from the typechecker is
  71 all we're gonna get.
  72
  73 \item
  74 We {\em sort} things in the interface into some ``canonical'' order;
  75 otherwise, with heavily-recursive modules, you can have (unchanged)
  76 information ``move around'' in the interface file---deeply unfriendly
  77 to \tr{make}.
  78 \end{enumerate}
  79
  80 \begin{code}
  81 mkInterface :: (GlobalSwitch -> Bool)
  82             -> FAST_STRING
  83             -> (FAST_STRING -> Bool,  -- is something in export list, explicitly?
  84                 FAST_STRING -> Bool)  -- is a module among the "dotdot" exported modules?
  85             -> IdEnv UnfoldingDetails
  86             -> FiniteMap TyCon [(Bool, [Maybe UniType])]
  87             -> ([RenamedFixityDecl],  -- interface info from the typecheck
  88                 [Id],
  89                 CE,
  90                 TCE,
  91                 Bag InstInfo)
  92             -> [PlainStgBinding]
  93             -> Pretty
  94
  95 mkInterface sw_chkr modname export_list_fns inline_env tycon_specs
  96             (fixity_decls, global_ids, ce, tce, inst_infos)
  97             stg_binds
  98   = let
  99         -- first, gather up the things we want to export:
 100
 101         exported_tycons  = [ tc | tc <- rngTCE tce,
 102                            isExported tc,
 103                            is_exportable_tycon_or_class sw_chkr export_list_fns tc ]
 104         exported_classes = [  c |  c <- rngCE  ce,
 105                            isExported  c,
 106                            is_exportable_tycon_or_class sw_chkr export_list_fns  c ]
 107         exported_inst_infos = [ i | i <- bagToList inst_infos,
 108                            is_exported_inst_info sw_chkr export_list_fns i ]
 109         exported_vals
 110           = [ v | v <- global_ids,
 111               isExported v && not (isDataCon v) && not (isClassOpId v) ]
 112
 113         -- We also have to worry about TyCons/Classes that are
 114         -- *mentioned* in exported things (e.g., values' types or
 115         -- instances), so that we can be sure to do an import decl for
 116         -- them, for original-naming purposes:
 117
 118         (mentioned_tycons, mentioned_classes)
 119           = foldr ( \ (tcs1, cls1) (tcs2, cls2)
 120                       -> (tcs1 `unionBags` tcs2, cls1 `unionBags` cls2) )
 121                   (emptyBag, emptyBag)
 122                   (map getMentionedTyConsAndClassesFromClass exported_classes  ++
 123                    map getMentionedTyConsAndClassesFromTyCon exported_tycons   ++
 124                    map getMentionedTyConsAndClassesFromId    exported_vals     ++
 125                    map getMentionedTyConsAndClassesFromInstInfo exported_inst_infos)
 126
 127         mentionable_classes
 128           = filter (is_mentionable sw_chkr) (bagToList mentioned_classes)
 129         mentionable_tycons
 130           = [ tc | tc <- bagToList mentioned_tycons,
 131                    is_mentionable sw_chkr tc,
 132                    not (isPrimTyCon tc) ]
 133
 134         nondup_mentioned_tycons  = fst (removeDups cmpTyCon mentionable_tycons)
 135         nondup_mentioned_classes = fst (removeDups cmpClass mentionable_classes)
 136
 137         -- Next: as discussed in the notes, we want the top-level
 138         -- Ids straight from the final STG code, so we can use
 139         -- their IdInfos to print pragmas; we slurp them out here,
 140         -- then pass them to the printing functions, which may
 141         -- use them.
 142
 143         better_ids = collectExportedStgBinders stg_binds
 144
 145         -- Make a lookup function for convenient access:
 146
 147         better_id_fn i
 148           = if not (isLocallyDefined i)
 149             then i  -- can't be among our "better_ids"
 150             else
 151                let
 152                    eq_fn = if isTopLevId i -- can't trust uniqs
 153                            then (\ x y -> getOrigName x == getOrigName y)
 154                            else eqId
 155                in
 156                case [ x | x <- better_ids, x `eq_fn` i ] of
 157                  []  -> pprPanic "better_id_fn:" (ppr PprShowAll i)
 158                         i
 159                  [x] -> x
 160                  _   -> panic "better_id_fn"
 161
 162         -- Finally, we sort everything lexically, so that we always
 163         -- get the same interface from the same information:
 164
 165         sorted_mentioned_tycons  = sortLt ltLexical nondup_mentioned_tycons
 166         sorted_mentioned_classes = sortLt ltLexical nondup_mentioned_classes
 167
 168         sorted_tycons     = sortLt ltLexical exported_tycons
 169         sorted_classes    = sortLt ltLexical exported_classes
 170         sorted_vals       = sortLt ltLexical exported_vals
 171         sorted_inst_infos = sortLt lt_lexical_inst_info exported_inst_infos
 172     in
 173     if (any_purely_local sorted_tycons sorted_classes sorted_vals) then
 174         -- this will be less of a HACK when we teach
 175         -- mkInterface to do I/O (WDP 94/10)
 176         error "Can't produce interface file because of errors!\n"
 177     else
 178 --  trace ("mkIface:Ids:"++(ppShow 80 (ppr PprDebug global_ids))) (
 179     ppAboves
 180        [ppPStr SLIT("{-# GHC_PRAGMA INTERFACE VERSION 6 #-}"),
 181         ppCat [ppPStr SLIT("interface"), ppPStr modname, ppPStr SLIT("where")],
 182
 183         do_import_decls sw_chkr modname
 184                 sorted_vals sorted_mentioned_classes sorted_mentioned_tycons,
 185                 -- Mustn't give the data constructors to do_import_decls,
 186                 -- because they aren't explicitly imported; their tycon is.
 187                 -- ToDo: modify if we ever add renaming properly.
 188
 189         ppAboves (map (do_fixity sw_chkr)                             fixity_decls),
 190         ppAboves (map (pprIfaceClass sw_chkr better_id_fn inline_env) sorted_classes),
 191         ppAboves (map (do_tycon    sw_chkr tycon_specs)               sorted_tycons),
 192         ppAboves (map (do_value    sw_chkr better_id_fn inline_env)   sorted_vals),
 193         ppAboves (map (do_instance sw_chkr better_id_fn inline_env)   sorted_inst_infos),
 194
 195         ppChar '\n'
 196        ]
 197 --  )
 198   where
 199     any_purely_local tycons classes vals
 200       =  any bad_tc tycons || any bad_cl classes || any bad_id vals
 201       where
 202         bad_cl cl
 203           = case (maybePurelyLocalClass cl) of
 204               Nothing -> False
 205               Just xs -> naughty_trace cl xs
 206
 207         bad_id id
 208           = case (maybePurelyLocalType (getIdUniType id)) of
 209               Nothing -> False
 210               Just xs -> naughty_trace id xs
 211
 212         bad_tc tc
 213           = case (maybePurelyLocalTyCon tc) of
 214               Nothing -> False
 215               Just xs -> if exported_abs then False else naughty_trace tc xs
 216           where
 217             exported_abs = case (getExportFlag tc) of { ExportAbs -> True; _ -> False }
 218
 219         naughty_trace x things
 220           = pprTrace "Can't export -- `"
 221                 (ppBesides [ppr PprForUser x, ppStr "' mentions purely local things: ",
 222                         ppInterleave pp'SP things])
 223                 True
 224 \end{code}
 225
 226 %************************************************************************
 227 %*                                                                      *
 228 \subsection[imports-MkIface]{Generating `import' declarations in an interface}
 229 %*                                                                      *
 230 %************************************************************************
 231
 232 Not handling renaming yet (ToDo)
 233
 234 We gather up lots of (module, name) pairs for which we might print an
 235 import declaration.  We sort them, for the usual canonicalisation
 236 reasons.  NB: We {\em assume} the lists passed in don't have duplicates in
 237 them!  expect).
 238
 239 All rather horribly turgid (WDP).
 240
 241 \begin{code}
 242 do_import_decls
 243         :: (GlobalSwitch -> Bool)
 244         -> FAST_STRING
 245         -> [Id] -> [Class] -> [TyCon]
 246         -> Pretty
 247
 248 do_import_decls sw_chkr mod_name vals classes tycons
 249   = let
 250         -- Conjure up (module, name, maybe_renaming) triples for all
 251         -- the potentially import-decls things:
 252
 253         vals_names, classes_names, tycons_names :: [(FAST_STRING, FAST_STRING, [Maybe FAST_STRING])]
 254         vals_names      = map get_val_triple   vals
 255         classes_names   = map get_class_triple classes
 256         tycons_names    = map get_tycon_triple tycons
 257
 258         -- sort the (module, name, renaming) triples and chop
 259         -- them into per-module groups:
 260
 261         ie_list = sortLt lt (tycons_names ++ classes_names ++ vals_names)
 262
 263         per_module_groups = runs same_module ie_list
 264     in
 265     ppAboves (map print_a_decl per_module_groups)
 266   where
 267     lt, same_module :: (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
 268                     -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING]) -> Bool
 269
 270     lt (m1, ie1, _) (m2, ie2, _)
 271       = case _CMP_STRING_ m1 m2 of { LT_ -> True; EQ_ -> ie1 < ie2; GT__ -> False }
 272
 273     same_module (m1, _, _) (m2, _, _) = m1 == m2
 274
 275     compiling_the_prelude = sw_chkr CompilingPrelude
 276
 277     print_a_decl :: [(FAST_STRING, FAST_STRING, [Maybe FAST_STRING])] -> Pretty
 278     {-
 279         Obviously, if the module in question is this one,
 280         don't print an import declaration.
 281
 282         If it's a Prelude* module, we don't print the TyCons/
 283         Classes, because the compiler supposedly knows about
 284         them already (and they are PreludeCore things anyway).
 285
 286         But if we are compiling a Prelude module, then we
 287         try to do it as "normally" as possible.
 288     -}
 289     print_a_decl (ielist@((m,_,_) : _))
 290       |  m == mod_name
 291       || (not compiling_the_prelude &&
 292           (m == pRELUDE_CORE || m == pRELUDE_BUILTIN))
 293       = ppNil
 294
 295       | otherwise
 296       = ppBesides [ppPStr SLIT("import "), ppPStr m, ppLparen,
 297                    ppIntersperse pp'SP{-'-} (map pp_str [n | (_,n,_) <- ielist]),
 298                    ppRparen,
 299                    case (grab_non_Nothings [rns | (_,_,rns) <- ielist]) of
 300                      []        -> ppNil
 301                      renamings -> pp_renamings renamings
 302                   ]
 303       where
 304         isnt_tycon_ish :: FAST_STRING -> Bool
 305         isnt_tycon_ish str = not (isConop str)
 306
 307         grab_non_Nothings :: [[Maybe FAST_STRING]] -> [FAST_STRING]
 308
 309         grab_non_Nothings rns = catMaybes (concat rns)
 310
 311         pp_str :: FAST_STRING -> Pretty
 312         pp_str pstr
 313           = if isAvarop pstr then ppStr ("("++str++")") else ppPStr pstr
 314           where
 315             str = _UNPK_ pstr
 316
 317         pp_renamings strs
 318           = ppBesides [ ppPStr SLIT(" renaming "), ppLparen, ppIntersperse pp'SP{-'-} (map ppPStr strs), ppRparen ]
 319 \end{code}
 320
 321 Most of the huff and puff here is to ferret out renaming strings.
 322
 323 \begin{code}
 324 get_val_triple   :: Id    -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
 325 get_class_triple :: Class -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
 326 get_tycon_triple :: TyCon -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
 327
 328 get_val_triple id
 329   = case (generic_triple id) of { (a,b,rn) ->
 330     (a,b,[rn]) }
 331
 332 get_class_triple clas
 333   = case (generic_triple clas) of { (orig_mod, orig_nm, clas_rn) ->
 334     let
 335         nm_to_print = case (getExportFlag clas) of
 336                         ExportAll   -> orig_nm _APPEND_ SLIT("(..)") -- nothing like a good HACK!
 337                         ExportAbs   -> orig_nm
 338                         NotExported -> orig_nm
 339
 340 -- Ops don't have renaming info (bug) ToDo
 341 --      ops         = getClassOps clas
 342 --      ops_rns     = [ rn | (_,_,rn) <- map generic_triple ops ]
 343     in
 344     (orig_mod, nm_to_print, [clas_rn]) }
 345
 346 get_tycon_triple tycon
 347   = case (generic_triple tycon) of { (orig_mod, orig_nm, tycon_rn) ->
 348     let
 349         nm_to_print = case (getExportFlag tycon) of
 350                         ExportAll   -> orig_nm _APPEND_ SLIT("(..)") -- nothing like a good HACK!
 351                         ExportAbs   -> orig_nm
 352                         NotExported -> orig_nm
 353
 354         cons        = getTyConDataCons tycon
 355         cons_rns    = [ rn | (_,_,rn) <- map generic_triple cons ]
 356     in
 357     (orig_mod, nm_to_print, tycon_rn : cons_rns) }
 358
 359 generic_triple thing
 360   = case (getOrigName       thing) of { (orig_mod, orig_nm) ->
 361     case (getOccurrenceName thing) of { occur_name ->
 362     (orig_mod, orig_nm,
 363      if orig_nm == occur_name
 364      then Nothing
 365      else Just (orig_nm _APPEND_ SLIT(" to ") _APPEND_ occur_name)
 366     )}}
 367 \end{code}
 368
 369 %************************************************************************
 370 %*                                                                      *
 371 \subsection[fixities-MkIface]{Generating fixity declarations in an interface}
 372 %*                                                                      *
 373 %************************************************************************
 374
 375
 376 \begin{code}
 377 do_fixity :: (GlobalSwitch -> Bool) -> RenamedFixityDecl -> Pretty
 378
 379 do_fixity sw_chkr fixity_decl
 380   = case (getExportFlag (get_name fixity_decl)) of
 381       ExportAll -> ppr (PprInterface sw_chkr) fixity_decl
 382       _         -> ppNil
 383   where
 384      get_name (InfixL n _) = n
 385      get_name (InfixR n _) = n
 386      get_name (InfixN n _) = n
 387 \end{code}
 388
 389 %************************************************************************
 390 %*                                                                      *
 391 \subsection[tycons-MkIface]{Generating tycon declarations in an interface}
 392 %*                                                                      *
 393 %************************************************************************
 394
 395 \begin{code}
 396 do_tycon :: (GlobalSwitch -> Bool) -> FiniteMap TyCon [(Bool, [Maybe UniType])] -> TyCon -> Pretty
 397
 398 do_tycon sw_chkr tycon_specs_map tycon
 399   = pprTyCon (PprInterface sw_chkr) tycon tycon_specs
 400   where
 401     tycon_specs = map snd (lookupWithDefaultFM tycon_specs_map [] tycon)
 402 \end{code}
 403
 404 %************************************************************************
 405 %*                                                                      *
 406 \subsection[values-MkIface]{Generating a value's signature in an interface}
 407 %*                                                                      *
 408 %************************************************************************
 409
 410 \begin{code}
 411 do_value :: (GlobalSwitch -> Bool)
 412          -> (Id -> Id)
 413          -> IdEnv UnfoldingDetails
 414          -> Id
 415          -> Pretty
 416
 417 do_value sw_chkr better_id_fn inline_env val
 418   = let
 419         sty         = PprInterface sw_chkr
 420         better_val  = better_id_fn val
 421         name_str    = getOccurrenceName better_val -- NB: not orig name!
 422
 423         id_info     = getIdInfo better_val
 424
 425         val_ty      = let
 426                          orig_ty  = getIdUniType val
 427                          final_ty = getIdUniType better_val
 428                       in
 429 --                    ASSERT (orig_ty == final_ty || mkLiftTy orig_ty == final_ty)
 430                       ASSERT (if (orig_ty == final_ty || mkLiftTy orig_ty == final_ty) then True else pprTrace "do_value:" (ppCat [ppr PprDebug val, ppr PprDebug better_val]) False)
 431                       orig_ty
 432
 433         -- Note: We export the type of the original val
 434         -- The type of an unboxed val will have been *lifted* by the desugarer
 435         -- In this case we export an unlifted type, but id_info which assumes
 436         --   a lifted Id i.e. extracted from better_val (above)
 437         -- The importing module must lift the Id before using the imported id_info
 438
 439         pp_id_info
 440           = if sw_chkr OmitInterfacePragmas
 441             || boringIdInfo id_info
 442             then ppNil
 443             else ppCat [ppPStr SLIT("\t{-# GHC_PRAGMA"),
 444                         ppIdInfo sty better_val True{-yes specs-}
 445                             better_id_fn inline_env id_info,
 446                         ppPStr SLIT("#-}")]
 447     in
 448     ppAbove (ppCat [ppr_non_op name_str,
 449                     ppPStr SLIT("::"), pprUniType sty val_ty])
 450             pp_id_info
 451
 452 -- sadly duplicates Outputable.pprNonOp (ToDo)
 453
 454 ppr_non_op str
 455   = if isAvarop str -- NOT NEEDED: || isAconop
 456     then ppBesides [ppLparen, ppPStr str, ppRparen]
 457     else ppPStr str
 458 \end{code}
 459
 460 %************************************************************************
 461 %*                                                                      *
 462 \subsection[instances-MkIface]{Generating instance declarations in an interface}
 463 %*                                                                      *
 464 %************************************************************************
 465
 466 The types of ``dictionary functions'' (dfuns) have just the required
 467 info for instance declarations in interfaces.  However, the dfuns that
 468 GHC really uses have {\em extra} dictionaries passed to them (for
 469 efficiency).  When we print interfaces, we want to omit that
 470 dictionary information.  (It can be reconsituted on the other end,
 471 from instance and class decls).
 472
 473 \begin{code}
 474 do_instance :: (GlobalSwitch -> Bool)
 475             -> (Id -> Id)
 476             -> IdEnv UnfoldingDetails
 477             -> InstInfo
 478             -> Pretty
 479
 480 do_instance sw_chkr better_id_fn inline_env
 481     (InstInfo clas tv_tmpls ty inst_decl_theta dfun_theta dfun_id constm_ids _ from_here modname _ _)
 482   = let
 483         sty = PprInterface sw_chkr
 484
 485         better_dfun      = better_id_fn dfun_id
 486         better_dfun_info = getIdInfo better_dfun
 487         better_constms   = map better_id_fn constm_ids
 488
 489         class_op_strs = map getClassOpString (getClassOps clas)
 490
 491         pragma_begin
 492           = ppCat [ppPStr SLIT("\t{-# GHC_PRAGMA"), pp_modname, ppPStr SLIT("{-dfun-}"),
 493                    ppIdInfo sty better_dfun False{-NO specs-}
 494                     better_id_fn inline_env better_dfun_info]
 495
 496         pragma_end = ppPStr SLIT("#-}")
 497
 498         pp_modname = if _NULL_ modname
 499                      then ppNil
 500                      else ppCat [ppStr "_M_", ppPStr modname]
 501
 502         name_pragma_pairs
 503           = pp_the_list [ ppCat [ppChar '\t', ppr_non_op op, ppEquals,
 504                                  ppChar '{' ,
 505                                  ppIdInfo sty constm True{-YES, specs-}
 506                                   better_id_fn inline_env
 507                                   (getIdInfo constm),
 508                                  ppChar '}' ]
 509                         | (op, constm) <- class_op_strs `zip` better_constms ]
 510
 511 #ifdef DEBUG
 512         pp_the_list [] = panic "MkIface: no class_ops or better_constms?"
 513 #endif
 514         pp_the_list [p]    = p
 515         pp_the_list (p:ps) = ppAbove (ppBeside p ppComma) (pp_the_list ps)
 516
 517         real_stuff
 518           = ppCat [ppPStr SLIT("instance"),
 519                    ppr sty (mkSigmaTy tv_tmpls inst_decl_theta (mkDictTy clas ty))]
 520     in
 521     if sw_chkr OmitInterfacePragmas
 522     || boringIdInfo better_dfun_info
 523     then real_stuff
 524     else ppAbove real_stuff
 525           ({-ppNest 8 -} -- ppNest does nothing
 526              if null better_constms
 527              then ppCat [pragma_begin, pragma_end]
 528              else ppAbove pragma_begin (ppCat [name_pragma_pairs, pragma_end])
 529           )
 530 \end{code}
 531
 532 %************************************************************************
 533 %*                                                                      *
 534 \subsection[utils-InstInfos]{Utility functions for @InstInfos@}
 535 %*                                                                      *
 536 %************************************************************************
 537
 538 ToDo: perhaps move.
 539
 540 Classes/TyCons are ``known,'' more-or-less.  Prelude TyCons are
 541 ``completely'' known---they don't need to be mentioned in interfaces.
 542 Classes usually don't need to be mentioned in interfaces, but if we're
 543 compiling the prelude, then we treat them without special favours.
 544 \begin{code}
 545 is_exportable_tycon_or_class sw_chkr export_list_fns tc
 546   = if not (fromPreludeCore tc) then
 547         True
 548     else
 549         in_export_list_or_among_dotdot_modules
 550             (sw_chkr CompilingPrelude) -- ignore M.. stuff if compiling prelude
 551             export_list_fns tc
 552
 553 in_export_list_or_among_dotdot_modules ignore_Mdotdots (in_export_list, among_dotdot_modules) tc
 554   = if in_export_list (getOccurrenceName tc) then
 555         True
 556     else
 557 --      pprTrace "in_export:" (ppAbove (ppr PprDebug ignore_Mdotdots) (ppPStr (getOccurrenceName tc))) (
 558     if ignore_Mdotdots then
 559         False
 560     else
 561         any among_dotdot_modules (getInformingModules tc)
 562 --  )
 563
 564 is_mentionable sw_chkr tc
 565   = not (from_PreludeCore_or_Builtin tc) || (sw_chkr CompilingPrelude)
 566   where
 567     from_PreludeCore_or_Builtin thing
 568       = let
 569             mod_name = fst (getOrigName thing)
 570         in
 571         mod_name == pRELUDE_CORE || mod_name == pRELUDE_BUILTIN
 572
 573 is_exported_inst_info sw_chkr export_list_fns
 574         (InstInfo clas _ ty _ _ _ _ _ from_here _ _ _)
 575   = let
 576         is_fun_tycon = isFunType ty
 577
 578         seems_exported = instanceIsExported clas ty from_here
 579
 580         (tycon, _, _) = getUniDataTyCon ty
 581     in
 582     if (sw_chkr OmitReexportedInstances && not from_here) then
 583         False -- Flag says to violate Haskell rules, blatantly
 584
 585     else if not (sw_chkr CompilingPrelude)
 586          || not (is_fun_tycon || fromPreludeCore tycon)
 587          || not (fromPreludeCore clas) then
 588         seems_exported -- take what we got
 589
 590     else -- compiling Prelude & tycon/class are Prelude things...
 591         from_here
 592         || in_export_list_or_among_dotdot_modules True{-ignore M..s-} export_list_fns clas
 593         || (not is_fun_tycon
 594             && in_export_list_or_among_dotdot_modules True{-ignore M..s-} export_list_fns tycon)
 595 \end{code}
 596
 597 \begin{code}
 598 lt_lexical_inst_info (InstInfo _ _ _ _ _ dfun1 _ _ _ _ _ _) (InstInfo _ _ _ _ _ dfun2 _ _ _ _ _ _)
 599   = ltLexical dfun1 dfun2
 600 \end{code}
 601
 602 \begin{code}
 603 getMentionedTyConsAndClassesFromInstInfo (InstInfo clas _ ty _ dfun_theta _ _ _ _ _ _ _)
 604   = case (getMentionedTyConsAndClassesFromUniType ty) of { (ts, cs) ->
 605     case [ c | (c, _) <- dfun_theta ]                 of { theta_classes ->
 606     (ts, (cs `unionBags` listToBag theta_classes) `snocBag` clas)
 607     }}
 608 \end{code}