2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[Rename1]{@Rename1@: gather up imported information}
6 See the @Rename@ module for a basic description of the renamer.
9 #include "HsVersions.h"
15 Module, Bag, ProtoNamePat(..), InPat, Maybe,
16 PprStyle, Pretty(..), PrettyRep, ProtoName, Name,
17 PreludeNameFun(..), PreludeNameFuns(..)
20 IMPORT_Trace -- ToDo: rm
21 import Pretty -- these two too
25 import AbsSynFuns ( getMentionedVars ) -- *** not via AbsSyn ***
26 import Bag ( Bag, emptyBag, unitBag, snocBag, unionBags, bagToList )
30 import Maybes ( maybeToBool, catMaybes, Maybe(..) )
31 --OLD: import NameEnv ( mkStringLookupFn )
32 import ProtoName ( ProtoName(..), mkPreludeProtoName )
39 %************************************************************************
41 \subsection{Types and things used herein}
43 %************************************************************************
45 @AllIntDecls@ is the type returned from processing import statement(s)
49 type AllIntDecls = ([ProtoNameFixityDecl], [ProtoNameTyDecl],
50 [ProtoNameClassDecl], [ProtoNameInstDecl],
51 [ProtoNameSig], Bag FAST_STRING)
54 The selective-import function @SelectiveImporter@ maps a @ProtoName@
55 to something which indicates how much of the thing, if anything, is
56 wanted by the importing module.
58 type SelectiveImporter = ProtoName -> Wantedness
66 The @ProtoNames@ supplied to these ``name functions'' are always
67 @Unks@, unless they are fully-qualified names, which occur only in
68 interface pragmas (and, therefore, never on the {\em definitions} of
69 things). That doesn't happen in @Rename1@!
71 type IntNameFun = ProtoName -> ProtoName
72 type IntTCNameFun = ProtoName -> (ProtoName, IntNameFun)
75 %************************************************************************
77 \subsection{First pass over the entire module}
79 %************************************************************************
81 This pass flattens out the declarations embedded within the interfaces
82 which this module imports. The result is a new module with no
83 imports, but with more declarations. The declarations which arose
84 from the imported interfaces will have @ProtoNames@ with @Imp@
85 constructors; the declarations in the body of this module are
86 unaffected, so they will still be @Unk@'s.
88 We import only the declarations from interfaces which are actually {\em
89 used}. This saves time later, because we don't need process the
93 rnModule1 :: PreludeNameFuns
94 -> Bool -- see use below
96 -> Rn12M (ProtoNameModule, [FAST_STRING])
98 rnModule1 pnf@(v_pnf, tc_pnf)
99 use_mentioned_vars_heuristic
100 (Module mod_name exports imports fixes
101 ty_decls absty_sigs class_decls inst_decls specinst_sigs
102 defaults binds _ src_loc)
104 = -- slurp through the *body* of the module, collecting names of
105 -- mentioned *variables*, 3+ letters long & not prelude names.
106 -- Note: we *do* have to pick up top-level binders,
107 -- so we can check for conflicts with imported guys!
110 (uses_Mdotdot_in_exports, mentioned_vars)
111 = getMentionedVars v_pnf exports fixes class_decls inst_decls binds
113 -- Using the collected "mentioned" variables, create an
114 -- "is-mentioned" function (:: FAST_STRING -> Bool), which gives
115 -- True if something is mentioned is in the list collected.
116 -- For more details, see under @selectAll@, notably the
117 -- handling of short (< 3 chars) names.
119 -- Note: this "is_mentioned" game doesn't work if the export
120 -- list includes any M.. constructs (because that mentions
121 -- variables *implicitly*, basically). getMentionedVars tells
122 -- us this, and we act accordingly.
125 = lookupFM {-OLD: mkStringLookupFn-} (listToFM
126 [ (x, panic "is_mentioned_fn")
127 | x <- mentioned_vars ++ needed_for_deriving ]
129 -- OLD: False{-not-sorted-}
131 needed_for_deriving -- is this a HACK or what?
144 = if use_mentioned_vars_heuristic
145 && not (uses_Mdotdot_in_exports)
146 then \ x -> maybeToBool (is_mentioned_maybe x)
149 --O:M is_mentioned_fn = \ x -> True -- ToDo: delete altogether
151 -- OK, now do the business:
152 doImportedIfaces pnf is_mentioned_fn imports
153 `thenRn12` \ (int_fixes, int_ty_decls,
154 int_class_decls, int_inst_decls,
155 int_sigs, import_names) ->
157 inst_decls' = doRevoltingInstDecls tc_nf inst_decls
161 exports imports -- passed along mostly for later checking
163 (int_ty_decls ++ ty_decls)
165 (int_class_decls ++ class_decls)
166 (int_inst_decls ++ inst_decls')
172 bagToList import_names)
174 -- This function just spots prelude names
175 tc_nf pname@(Unk s) = case (tc_pnf s) of
177 Just name -> Prel name
179 tc_nf other_pname = panic "In tc_nf passed to doRevoltingInstDecls"
180 -- The only place where Imps occur is on Ids in unfoldings;
181 -- this function is only used on type-things.
184 Instance declarations in the module itself are treated in a horribly
185 special way. Because their class name and type constructor will be
186 compared against imported ones in the second pass (to eliminate
187 duplicate instance decls) we need to make Prelude classes and tycons
188 appear as such. (For class and type decls, the module can't be
189 declaring a prelude class or tycon, so Prel and Unk things can just
190 compare non-equal.) This is a HACK.
193 doRevoltingInstDecls :: IntNameFun -> [ProtoNameInstDecl] -> [ProtoNameInstDecl]
195 doRevoltingInstDecls tc_nf decls
196 = map revolt_me decls
198 revolt_me (InstDecl context cname ty binds True modname imod uprags pragma src_loc)
200 context -- Context unchanged
201 (tc_nf cname) -- Look up the class
202 (doIfaceMonoType1 tc_nf ty) -- Ditto the type
203 binds -- Binds unchanged
212 %************************************************************************
214 \subsection{Process a module's imported interfaces}
216 %************************************************************************
218 @doImportedIfaces@ processes the entire set of interfaces imported by the
219 module being renamed.
222 doImportedIfaces :: PreludeNameFuns
223 -> (FAST_STRING -> Bool)
224 -> [ProtoNameImportedInterface]
227 doImportedIfaces pnfs is_mentioned_fn []
228 = returnRn12 ( [{-fixities-}], [{-tydecls-}], [{-clasdecls-}],
229 [{-instdecls-}], [{-sigs-}], emptyBag )
231 doImportedIfaces pnfs is_mentioned_fn (iface:ifaces)
232 = doOneIface pnfs is_mentioned_fn iface
233 `thenRn12` \ (ifixes1, itd1, icd1, iid1, isd1, names1) ->
235 doImportedIfaces pnfs is_mentioned_fn ifaces
236 `thenRn12` \ (ifixes2, itd2, icd2, iid2, isd2, names2) ->
238 returnRn12 (ifixes1 ++ ifixes2,
243 names1 `unionBags` names2)
247 doOneIface pnfs is_mentioned_fn (ImportAll int renamings)
249 renaming_fn = mkRenamingFun renamings
250 -- if there are any renamings, then we don't use
251 -- the "is_mentioned_fn" hack; possibly dangerous (paranoia reigns)
252 revised_is_mentioned_fn
255 else (\ x -> True) -- pretend everything is mentioned
257 -- pprTrace "ImportAll:mod_rns:" (ppr PprDebug renamings) (
258 doIface1 renaming_fn pnfs (selectAll renaming_fn revised_is_mentioned_fn) int
261 doOneIface pnfs unused_is_mentioned_fn (ImportSome int ie_list renamings)
262 = --pprTrace "ImportSome:mod_rns:" (ppr PprDebug renamings) (
263 doIface1 (mkRenamingFun renamings) pnfs si_fun int
266 -- the `selective import' function should not be applied
267 -- to the Imps that occur on Ids in unfoldings.
269 si_fun (Unk str) = check_ie str ie_list
270 si_fun other = panic "si_fun in doOneIface"
272 check_ie name [] = NotWanted
273 check_ie name (ie:ies)
275 IEVar n | name == n -> Wanted
276 IEThingAbs n | name == n -> WantedWith ie
277 IEThingAll n | name == n -> WantedWith ie
278 IEConWithCons n ns | name == n -> WantedWith ie
279 IEClsWithOps n ns | name == n -> WantedWith ie
280 IEModuleContents _ -> panic "Module.. in import list?"
281 other -> check_ie name ies
283 doOneIface pnfs unused_is_mentioned_fn (ImportButHide int ie_list renamings)
284 = --pprTrace "ImportButHide:mod_rns:" (ppr PprDebug renamings) (
285 doIface1 (mkRenamingFun renamings) pnfs si_fun int
288 -- see comment above:
290 si_fun (Unk str) | str `elemFM` entity_info = NotWanted
293 entity_info = fst (getIEStrings ie_list)
296 @selectAll@ ``normally'' creates an @SelectiveImporter@ that declares
297 everything from an interface to be @Wanted@. We may, however, pass
298 in a more discriminating @is_mentioned_fn@ (returns @True@ if the
299 named entity is mentioned in the body of the module in question), which
300 can be used to trim off junk from an interface.
302 For @selectAll@ to say something is @NotWanted@, it must be a
303 variable, it must not be in the collected-up list of mentioned
304 variables (checked with @is_mentioned_fn@), and it must be three chars
307 And, of course, we mustn't forget to take account of renaming!
309 ADR Question: What's so magical about names longer than 3 characters?
310 Why would we want to keep long names which aren't mentioned when we're
311 quite happy to throw away short names that aren't mentioned?
314 selectAll :: (FAST_STRING -> FAST_STRING) -> (FAST_STRING -> Bool) -> SelectiveImporter
316 selectAll renaming_fn is_mentioned_fn (Unk str) -- gotta be an Unk
318 rn_str = renaming_fn str
321 && (not (is_mentioned_fn rn_str))
322 && (_UNPK_ rn_str `lengthExceeds` 2)
328 %************************************************************************
330 \subsection{First pass over a particular interface}
332 %************************************************************************
335 @doIface1@ handles a specific interface. First it looks at the
336 interface imports, creating a bag that maps local names back to their
337 original names, from which it makes a function that does the same. It
338 then uses this function to create a triple of bags for the interface
339 type, class and value declarations, in which local names have been
340 mapped back into original names.
342 Notice that @mkLocalNameFun@ makes two different functions. The first
343 is the name function for the interface. This takes a local name and
344 provides an original name for any name in the interface by using
348 the original name produced by the renaming function;
350 the local name in the interface and the interface name.
353 The function @doIfaceImports1@ receives two association lists which will
354 be described at its definition.
357 doIface1 :: (FAST_STRING -> FAST_STRING) -- Renamings in import stmt of module
360 -> ProtoNameInterface
363 doIface1 mod_rn_fn (v_pnf, tc_pnf) sifun
364 (MkInterface i_name import_decls fix_decls ty_decls class_decls
365 inst_decls sig_decls anns)
367 = doIfaceImports1 mod_rn_fn i_name import_decls `thenRn12` \ (v_bag, tc_bag) ->
368 do_body (v_bag, tc_bag)
370 do_body (v_bag, tc_bag)
371 = report_all_errors `thenRn12` \ _ ->
373 doIfaceTyDecls1 sifun full_tc_nf ty_decls `thenRn12` \ ty_decls' ->
375 doIfaceClassDecls1 sifun full_tc_nf class_decls `thenRn12` \ class_decls' ->
377 let sig_decls' = doIfaceSigs1 sifun v_nf tc_nf sig_decls
378 fix_decls' = doIfaceFixes1 sifun v_nf fix_decls
379 inst_decls' = doIfaceInstDecls1 sifun tc_nf inst_decls
381 returnRn12 (fix_decls', ty_decls', class_decls', inst_decls', sig_decls', unitBag i_name)
383 v_dups :: [[(FAST_STRING, ProtoName)]]
384 tc_dups :: [[(FAST_STRING, (ProtoName, IntNameFun))]]
386 (imp_v_nf, v_dups) = mkNameFun {-OLD:v_pnf-} v_bag
387 (imp_tc_nf, tc_dups) = mkNameFun {-OLD:tc_pnf-} tc_bag
390 v_nf (Unk s) = case v_pnf s of
391 Just n -> mkPreludeProtoName n
392 Nothing -> case imp_v_nf s of
394 Nothing -> Imp i_name s [i_name] (mod_rn_fn s)
396 prel_con_or_op_nf :: FAST_STRING{-module name-}-> IntNameFun
397 -- Used for (..)'d parts of prelude datatype/class decls;
398 -- OLD:? For `data' types, we happen to know everything;
399 -- OLD:? For class decls, we *don't* know what the class-ops are.
400 prel_con_or_op_nf m (Unk s)
402 Just n -> mkPreludeProtoName n
403 Nothing -> Imp m s [m] (mod_rn_fn s)
404 -- Strictly speaking, should be *no renaming* here, folks
406 local_con_or_op_nf :: IntNameFun
407 -- used for non-prelude constructors/ops
408 local_con_or_op_nf (Unk s) = Imp i_name s [i_name] (mod_rn_fn s)
410 full_tc_nf :: IntTCNameFun
413 Just n -> (mkPreludeProtoName n,
415 mod = fst (getOrigName n)
417 prel_con_or_op_nf mod)
419 Nothing -> case imp_tc_nf s of
421 Nothing -> (Imp i_name s [i_name] (mod_rn_fn s),
424 tc_nf = fst . full_tc_nf
426 -- ADR: commented out next new lines because I don't believe
427 -- ADR: the check is useful or required by the Standard. (It
428 -- ADR: also messes up the interpreter.)
430 tc_errs = [] -- map (map (fst . snd)) tc_dups
431 -- Ugh! Just keep the dup'd protonames
432 v_errs = [] -- map (map snd) v_dups
436 = mapRn12 (addErrRn12 . duplicateImportsInInterfaceErr (_UNPK_ i_name))
441 %************************************************************************
443 \subsection{doIfaceImports1}
445 %************************************************************************
447 @ImportNameBags@ is a pair of bags (one for values, one for types and
448 classes) which specify the new names brought into scope by some
449 import declarations in an interface.
452 type ImportNameBags = (Bag (FAST_STRING, ProtoName),
453 Bag (FAST_STRING, (ProtoName, IntNameFun))
459 :: (FAST_STRING -> FAST_STRING) -- Renamings in import stmt of module
460 -> FAST_STRING -- name of module whose interface we're doing
462 -> Rn12M ImportNameBags
464 doIfaceImports1 _ _ [] = returnRn12 (emptyBag, emptyBag)
466 doIfaceImports1 mod_rn_fn int_mod_name (imp_decl1 : rest)
467 = do_decl imp_decl1 `thenRn12` \ (vb1, tcb1) ->
468 doIfaceImports1 mod_rn_fn int_mod_name rest `thenRn12` \ (vb2, tcb2) ->
469 -- pprTrace "vbags/tcbags:" (ppr PprDebug (vb1 `unionBags` vb2, [(s,p) | (s,(p,_)) <- bagToList (tcb1 `unionBags` tcb2)])) (
470 returnRn12 (vb1 `unionBags` vb2, tcb1 `unionBags` tcb2)
473 do_decl (IfaceImportDecl orig_mod_name imports renamings src_loc)
474 = -- Look at the renamings to get a suitable renaming function
475 doRenamings mod_rn_fn int_mod_name orig_mod_name renamings
476 `thenRn12` \ (orig_to_pn, local_to_pn) ->
478 -- Now deal with one import at a time, combining results.
480 foldl (doIfaceImport1 orig_to_pn local_to_pn)
486 @doIfaceImport1@ takes a list of imports and the pair of renaming functions,
487 returning a bag which maps local names to original names.
490 doIfaceImport1 :: ( FAST_STRING -- Original local name
491 -> (FAST_STRING, -- Local name in this interface
492 ProtoName) -- Its full protoname
495 -> IntNameFun -- Local name to ProtoName; use for
496 -- constructors and class ops
498 -> ImportNameBags -- Accumulator
499 -> IE -- An item in the import list
502 doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) (IEVar orig_name)
503 = (v_bag `snocBag` (orig_to_pn orig_name), tc_bag)
505 doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAbs orig_name)
506 = int_import1_help orig_to_pn local_to_pn acc orig_name
508 doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAll orig_name)
509 = int_import1_help orig_to_pn local_to_pn acc orig_name
511 doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) other
512 = panic "Rename1: strange import decl"
514 -- Little help guy...
516 int_import1_help orig_to_pn local_to_pn (v_bag, tc_bag) orig_name
517 = case (orig_to_pn orig_name) of { (str, o_name) ->
518 (v_bag, tc_bag `snocBag` (str, (o_name, local_to_pn)))
523 The renaming-processing code. It returns two name-functions. The
524 first maps the {\em original} name for an entity onto a @ProtoName@
525 --- it is used when running over the list of things to be imported.
526 The second maps the {\em local} name for a constructor or class op
527 back to its original name --- it is used when scanning the RHS of
528 a @data@ or @class@ decl.
530 It can produce errors, if there is a domain clash on the renamings.
534 --instance Outputable _PackedString where
535 -- ppr sty s = ppStr (_UNPK_ s)
537 doRenamings :: (FAST_STRING -> FAST_STRING) -- Renamings in import stmt of module
538 -> FAST_STRING -- Name of the module whose interface we're working on
539 -> FAST_STRING -- Original-name module for these renamings
540 -> [Renaming] -- Renamings
542 ((FAST_STRING -- Original local name to...
543 -> (FAST_STRING, -- ... Local name in this interface
544 ProtoName) -- ... Its full protoname
546 IntNameFun) -- Use for constructors, class ops
548 doRenamings mod_rn_fn int_mod orig_mod []
552 result = (s, Imp orig_mod s [int_mod] (mod_rn_fn s))
554 -- pprTrace "name1a:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
561 result = Imp orig_mod s [int_mod] (mod_rn_fn s)
563 -- pprTrace "name2a:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
568 doRenamings mod_rn_fn int_mod orig_mod renamings
570 local_rn_fn = mkRenamingFun renamings
572 --pprTrace "local_rns:" (ppr PprDebug renamings) (
576 local_name = local_rn_fn s
578 = (local_name, Imp orig_mod s [int_mod] (mod_rn_fn local_name))
580 -- pprTrace "name1:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
588 = Imp orig_mod s [int_mod] (mod_rn_fn (local_rn_fn s))
590 -- pprTrace "name2:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
598 mkRenamingFun :: [Renaming] -> FAST_STRING -> FAST_STRING
600 mkRenamingFun [] = \ s -> s
601 mkRenamingFun renamings
603 rn_fn = lookupFM (listToFM -- OLD: mkStringLookupFn
604 [ (old, new) | MkRenaming old new <- renamings ]
605 ) -- OLD: False {-not-sorted-}
607 \s -> case rn_fn s of
613 %************************************************************************
615 \subsection{Type declarations}
617 %************************************************************************
619 @doIfaceTyDecls1@ uses the `name function' to map local tycon names into
620 original names, calling @doConDecls1@ to do the same for the
621 constructors. @doTyDecls1@ is used to do both module and interface
625 doIfaceTyDecls1 :: SelectiveImporter
628 -> Rn12M [ProtoNameTyDecl]
630 doIfaceTyDecls1 sifun full_tc_nf ty_decls
631 = mapRn12 do_decl ty_decls `thenRn12` \ decls_maybe ->
632 returnRn12 (catMaybes decls_maybe)
634 do_decl (TyData context tycon tyvars condecls derivs (DataPragmas hidden_cons specs) src_loc)
636 full_thing = returnRn12 (Just ty_decl')
638 -- GHC doesn't allow derivings in interfaces
641 else addErrRn12 (derivingInIfaceErr tycon derivs src_loc)
644 case (sifun tycon) of
645 NotWanted -> returnRn12 Nothing
647 WantedWith (IEThingAll _) -> full_thing
648 WantedWith (IEThingAbs _) -> returnRn12 (Just abs_ty_decl')
649 WantedWith ie@(IEConWithCons _ _) -> full_thing
651 WantedWith really_weird_ie -> -- probably a typo in the pgm
652 addErrRn12 (weirdImportExportConstraintErr
653 tycon really_weird_ie src_loc) `thenRn12` \ _ ->
656 (tycon_name, constr_nf) = full_tc_nf tycon
657 tc_nf = fst . full_tc_nf
659 condecls' = map (do_condecl constr_nf tc_nf) condecls
660 hidden_cons' = map (do_condecl constr_nf tc_nf) hidden_cons
662 pragmas' invent_hidden
663 = DataPragmas (if null hidden_cons && invent_hidden
664 then condecls' -- if importing abstractly but condecls were
665 -- exported we add them to the data pragma
667 specs {- ToDo: do_specs -}
669 context' = doIfaceContext1 tc_nf context
670 deriv' = map tc_nf derivs -- rename derived classes
672 ty_decl' = TyData context' tycon_name tyvars condecls' deriv' (pragmas' False) src_loc
673 abs_ty_decl'= TyData context' tycon_name tyvars [] deriv' (pragmas' True) src_loc
675 do_decl (TySynonym tycon tyvars monoty pragmas src_loc)
677 full_thing = returnRn12 (Just ty_decl')
679 case (sifun tycon) of
680 NotWanted -> returnRn12 Nothing
682 WantedWith (IEThingAll _) -> full_thing
684 WantedWith weird_ie -> full_thing
686 (tycon_name,_) = full_tc_nf tycon
687 tc_nf = fst . full_tc_nf
688 monoty' = doIfaceMonoType1 tc_nf monoty
689 ty_decl' = TySynonym tycon_name tyvars monoty' pragmas src_loc
691 -- one name fun for the data constructor, another for the type:
693 do_condecl c_nf tc_nf (ConDecl name tys src_loc)
694 = ConDecl (c_nf name) (doIfaceMonoTypes1 tc_nf tys) src_loc
697 %************************************************************************
699 \subsection{Class declarations}
701 %************************************************************************
703 @doIfaceClassDecls1@ uses the `name function' to map local class names into
704 original names, calling @doIfaceClassOp1@ to do the same for the
705 class operations. @doClassDecls1@ is used to process both module and
706 interface class declarations.
709 doIfaceClassDecls1 :: SelectiveImporter
711 -> [ProtoNameClassDecl]
712 -> Rn12M [ProtoNameClassDecl]
714 doIfaceClassDecls1 sifun full_tc_nf clas_decls
715 = mapRn12 do_decl clas_decls `thenRn12` \ decls_maybe ->
716 returnRn12 (catMaybes decls_maybe)
718 do_decl (ClassDecl ctxt cname tyvar sigs bs@EmptyMonoBinds prags locn)
719 -- No defaults in interface
721 full_thing = returnRn12 (Just class_decl')
723 case (sifun cname) of
724 NotWanted -> returnRn12 Nothing
726 WantedWith (IEThingAll _) -> full_thing
727 --??? WantedWith (IEThingAbs _) -> returnRn12 (Just abs_class_decl')
728 WantedWith (IEClsWithOps _ _) -> full_thing
729 -- ToDo: add checking of IEClassWithOps
730 WantedWith really_weird_ie -> -- probably a typo in the pgm
731 addErrRn12 (weirdImportExportConstraintErr
732 cname really_weird_ie locn) `thenRn12` \ _ ->
735 (clas, op_nf) = full_tc_nf cname
736 tc_nf = fst . full_tc_nf
738 sigs' = map (doIfaceClassOp1 op_nf tc_nf) sigs
739 ctxt' = doIfaceContext1 tc_nf ctxt
741 class_decl' = ClassDecl ctxt' clas tyvar sigs' bs prags locn
742 abs_class_decl' = ClassDecl ctxt' clas tyvar [] bs prags locn
746 doIfaceClassOp1 :: IntNameFun -- Use this for the class ops
747 -> IntNameFun -- Use this for the types
748 -> ProtoNameClassOpSig
749 -> ProtoNameClassOpSig
751 doIfaceClassOp1 op_nf tc_nf (ClassOpSig v ty pragma src_loc)
752 = ClassOpSig (op_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc
755 %************************************************************************
757 \subsection{Instance declarations}
759 %************************************************************************
761 We select the instance decl if either the class or the type constructor
765 doIfaceInstDecls1 :: SelectiveImporter
767 -> [ProtoNameInstDecl]
768 -> [ProtoNameInstDecl]
770 doIfaceInstDecls1 si tc_nf inst_decls
771 = catMaybes (map do_decl inst_decls)
773 do_decl (InstDecl context cname ty EmptyMonoBinds False modname imod uprags pragmas src_loc)
774 = case (si cname, tycon_reqd) of
775 (NotWanted, NotWanted) -> Nothing
778 context' = doIfaceContext1 tc_nf context
779 ty' = doIfaceMonoType1 tc_nf ty
781 inst_decl' = InstDecl context' (tc_nf cname) ty' EmptyMonoBinds False modname imod uprags pragmas src_loc
784 = case getNonPrelOuterTyCon ty of
785 Nothing -> NotWanted -- Type doesn't have a user-defined tycon
786 -- at its outermost level
787 Just tycon -> si tycon -- It does, so look up in the si-fun
790 %************************************************************************
792 \subsection{Signature declarations}
794 %************************************************************************
796 @doIfaceSigs1@ uses the name function to create a bag that
797 maps local names into original names.
799 NB: Can't have user-pragmas & other weird things in interfaces.
802 doIfaceSigs1 :: SelectiveImporter -> IntNameFun -> IntNameFun
806 doIfaceSigs1 si v_nf tc_nf sigs
807 = catMaybes (map do_sig sigs)
809 do_sig (Sig v ty pragma src_loc)
812 Wanted -> Just (Sig (v_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc)
813 -- WantedWith doesn't make sense
817 %************************************************************************
819 \subsection{Fixity declarations}
821 %************************************************************************
824 doIfaceFixes1 :: SelectiveImporter -> IntNameFun
825 -> [ProtoNameFixityDecl]
826 -> [ProtoNameFixityDecl]
828 doIfaceFixes1 si vnf fixities
829 = catMaybes (map do_fixity fixities)
831 do_fixity (InfixL name i) = do_one InfixL name i
832 do_fixity (InfixR name i) = do_one InfixR name i
833 do_fixity (InfixN name i) = do_one InfixN name i
837 Wanted -> Just (con (vnf name) i)
842 %************************************************************************
844 \subsection{doContext, MonoTypes, MonoType, Polytype}
846 %************************************************************************
849 doIfacePolyType1 :: IntNameFun -> ProtoNamePolyType -> ProtoNamePolyType
851 doIfacePolyType1 tc_nf (UnoverloadedTy ty)
852 = UnoverloadedTy (doIfaceMonoType1 tc_nf ty)
854 doIfacePolyType1 tc_nf (OverloadedTy ctxt ty)
855 = OverloadedTy (doIfaceContext1 tc_nf ctxt) (doIfaceMonoType1 tc_nf ty)
859 doIfaceContext1 :: IntNameFun -> ProtoNameContext -> ProtoNameContext
860 doIfaceContext1 tc_nf context = [(tc_nf clas, tyvar) | (clas,tyvar) <- context]
865 doIfaceMonoTypes1 :: IntNameFun -> [ProtoNameMonoType] -> [ProtoNameMonoType]
866 doIfaceMonoTypes1 tc_nf tys = map (doIfaceMonoType1 tc_nf) tys
871 doIfaceMonoType1 :: IntNameFun -> ProtoNameMonoType -> ProtoNameMonoType
873 doIfaceMonoType1 tc_nf (MonoTyVar tyvar) = MonoTyVar tyvar
875 doIfaceMonoType1 tc_nf (ListMonoTy ty)
876 = ListMonoTy (doIfaceMonoType1 tc_nf ty)
878 doIfaceMonoType1 tc_nf (FunMonoTy ty1 ty2)
879 = FunMonoTy (doIfaceMonoType1 tc_nf ty1) (doIfaceMonoType1 tc_nf ty2)
881 doIfaceMonoType1 tc_nf (TupleMonoTy tys)
882 = TupleMonoTy (map (doIfacePolyType1 tc_nf) tys)
884 doIfaceMonoType1 tc_nf (MonoTyCon name tys)
885 = MonoTyCon (tc_nf name) (doIfaceMonoTypes1 tc_nf tys)
888 doIfaceMonoType1 tc_nf (MonoTyProc tys ty)
889 = MonoTyProc (doIfaceMonoTypes1 tc_nf tys) (doIfaceMonoType1 tc_nf ty)
891 doIfaceMonoType1 tc_nf (MonoTyPod ty)
892 = MonoTyPod (doIfaceMonoType1 tc_nf ty)
893 #endif {- Data Parallel Haskell -}