ghc/compiler/rename/RnPass1.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnPass1]{@RnPass1@: gather up imported information}
   5
   6 See the @Rename@ module for a basic description of the renamer.
   7
   8 \begin{code}
   9 #include "HsVersions.h"
  10
  11 module RnPass1 (
  12         rnModule1
  13
  14         -- for completeness
  15     ) where
  16
  17 import Ubiq{-uitous-}
  18
  19 import HsSyn
  20 import HsPragmas        ( DataPragmas(..) )
  21 import RdrHsSyn         -- ProtoName* instantiations...
  22
  23 import Bag              ( emptyBag, unitBag, snocBag, unionBags, Bag )
  24 import ErrUtils
  25 import FiniteMap        ( lookupFM, listToFM, elementOf )
  26 import Maybes           ( catMaybes, maybeToBool )
  27 import Name             ( Name{-instances-} )
  28 import Outputable       ( isAvarid, getLocalName, interpp'SP )
  29 import PprStyle         ( PprStyle(..) )
  30 import Pretty
  31 import ProtoName        ( mkPreludeProtoName, ProtoName(..) )
  32 import RnMonad12
  33 import RnUtils
  34 import Util             ( lengthExceeds, panic )
  35 \end{code}
  36
  37 %************************************************************************
  38 %*                                                                      *
  39 \subsection{Types and things used herein}
  40 %*                                                                      *
  41 %************************************************************************
  42
  43 @AllIntDecls@ is the type returned from processing import statement(s)
  44 in the main module.
  45
  46 \begin{code}
  47 type AllIntDecls = ([ProtoNameFixityDecl], [ProtoNameTyDecl],
  48                     [ProtoNameClassDecl],  [ProtoNameInstDecl],
  49                     [ProtoNameSig], Bag FAST_STRING)
  50 \end{code}
  51
  52 The selective-import function @SelectiveImporter@ maps a @ProtoName@
  53 to something which indicates how much of the thing, if anything, is
  54 wanted by the importing module.
  55 \begin{code}
  56 type SelectiveImporter = ProtoName -> Wantedness
  57
  58 data Wantedness
  59   = Wanted
  60   | NotWanted
  61   | WantedWith (IE ProtoName)
  62 \end{code}
  63
  64 The @ProtoNames@ supplied to these ``name functions'' are always
  65 @Unks@, unless they are fully-qualified names, which occur only in
  66 interface pragmas (and, therefore, never on the {\em definitions} of
  67 things).  That doesn't happen in @RnPass1@!
  68 \begin{code}
  69 type IntNameFun   = ProtoName -> ProtoName
  70 type IntTCNameFun = ProtoName -> (ProtoName, IntNameFun)
  71 \end{code}
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection{First pass over the entire module}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 This pass flattens out the declarations embedded within the interfaces
  80 which this module imports.  The result is a new module with no
  81 imports, but with more declarations.  The declarations which arose
  82 from the imported interfaces will have @ProtoNames@ with @Imp@
  83 constructors; the declarations in the body of this module are
  84 unaffected, so they will still be @Unk@'s.
  85
  86 We import only the declarations from interfaces which are actually {\em
  87 used}.  This saves time later, because we don't need process the
  88 unused ones.
  89
  90 \begin{code}
  91 rnModule1 :: PreludeNameMappers
  92           -> Bool               -- see use below
  93           -> ProtoNameHsModule
  94           -> Rn12M (ProtoNameHsModule, Bag FAST_STRING)
  95
  96 rnModule1 pnf@(v_pnf, tc_pnf)
  97         use_mentioned_vars_heuristic
  98         (HsModule mod_name exports imports fixes
  99                   ty_decls absty_sigs class_decls inst_decls specinst_sigs
 100                   defaults binds _ src_loc)
 101
 102   =     -- slurp through the *body* of the module, collecting names of
 103         -- mentioned *variables*, 3+ letters long & not prelude names.
 104         -- Note: we *do* have to pick up top-level binders,
 105         -- so we can check for conflicts with imported guys!
 106     let
 107         is_mentioned_fn = \ x -> True -- wimp way out
 108 {- OLD:
 109         (uses_Mdotdot_in_exports, mentioned_vars)
 110           = getMentionedVars v_pnf exports fixes class_decls inst_decls binds
 111
 112         -- Using the collected "mentioned" variables, create an
 113         -- "is-mentioned" function (:: FAST_STRING -> Bool), which gives
 114         -- True if something is mentioned is in the list collected.
 115         -- For more details, see under @selectAll@, notably the
 116         -- handling of short (< 3 chars) names.
 117
 118         -- Note: this "is_mentioned" game doesn't work if the export
 119         -- list includes any M.. constructs (because that mentions
 120         -- variables *implicitly*, basically).  getMentionedVars tells
 121         -- us this, and we act accordingly.
 122
 123         is_mentioned_maybe
 124           = lookupFM (listToFM
 125                 [ (x, panic "is_mentioned_fn")
 126                 | x <- mentioned_vars ++ needed_for_deriving ]
 127                 )
 128           where
 129             needed_for_deriving -- is this a HACK or what?
 130               = [ SLIT("&&"),
 131                   SLIT("."),
 132                   SLIT("lex"),
 133                   SLIT("map"),
 134                   SLIT("not"),
 135                   SLIT("readParen"),
 136                   SLIT("showParen"),
 137                   SLIT("showSpace__"),
 138                   SLIT("showString")
 139                 ]
 140
 141         is_mentioned_fn
 142           = if use_mentioned_vars_heuristic
 143             && not (uses_Mdotdot_in_exports)
 144             then \ x -> maybeToBool (is_mentioned_maybe x)
 145             else \ x -> True
 146 -}
 147     in
 148         -- OK, now do the business:
 149     doImportedIfaces pnf is_mentioned_fn imports
 150                  `thenRn12`  \ (int_fixes, int_ty_decls,
 151                                 int_class_decls, int_inst_decls,
 152                                 int_sigs, import_names) ->
 153     let
 154         inst_decls' = doRevoltingInstDecls tc_nf inst_decls
 155     in
 156     returnRn12
 157          ((HsModule mod_name
 158                     exports imports -- passed along mostly for later checking
 159                     (int_fixes ++ fixes)
 160                     (int_ty_decls ++ ty_decls)
 161                     absty_sigs
 162                     (int_class_decls ++ class_decls)
 163                     (int_inst_decls  ++ inst_decls')
 164                     specinst_sigs
 165                     defaults
 166                     binds
 167                     int_sigs
 168                     src_loc),
 169           import_names)
 170   where
 171     -- This function just spots prelude names
 172     tc_nf pname@(Unk s) = case (tc_pnf s) of
 173                            Nothing   -> pname
 174                            Just name -> Prel name
 175
 176     tc_nf other_pname   = panic "In tc_nf passed to doRevoltingInstDecls"
 177         -- The only place where Imps occur is on Ids in unfoldings;
 178         -- this function is only used on type-things.
 179 \end{code}
 180
 181 Instance declarations in the module itself are treated in a horribly
 182 special way.  Because their class name and type constructor will be
 183 compared against imported ones in the second pass (to eliminate
 184 duplicate instance decls) we need to make Prelude classes and tycons
 185 appear as such.  (For class and type decls, the module can't be
 186 declaring a prelude class or tycon, so Prel and Unk things can just
 187 compare non-equal.)  This is a HACK.
 188
 189 \begin{code}
 190 doRevoltingInstDecls :: IntNameFun -> [ProtoNameInstDecl] -> [ProtoNameInstDecl]
 191
 192 doRevoltingInstDecls tc_nf decls
 193   = map revolt_me decls
 194   where
 195     revolt_me (InstDecl cname ty binds True modname uprags pragma src_loc)
 196       = InstDecl
 197             (tc_nf cname)               -- Look up the class
 198             (doIfacePolyType1 tc_nf ty) -- Ditto the type
 199             binds                       -- Binds unchanged
 200             True{-yes,defined in this module-}
 201             modname
 202             uprags
 203             pragma
 204             src_loc
 205 \end{code}
 206
 207 %************************************************************************
 208 %*                                                                      *
 209 \subsection{Process a module's imported interfaces}
 210 %*                                                                      *
 211 %************************************************************************
 212
 213 @doImportedIfaces@ processes the entire set of interfaces imported by the
 214 module being renamed.
 215
 216 \begin{code}
 217 doImportedIfaces :: PreludeNameMappers
 218               -> (FAST_STRING -> Bool)
 219               -> [ProtoNameImportedInterface]
 220               -> Rn12M AllIntDecls
 221
 222 doImportedIfaces pnfs is_mentioned_fn []
 223   = returnRn12 ( [{-fixities-}],  [{-tydecls-}], [{-clasdecls-}],
 224                  [{-instdecls-}], [{-sigs-}], emptyBag )
 225
 226 doImportedIfaces pnfs is_mentioned_fn (iface:ifaces)
 227   = doOneIface  pnfs is_mentioned_fn iface
 228                          `thenRn12` \ (ifixes1, itd1, icd1, iid1, isd1, names1) ->
 229
 230     doImportedIfaces pnfs is_mentioned_fn ifaces
 231                          `thenRn12` \ (ifixes2, itd2, icd2, iid2, isd2, names2) ->
 232
 233     returnRn12 (ifixes1 ++ ifixes2,
 234                 itd1 ++ itd2,
 235                 icd1 ++ icd2,
 236                 iid1 ++ iid2,
 237                 isd1 ++ isd2,
 238                 names1 `unionBags` names2)
 239 \end{code}
 240
 241 \begin{code}
 242 doOneIface :: PreludeNameMappers
 243            -> (FAST_STRING -> Bool)
 244            -> ProtoNameImportedInterface
 245            -> Rn12M AllIntDecls
 246
 247 doOneIface _ _ (ImportMod _ True{-qualified-} _ _)
 248   = panic "RnPass1.doOneIface:can't grok `qualified'"
 249
 250 doOneIface _ _ (ImportMod _ _ (Just _) _)
 251   = panic "RnPass1.doOneIface:can't grok `as' module (blech)"
 252
 253 doOneIface pnfs is_mentioned_fn (ImportMod iface qual asmod Nothing{-all-})
 254   = doIface1 pnfs (selectAll is_mentioned_fn) iface
 255
 256 doOneIface pnfs _ (ImportMod iface qual asmod (Just (False{-unhidden-}, ies)))
 257   = doIface1 pnfs si_fun iface
 258   where
 259     -- the `selective import' function should not be applied
 260     -- to the Imps that occur on Ids in unfoldings.
 261
 262     si_fun (Unk    n) = check_ie n ies
 263     si_fun (Qunk _ n) = check_ie n ies
 264
 265     check_ie name [] = NotWanted
 266     check_ie name (ie:ies)
 267       = case ie of
 268           IEVar (Unk n)      | name == n -> Wanted
 269           IEThingAbs (Unk n) | name == n -> WantedWith ie
 270           IEThingAll (Unk n) | name == n -> WantedWith ie
 271           IEModuleContents _ -> panic "Module.. in import list?"
 272           other              -> check_ie name ies
 273
 274 doOneIface pnfs _ (ImportMod iface qual asmod (Just (True{-hidden-}, ies)))
 275   = doIface1 pnfs si_fun iface
 276   where
 277     -- see comment above:
 278
 279     si_fun x | n `elementOf` entity_info = NotWanted
 280              | otherwise                 = Wanted
 281       where
 282         n = case x of { Unk s -> s; Qunk _ s -> s }
 283
 284     entity_info = getImportees ies
 285 \end{code}
 286
 287 @selectAll@ ``normally'' creates an @SelectiveImporter@ that declares
 288 everything from an interface to be @Wanted@.  We may, however, pass
 289 in a more discriminating @is_mentioned_fn@ (returns @True@ if the
 290 named entity is mentioned in the body of the module in question), which
 291 can be used to trim off junk from an interface.
 292
 293 For @selectAll@ to say something is @NotWanted@, it must be a
 294 variable, it must not be in the collected-up list of mentioned
 295 variables (checked with @is_mentioned_fn@), and it must be three chars
 296 or longer.
 297
 298 And, of course, we mustn't forget to take account of renaming!
 299
 300 ADR Question: What's so magical about names longer than 3 characters?
 301 Why would we want to keep long names which aren't mentioned when we're
 302 quite happy to throw away short names that aren't mentioned?
 303
 304 \begin{code}
 305 selectAll :: (FAST_STRING -> Bool) -> SelectiveImporter
 306
 307 selectAll is_mentioned_fn n
 308   = let
 309         rn_str = case n of { Unk s -> s ; Qunk _ s -> s }
 310     in
 311     if (isAvarid rn_str)
 312     && (not (is_mentioned_fn rn_str))
 313     && (_UNPK_ rn_str `lengthExceeds` 2)
 314     then NotWanted
 315     else Wanted
 316 \end{code}
 317
 318
 319 %************************************************************************
 320 %*                                                                      *
 321 \subsection{First pass over a particular interface}
 322 %*                                                                      *
 323 %************************************************************************
 324
 325
 326 @doIface1@ handles a specific interface. First it looks at the
 327 interface imports, creating a bag that maps local names back to their
 328 original names, from which it makes a function that does the same. It
 329 then uses this function to create a triple of bags for the interface
 330 type, class and value declarations, in which local names have been
 331 mapped back into original names.
 332
 333 Notice that @mkLocalNameFun@ makes two different functions. The first
 334 is the name function for the interface. This takes a local name and
 335 provides an original name for any name in the interface by using
 336 either of:
 337 \begin{itemize}
 338 \item
 339 the original name produced by the renaming function;
 340 \item
 341 the local name in the interface and the interface name.
 342 \end{itemize}
 343
 344 The function @doIfaceImports1@ receives two association lists which will
 345 be described at its definition.
 346
 347 \begin{code}
 348 doIface1 :: PreludeNameMappers
 349          -> SelectiveImporter
 350          -> ProtoNameInterface
 351          -> Rn12M AllIntDecls
 352
 353 doIface1 (v_pnf, tc_pnf) sifun
 354        (Interface i_name import_decls fix_decls ty_decls class_decls
 355                     inst_decls sig_decls anns)
 356
 357   = doIfaceImports1 (panic "i_name"{-i_name-}) import_decls     `thenRn12` \ (v_bag, tc_bag) ->
 358     do_body (v_bag, tc_bag)
 359   where
 360     do_body (v_bag, tc_bag)
 361       = report_all_errors                       `thenRn12` \ _ ->
 362
 363         doIfaceTyDecls1    sifun full_tc_nf ty_decls    `thenRn12` \ ty_decls' ->
 364
 365         doIfaceClassDecls1 sifun full_tc_nf class_decls  `thenRn12` \ class_decls' ->
 366
 367         let sig_decls'  = doIfaceSigs1      sifun v_nf tc_nf sig_decls
 368             fix_decls'  = doIfaceFixes1     sifun v_nf       fix_decls
 369             inst_decls' = doIfaceInstDecls1 sifun      tc_nf inst_decls
 370         in
 371         returnRn12 (fix_decls', ty_decls', class_decls', inst_decls', sig_decls', unitBag i_name)
 372       where
 373         v_dups  :: [[(FAST_STRING, ProtoName)]]
 374         tc_dups :: [[(FAST_STRING, (ProtoName, IntNameFun))]]
 375
 376         (imp_v_nf, v_dups)   = mkNameFun v_bag
 377         (imp_tc_nf, tc_dups) = mkNameFun tc_bag
 378
 379         v_nf :: IntNameFun
 380         v_nf (Unk s) = case v_pnf s of
 381                          Just n  -> mkPreludeProtoName n
 382                          Nothing -> case imp_v_nf s of
 383                                       Just n  -> n
 384                                       Nothing -> Imp i_name s [i_name] s
 385
 386                 -- used for (..)'d parts of prelude datatype/class decls
 387         prel_con_or_op_nf  :: FAST_STRING{-module name-}-> IntNameFun
 388         prel_con_or_op_nf m (Unk s)
 389           = case v_pnf s of
 390               Just n  -> mkPreludeProtoName n
 391               Nothing -> Imp m s [m] s
 392                          -- Strictly speaking, should be *no renaming* here, folks
 393
 394                 -- used for non-prelude constructors/ops/fields
 395         local_con_or_op_nf :: IntNameFun
 396         local_con_or_op_nf (Unk s) = Imp i_name s [i_name] s
 397
 398         full_tc_nf :: IntTCNameFun
 399         full_tc_nf (Unk s)
 400           = case tc_pnf s of
 401               Just n  -> (mkPreludeProtoName n,
 402                           let
 403                               mod = fst (getOrigName n)
 404                           in
 405                           prel_con_or_op_nf mod)
 406
 407               Nothing -> case imp_tc_nf s of
 408                           Just pair -> pair
 409                           Nothing   -> (Imp i_name s [i_name] s,
 410                                         local_con_or_op_nf)
 411
 412         tc_nf = fst . full_tc_nf
 413
 414         -- ADR: commented out next new lines because I don't believe
 415         -- ADR: the check is useful or required by the Standard. (It
 416         -- ADR: also messes up the interpreter.)
 417
 418         tc_errs = [] -- map (map (fst . snd)) tc_dups
 419                   -- Ugh! Just keep the dup'd protonames
 420         v_errs  = [] -- map (map snd) v_dups
 421                   -- Ditto
 422
 423         report_all_errors
 424           = mapRn12 (addErrRn12 . duplicateImportsInInterfaceErr (_UNPK_ i_name))
 425                     (tc_errs ++ v_errs)
 426 \end{code}
 427
 428
 429 %************************************************************************
 430 %*                                                                      *
 431 \subsection{doIfaceImports1}
 432 %*                                                                      *
 433 %************************************************************************
 434
 435 @ImportNameBags@ is a pair of bags (one for values, one for types and
 436 classes) which specify the new names brought into scope by some
 437 import declarations in an interface.
 438
 439 \begin{code}
 440 type ImportNameBags = (Bag (FAST_STRING, ProtoName),
 441                        Bag (FAST_STRING, (ProtoName, IntNameFun))
 442                       )
 443 \end{code}
 444
 445 \begin{code}
 446 doIfaceImports1
 447         :: FAST_STRING                  -- name of module whose interface we're doing
 448         -> [IfaceImportDecl ProtoName]
 449         -> Rn12M ImportNameBags
 450
 451 doIfaceImports1 _  [] = returnRn12 (emptyBag, emptyBag)
 452
 453 doIfaceImports1 int_mod_name (imp_decl1 : rest)
 454   = do_decl                      imp_decl1  `thenRn12` \ (vb1, tcb1) ->
 455     doIfaceImports1 int_mod_name rest       `thenRn12` \ (vb2, tcb2) ->
 456     returnRn12 (vb1 `unionBags` vb2, tcb1 `unionBags` tcb2)
 457   where
 458     do_decl (IfaceImportDecl orig_mod_name imports src_loc)
 459       =         -- Look at the renamings to get a suitable renaming function
 460         doRenamings{-not really-} int_mod_name orig_mod_name
 461                                     `thenRn12` \ (orig_to_pn, local_to_pn) ->
 462
 463             -- Now deal with one import at a time, combining results.
 464         returnRn12 (
 465           foldl (doIfaceImport1 orig_to_pn local_to_pn)
 466                 (emptyBag, emptyBag)
 467                 imports
 468         )
 469 \end{code}
 470
 471 @doIfaceImport1@ takes a list of imports and the pair of renaming functions,
 472 returning a bag which maps local names to original names.
 473
 474 \begin{code}
 475 doIfaceImport1 :: ( ProtoName       -- Original local name
 476                  -> (FAST_STRING,   -- Local name in this interface
 477                      ProtoName)     -- Its full protoname
 478                 )
 479
 480              -> IntNameFun          -- Local name to ProtoName; use for
 481                                     --   constructors and class ops
 482
 483              -> ImportNameBags      -- Accumulator
 484              -> (IE ProtoName)      -- An item in the import list
 485              -> ImportNameBags
 486
 487 doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) (IEVar orig_name)
 488   = (v_bag `snocBag` (orig_to_pn orig_name), tc_bag)
 489
 490 doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAbs orig_name)
 491   = int_import1_help orig_to_pn local_to_pn acc orig_name
 492
 493 doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAll orig_name)
 494   = int_import1_help orig_to_pn local_to_pn acc orig_name
 495
 496 -- the next ones will go away with 1.3:
 497 {- OLD:
 498 doIfaceImport1 orig_to_pn local_to_pn acc (IEConWithCons orig_name _)
 499   = int_import1_help orig_to_pn local_to_pn acc orig_name
 500
 501 doIfaceImport1 orig_to_pn local_to_pn acc (IEClsWithOps orig_name _)
 502   = int_import1_help orig_to_pn local_to_pn acc orig_name
 503 -}
 504
 505 doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) other
 506   = panic "RnPass1: strange import decl"
 507
 508 -- Little help guy...
 509
 510 int_import1_help orig_to_pn local_to_pn (v_bag, tc_bag) orig_name
 511   = case (orig_to_pn orig_name) of { (str, o_name) ->
 512     (v_bag, tc_bag `snocBag` (str, (o_name, local_to_pn)))
 513     }
 514 \end{code}
 515
 516
 517 The renaming-processing code.  It returns two name-functions. The
 518 first maps the {\em original} name for an entity onto a @ProtoName@
 519 --- it is used when running over the list of things to be imported.
 520 The second maps the {\em local} name for a constructor or class op
 521 back to its original name --- it is used when scanning the RHS of
 522 a @data@ or @class@ decl.
 523
 524 It can produce errors, if there is a domain clash on the renamings.
 525
 526 \begin{code}
 527 doRenamings :: FAST_STRING      -- Name of the module whose interface we're working on
 528             -> FAST_STRING      -- Original-name module for these renamings
 529             -> Rn12M
 530                 ((ProtoName          -- Original local name to...
 531                     -> (FAST_STRING, -- ... Local name in this interface
 532                         ProtoName)   -- ... Its full protoname
 533                  ),
 534                  IntNameFun)         -- Use for constructors, class ops
 535
 536 doRenamings int_mod orig_mod
 537   = returnRn12 (
 538       \ (Unk s) ->
 539         let
 540             result = (s, Imp orig_mod s [int_mod] s)
 541         in
 542         result
 543         ,
 544
 545       \ (Unk s) ->
 546         let
 547             result = Imp orig_mod s [int_mod] s
 548         in
 549         result
 550     )
 551 \end{code}
 552
 553 %************************************************************************
 554 %*                                                                      *
 555 \subsection{Type declarations}
 556 %*                                                                      *
 557 %************************************************************************
 558
 559 @doIfaceTyDecls1@ uses the `name function' to map local tycon names into
 560 original names, calling @doConDecls1@ to do the same for the
 561 constructors. @doTyDecls1@ is used to do both module and interface
 562 type declarations.
 563
 564 \begin{code}
 565 doIfaceTyDecls1 :: SelectiveImporter
 566               -> IntTCNameFun
 567               -> [ProtoNameTyDecl]
 568               -> Rn12M [ProtoNameTyDecl]
 569
 570 doIfaceTyDecls1 sifun full_tc_nf ty_decls
 571   = mapRn12 do_decl ty_decls `thenRn12` \ decls_maybe ->
 572     returnRn12 (catMaybes decls_maybe)
 573   where
 574     do_decl (TySynonym tycon tyvars monoty src_loc)
 575       = let
 576             full_thing = returnRn12 (Just ty_decl')
 577         in
 578         case (sifun tycon) of
 579           NotWanted                 -> returnRn12 Nothing
 580           Wanted                    -> full_thing
 581           WantedWith (IEThingAll _) -> full_thing
 582
 583           WantedWith weird_ie       -> full_thing
 584       where
 585         (tycon_name,_) = full_tc_nf tycon
 586         tc_nf   = fst . full_tc_nf
 587         monoty' = doIfaceMonoType1 tc_nf monoty
 588         ty_decl' = TySynonym tycon_name tyvars monoty' src_loc
 589
 590     do_decl (TyData context tycon tyvars condecls derivs pragmas src_loc)
 591       = do_data context tycon condecls derivs pragmas src_loc `thenRn12` \ done_data ->
 592         case done_data of
 593           Nothing -> returnRn12 Nothing
 594           Just (context', tycon', condecls', derivs', pragmas') ->
 595              returnRn12 (Just (TyData context' tycon' tyvars condecls' derivs' pragmas' src_loc))
 596
 597     do_decl (TyNew context tycon tyvars condecl derivs pragmas src_loc)
 598       = do_data context tycon condecl derivs pragmas src_loc `thenRn12` \ done_data ->
 599         case done_data of
 600           Nothing -> returnRn12 Nothing
 601           Just (context', tycon', condecl', derivs', pragmas') ->
 602              returnRn12 (Just (TyNew context' tycon' tyvars condecl' derivs' pragmas' src_loc))
 603
 604     --------------------------------------------
 605     do_data context tycon condecls derivs (DataPragmas hidden_cons specs) src_loc
 606       = let
 607             full_thing = Just (context', tycon_name, condecls', deriv', (pragmas' False))
 608             abs_thing  = Just (context', tycon_name, [],        deriv', (pragmas' True))
 609         in
 610         case (sifun tycon) of
 611           NotWanted                     -> returnRn12 Nothing
 612           Wanted                        -> returnRn12 full_thing
 613           WantedWith (IEThingAll _)     -> returnRn12 full_thing
 614           WantedWith (IEThingAbs _)     -> returnRn12 abs_thing
 615
 616           WantedWith really_weird_ie -> -- probably a typo in the pgm
 617             addErrRn12 (weirdImportExportConstraintErr
 618                         tycon really_weird_ie src_loc) `thenRn12` \ _ ->
 619             returnRn12 full_thing
 620       where
 621         (tycon_name, constrfield_nf) = full_tc_nf tycon
 622         tc_nf                        = fst . full_tc_nf
 623
 624         condecls'    = map (do_condecl constrfield_nf tc_nf) condecls
 625         hidden_cons' = map (do_condecl constrfield_nf tc_nf) hidden_cons
 626
 627         pragmas' invent_hidden
 628           = DataPragmas (if null hidden_cons && invent_hidden
 629                          then condecls'  -- if importing abstractly but condecls were
 630                                          -- exported we add them to the data pragma
 631                          else hidden_cons')
 632                         specs {- ToDo: do_specs -}
 633
 634         context'    = doIfaceContext1 tc_nf context
 635         deriv'      = case derivs of
 636                         Nothing -> Nothing
 637                         Just ds -> panic "doIfaceTyDecls1:derivs" -- Just (map tc_nf ds)
 638                                                                   -- rename derived classes
 639
 640     --------------------------------------------
 641     -- one name fun for the data constructor, another for the type:
 642
 643     do_condecl cf_nf tc_nf (ConDecl name tys src_loc)
 644       = ConDecl (cf_nf name) (map (do_bang tc_nf) tys) src_loc
 645
 646     do_condecl cf_nf tc_nf (ConOpDecl ty1 op ty2 src_loc)
 647       = ConOpDecl (do_bang tc_nf ty1) (cf_nf op) (do_bang tc_nf ty2) src_loc
 648
 649     do_condecl cf_nf tc_nf (NewConDecl name ty src_loc)
 650       = NewConDecl (cf_nf name) (doIfaceMonoType1 tc_nf ty) src_loc
 651
 652     do_condecl cf_nf tc_nf (RecConDecl con fields src_loc)
 653       = RecConDecl (cf_nf con) (map do_field fields) src_loc
 654       where
 655         do_field (var, ty) = (cf_nf var, do_bang tc_nf ty)
 656
 657     --------------------------------------------
 658     do_bang tc_nf (Banged   ty) = Banged   (doIfaceMonoType1 tc_nf ty)
 659     do_bang tc_nf (Unbanged ty) = Unbanged (doIfaceMonoType1 tc_nf ty)
 660 \end{code}
 661
 662 %************************************************************************
 663 %*                                                                      *
 664 \subsection{Class declarations}
 665 %*                                                                      *
 666 %************************************************************************
 667
 668 @doIfaceClassDecls1@ uses the `name function' to map local class names into
 669 original names, calling @doIfaceClassOp1@ to do the same for the
 670 class operations. @doClassDecls1@ is used to process both module and
 671 interface class declarations.
 672
 673 \begin{code}
 674 doIfaceClassDecls1 ::  SelectiveImporter
 675                  -> IntTCNameFun
 676                  -> [ProtoNameClassDecl]
 677                  -> Rn12M [ProtoNameClassDecl]
 678
 679 doIfaceClassDecls1 sifun full_tc_nf clas_decls
 680   = mapRn12 do_decl clas_decls `thenRn12` \ decls_maybe ->
 681     returnRn12 (catMaybes decls_maybe)
 682   where
 683     do_decl (ClassDecl ctxt cname tyvar sigs bs@EmptyMonoBinds prags locn)
 684                                      -- No defaults in interface
 685       = let
 686             full_thing = returnRn12 (Just class_decl')
 687         in
 688         case (sifun cname) of
 689           NotWanted                     -> returnRn12 Nothing
 690           Wanted                        -> full_thing
 691           WantedWith (IEThingAll _)     -> full_thing
 692           -- ToDo: add checking of IEClassWithOps
 693           WantedWith really_weird_ie    -> -- probably a typo in the pgm
 694             addErrRn12 (weirdImportExportConstraintErr
 695                         cname really_weird_ie locn) `thenRn12` \ _ ->
 696             full_thing
 697       where
 698         (clas, op_nf) = full_tc_nf cname
 699         tc_nf = fst . full_tc_nf
 700
 701         sigs' = map (doIfaceClassOp1 op_nf tc_nf) sigs
 702         ctxt' = doIfaceContext1 tc_nf ctxt
 703
 704         class_decl'     = ClassDecl ctxt' clas tyvar sigs' bs prags locn
 705         abs_class_decl' = ClassDecl ctxt' clas tyvar []    bs prags locn
 706 \end{code}
 707
 708 \begin{code}
 709 doIfaceClassOp1 :: IntNameFun   -- Use this for the class ops
 710               -> IntNameFun     -- Use this for the types
 711               -> ProtoNameClassOpSig
 712               -> ProtoNameClassOpSig
 713
 714 doIfaceClassOp1 op_nf tc_nf (ClassOpSig v ty pragma src_loc)
 715   = ClassOpSig (op_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc
 716 \end{code}
 717
 718 %************************************************************************
 719 %*                                                                      *
 720 \subsection{Instance declarations}
 721 %*                                                                      *
 722 %************************************************************************
 723
 724 We select the instance decl if either the class or the type constructor
 725 are selected.
 726
 727 \begin{code}
 728 doIfaceInstDecls1 :: SelectiveImporter
 729                 -> IntNameFun
 730                 -> [ProtoNameInstDecl]
 731                 -> [ProtoNameInstDecl]
 732
 733 doIfaceInstDecls1 si tc_nf inst_decls
 734   = catMaybes (map do_decl inst_decls)
 735   where
 736     do_decl (InstDecl cname ty EmptyMonoBinds False modname uprags pragmas src_loc)
 737       = case (si cname, tycon_reqd) of
 738           (NotWanted, NotWanted) -> Nothing
 739           _                      -> Just inst_decl'
 740      where
 741        ty'      = doIfacePolyType1 tc_nf ty
 742
 743        inst_decl' = InstDecl (tc_nf cname) ty' EmptyMonoBinds False modname uprags pragmas src_loc
 744
 745        tycon_reqd = _trace "RnPass1.tycon_reqd" NotWanted
 746 {- LATER:
 747          = case getNonPrelOuterTyCon ty of
 748              Nothing -> NotWanted    -- Type doesn't have a user-defined tycon
 749                                      -- at its outermost level
 750              Just tycon -> si tycon  -- It does, so look up in the si-fun
 751 -}
 752 \end{code}
 753
 754 %************************************************************************
 755 %*                                                                      *
 756 \subsection{Signature declarations}
 757 %*                                                                      *
 758 %************************************************************************
 759
 760 @doIfaceSigs1@ uses the name function to create a bag that
 761 maps local names into original names.
 762
 763 NB: Can't have user-pragmas & other weird things in interfaces.
 764
 765 \begin{code}
 766 doIfaceSigs1 :: SelectiveImporter -> IntNameFun -> IntNameFun
 767            -> [ProtoNameSig]
 768            -> [ProtoNameSig]
 769
 770 doIfaceSigs1 si v_nf tc_nf sigs
 771   = catMaybes (map do_sig sigs)
 772   where
 773     do_sig (Sig v ty pragma src_loc)
 774       = case (si v) of
 775           NotWanted -> Nothing
 776           Wanted    -> Just (Sig (v_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc)
 777           -- WantedWith doesn't make sense
 778 \end{code}
 779
 780
 781 %************************************************************************
 782 %*                                                                      *
 783 \subsection{Fixity declarations}
 784 %*                                                                      *
 785 %************************************************************************
 786
 787 \begin{code}
 788 doIfaceFixes1 :: SelectiveImporter -> IntNameFun
 789             -> [ProtoNameFixityDecl]
 790             -> [ProtoNameFixityDecl]
 791
 792 doIfaceFixes1 si vnf fixities
 793   = catMaybes (map do_fixity fixities)
 794   where
 795     do_fixity (InfixL name i) = do_one InfixL name i
 796     do_fixity (InfixR name i) = do_one InfixR name i
 797     do_fixity (InfixN name i) = do_one InfixN name i
 798
 799     do_one con name i
 800       = case si name of
 801           Wanted    -> Just (con (vnf name) i)
 802           NotWanted -> Nothing
 803 \end{code}
 804
 805
 806 %************************************************************************
 807 %*                                                                      *
 808 \subsection{doContext, MonoTypes, MonoType, Polytype}
 809 %*                                                                      *
 810 %************************************************************************
 811
 812 \begin{code}
 813 doIfacePolyType1 :: IntNameFun -> ProtoNamePolyType -> ProtoNamePolyType
 814
 815 doIfacePolyType1 tc_nf (HsPreForAllTy ctxt ty)
 816   = HsPreForAllTy (doIfaceContext1 tc_nf ctxt) (doIfaceMonoType1 tc_nf ty)
 817
 818 doIfacePolyType1 tc_nf (HsForAllTy tvs ctxt ty)
 819   = HsForAllTy tvs (doIfaceContext1 tc_nf ctxt) (doIfaceMonoType1 tc_nf ty)
 820 \end{code}
 821
 822 \begin{code}
 823 doIfaceContext1 :: IntNameFun -> ProtoNameContext -> ProtoNameContext
 824 doIfaceContext1 tc_nf  context = [(tc_nf clas, tyvar) | (clas,tyvar) <- context]
 825 \end{code}
 826
 827
 828 \begin{code}
 829 doIfaceMonoType1 :: IntNameFun -> ProtoNameMonoType -> ProtoNameMonoType
 830
 831 doIfaceMonoType1 tc_nf tv@(MonoTyVar _) = tv
 832
 833 doIfaceMonoType1 tc_nf (MonoListTy ty)
 834   = MonoListTy (doIfaceMonoType1 tc_nf ty)
 835
 836 doIfaceMonoType1 tc_nf (MonoFunTy ty1 ty2)
 837   = MonoFunTy (doIfaceMonoType1 tc_nf ty1) (doIfaceMonoType1 tc_nf ty2)
 838
 839 doIfaceMonoType1 tc_nf (MonoTupleTy tys)
 840   = MonoTupleTy (map (doIfaceMonoType1 tc_nf) tys)
 841
 842 doIfaceMonoType1 tc_nf (MonoTyApp name tys)
 843   = MonoTyApp (tc_nf name) (map (doIfaceMonoType1 tc_nf) tys)
 844 \end{code}
 845
 846 %************************************************************************
 847 %*                                                                      *
 848 \subsection{Error messages}
 849 %*                                                                      *
 850 %************************************************************************
 851
 852 \begin{code}
 853 duplicateImportsInInterfaceErr iface dups
 854   = panic "duplicateImportsInInterfaceErr: NOT DONE YET?"
 855
 856 weirdImportExportConstraintErr thing constraint locn
 857   = addShortErrLocLine locn ( \ sty ->
 858     ppBesides [ppStr "Illegal import/export constraint on `",
 859                ppr sty thing,
 860                ppStr "': ", ppr PprForUser constraint])
 861 \end{code}