-doOrigIEs iface_cache info mod src_loc us (ie:ies)
- = let
- (us1, us2) = splitUniqSupply us
- in
- doOrigIE iface_cache info mod src_loc us1 ie
- >>= \ (vals1, tcs1, imps1, errs1, warns1) ->
- doOrigIEs iface_cache info mod src_loc us2 ies
- >>= \ (vals2, tcs2, imps2, errs2, warns2) ->
- return (vals1 `unionBags` vals2,
- tcs1 `unionBags` tcs2,
- imps1 `unionBags` imps2,
- errs1 `unionBags` errs2,
- warns1 `unionBags` warns2)
-
-----------------------
-doOrigIE :: IfaceCache
- -> ImportNameInfo
- -> Module
- -> SrcLoc
- -> UniqSupply
- -> IE OrigName
- -> IO (Bag RnName, -- values
- Bag RnName, -- tycons/classes
- Bag (RnName,ExportFlag), -- import flags
- Bag Error,
- Bag Warning)
-
-doOrigIE iface_cache info mod src_loc us ie
- = with_decl iface_cache (ie_name ie)
- avoided_fn
- (\ err -> (emptyBag, emptyBag, emptyBag, unitBag err, emptyBag))
- (\ decl -> case initRn True mod emptyRnEnv us
- (setExtraRn info $
- pushSrcLocRn src_loc $
- getIfaceDeclNames ie decl)
- of
- ((vals, tcs, imps), errs, warns) -> (vals, tcs, imps, errs, warns))
- where
- avoided_fn Nothing -- the thing should be in the source
- = (emptyBag, emptyBag, emptyBag, emptyBag, emptyBag)
- avoided_fn (Just (Left rn@(WiredInId _))) -- a builtin value brought into scope
- = (unitBag rn, emptyBag, emptyBag, emptyBag, emptyBag)
- avoided_fn (Just (Right rn@(WiredInTyCon tc)))
- -- a builtin tc brought into scope; we also must bring its
- -- data constructors into scope
- = --pprTrace "avoided:Right:" (ppr PprDebug rn) $
- (listToBag [WiredInId dc | dc <- tyConDataCons tc], unitBag rn, emptyBag, emptyBag, emptyBag)
-
--------------------------
-checkOrigIE :: IfaceCache
- -> (IE OrigName, ExportFlag)
- -> IO (Bag (Module -> SrcLoc -> Error), Bag (Module -> SrcLoc -> Warning))
-
-checkOrigIE iface_cache (IEThingAll n, ExportAbs)
- = with_decl iface_cache n
- (\ _ -> (emptyBag, emptyBag))
- (\ err -> (unitBag (\ mod locn -> err), emptyBag))
- (\ decl -> case decl of
- TypeSig _ _ _ -> (emptyBag, unitBag (allWhenSynImpSpecWarn n))
- other -> (unitBag (allWhenAbsImpSpecErr n), emptyBag))
-
-checkOrigIE iface_cache (IEThingWith n ns, ExportAbs)
- = return (unitBag (withWhenAbsImpSpecErr n), emptyBag)
-
-checkOrigIE iface_cache (IEThingWith n ns, ExportAll)
- = with_decl iface_cache n
- (\ _ -> (emptyBag, emptyBag))
- (\ err -> (unitBag (\ mod locn -> err), emptyBag))
- (\ decl -> case decl of
- NewTypeSig _ con _ _ -> (check_with "constructors" [con] ns, emptyBag)
- DataSig _ cons fields _ _ -> (check_with "constructors (and fields)" (cons++fields) ns, emptyBag)
- ClassSig _ ops _ _ -> (check_with "class ops" ops ns, emptyBag))
- where
- check_with str has origs
- | sortLt (<) (map getLocalName has) == sortLt (<) (map nameOf origs)
- = emptyBag
- | otherwise
- = unitBag (withImpSpecErr str n has origs)
-
-checkOrigIE iface_cache other
- = return (emptyBag, emptyBag)
-
------------------------
-with_decl :: IfaceCache
- -> OrigName
- -> (Maybe (Either RnName RnName) -> something) -- if avoided..
- -> (Error -> something) -- if an error...
- -> (RdrIfaceDecl -> something) -- if OK...
- -> IO something
-
-with_decl iface_cache n do_avoid do_err do_decl
- = cachedDecl iface_cache (isLexCon n_name || isLexSpecialSym n_name) n >>= \ maybe_decl ->
- case maybe_decl of
- CachingAvoided info -> return (do_avoid info)
- CachingFail err -> return (do_err err)
- CachingHit decl -> return (do_decl decl)
- where
- n_name = nameOf n