import HsImpExp ( ieName )
import RdrHsSyn ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), SYN_IE(RdrNameImportDecl),
SYN_IE(RdrNameHsModule), SYN_IE(RdrNameFixityDecl),
- rdrNameOcc
+ rdrNameOcc, ieOcc
)
import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
-import RnIfaces ( getInterfaceExports, getDeclBinders, checkUpToDate )
+import RnIfaces ( getInterfaceExports, getDeclBinders, checkUpToDate, recordSlurp )
import RnEnv
import RnMonad
import FiniteMap
exportsFromAvail this_mod exports all_avails rn_env
`thenRn` \ (export_fn, export_env) ->
+ -- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
+ mapRn (recordSlurp Nothing) local_avails `thenRn_`
+
returnRn (export_fn, Just (export_env, rn_env, local_avails))
) `thenRn` \ (_, result) ->
returnRn result
getInterfaceExports mod `thenRn` \ (avails, fixities) ->
filterImports mod import_spec avails `thenRn` \ filtered_avails ->
let
- filtered_avails' = [ Avail (set_name_prov n) (map set_name_prov ns)
- | Avail n ns <- filtered_avails
- ]
+ filtered_avails' = map set_avail_prov filtered_avails
fixities' = [ (occ,(fixity,provenance)) | (occ,fixity) <- fixities ]
in
qualifyImports mod
as_mod
(ExportEnv filtered_avails' fixities')
where
+ set_avail_prov NotAvailable = NotAvailable
+ set_avail_prov (Avail n) = Avail (set_name_prov n)
+ set_avail_prov (AvailTC n ns) = AvailTC (set_name_prov n) (map set_name_prov ns)
set_name_prov name = setNameProvenance name provenance
provenance = Imported mod loc
\end{code}
getLocalDeclBinders avails decl
= getDeclBinders newLocalName decl `thenRn` \ avail ->
- returnRn (avail : avails)
+ case avail of
+ NotAvailable -> returnRn avails -- Instance decls and suchlike
+ other -> returnRn (avail : avails)
do_one (rdr_name, loc)
= newLocalName rdr_name loc `thenRn` \ name ->
- returnRn (Avail name [])
+ returnRn (Avail name)
\end{code}
%************************************************************************
= returnRn imports
filterImports mod (Just (want_hiding, import_items)) avails
- = -- Check that each import item mentions things that are actually available
- mapRn check_import_item import_items `thenRn_`
-
- -- Return filtered environment; no need to filter fixities
- returnRn (map new_avail avails)
-
+ = foldlRn (filter_item want_hiding) initial_avails import_items
where
- import_fm :: FiniteMap OccName RdrNameIE
- import_fm = listToFM [(ieOcc ie, ie) | ie <- import_items]
-
- avail_fm :: FiniteMap OccName AvailInfo
- avail_fm = listToFM [(nameOccName name, avail) | avail@(Avail name ns) <- avails]
-
- new_avail NotAvailable = NotAvailable
- new_avail avail@(Avail name _)
- | not in_import_items && want_hiding = avail
- | not in_import_items && not want_hiding = NotAvailable
- | in_import_items && want_hiding = NotAvailable
- | in_import_items && not want_hiding = filtered_avail
- where
- maybe_import_item = lookupFM import_fm (nameOccName name)
- in_import_items = maybeToBool maybe_import_item
- Just import_item = maybe_import_item
- filtered_avail = filterAvail import_item avail
-
- check_import_item :: RdrNameIE -> RnMG ()
- check_import_item item
- = checkRn (maybeToBool maybe_matching_avail && sub_names_ok item avail)
- (badImportItemErr mod item)
- where
- item_name = ieOcc item
- maybe_matching_avail = lookupFM avail_fm item_name
- Just avail = maybe_matching_avail
-
- sub_names_ok (IEVar _) _ = True
- sub_names_ok (IEThingAbs _) _ = True
- sub_names_ok (IEThingAll _) _ = True
- sub_names_ok (IEThingWith _ wanted) (Avail _ has) = all ((`elem` has_list) . rdrNameOcc) wanted
- where
- has_list = map nameOccName has
- sub_names_ok other1 other2 = False
+ initial_avails | want_hiding = avails
+ | otherwise = []
+
+ import_fm :: FiniteMap OccName AvailInfo
+ import_fm = listToFM [ (nameOccName name, avail)
+ | avail <- avails,
+ name <- availEntityNames avail]
+
+ filter_item want_hiding avails_so_far item@(IEModuleContents _)
+ = addErrRn (badImportItemErr mod item) `thenRn_`
+ returnRn avails_so_far
+
+ filter_item want_hiding avails_so_far item
+ | not (maybeToBool maybe_in_import_avails) ||
+ (case filtered_avail of { NotAvailable -> True; other -> False })
+ = addErrRn (badImportItemErr mod item) `thenRn_`
+ returnRn avails_so_far
+
+ | want_hiding = returnRn (foldr hide_it [] avails_so_far)
+ | otherwise = returnRn (filtered_avail : avails_so_far) -- Explicit import list
+
+ where
+ maybe_in_import_avails = lookupFM import_fm (ieOcc item)
+ Just avail = maybe_in_import_avails
+ filtered_avail = filterAvail item avail
+ hide_it avail avails = case hideAvail item avail of
+ NotAvailable -> avails
+ avail' -> avail' : avails
\end{code}
mod_avail_env = unitFM qual_mod avails
- add_name name_env NotAvailable = returnRn name_env
- add_name name_env (Avail n ns) = foldlRn add_one name_env (n : ns)
+ add_name name_env avail = foldlRn add_one name_env (availNames avail)
add_one :: NameEnv -> Name -> RnMG NameEnv
add_one env name = add_to_env addOneToNameEnvRn env occ_name name
emptyAvailEnv = emptyFM
unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
-unitAvailEnv ie NotAvailable
- = emptyFM
-unitAvailEnv ie avail@(Avail n ns)
- = unitFM (nameOccName n) (ie,avail)
+unitAvailEnv ie NotAvailable = emptyFM
+unitAvailEnv ie (AvailTC _ []) = emptyFM
+unitAvailEnv ie avail = unitFM (nameOccName (availName avail)) (ie,avail)
plusAvailEnv a1 a2
= mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2) `thenRn_`
listToAvailEnv ie items
= foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
-bad_avail (ie1,Avail n1 _) (ie2,Avail n2 _) = n1 /= n2 -- Same OccName, different Name
+bad_avail (ie1,avail1) (ie2,avail2) = availName avail1 /= availName avail2 -- Same OccName, different Name
plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
\end{code}
+Processing the export list.
+
+You might think that we should record things that appear in the export list as
+``occurrences'' (using addOccurrenceName), but you'd be wrong. We do check (here)
+that they are in scope, but there is no need to slurp in their actual declaration
+(which is what addOccurrenceName forces). Indeed, doing so would big trouble when
+compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
+includes ConcBase.StateAndSynchVar#, and so on...
\begin{code}
exportsFromAvail :: Module
where
full_avail_env :: UniqFM AvailInfo
full_avail_env = addListToUFM_C plusAvail emptyUFM
- [(name,avail) | avail@(Avail name _) <- concat (eltsFM all_avails)]
- -- NB: full_avail_env won't contain bindings for data constructors and class ops,
- -- which is right and proper; attempts to export them on their own will provoke an error
+ [(name, avail) | avail <- concat (eltsFM all_avails),
+ name <- availEntityNames avail
+ ]
+
+ -- NB: full_avail_env will contain bindings for class ops but not constructors
+ -- (see defn of availEntityNames)
exports_from_item :: RdrNameIE -> RnMG AvailEnv
exports_from_item ie@(IEModuleContents mod)
= case lookupFM all_avails mod of
Nothing -> failWithRn emptyAvailEnv (modExportErr mod)
- Just avails -> addOccurrenceNames Compulsory [n | Avail n _ <- avails] `thenRn_`
- listToAvailEnv ie avails
+ Just avails -> listToAvailEnv ie avails
exports_from_item ie
| not (maybeToBool maybe_in_scope)
= failWithRn emptyAvailEnv (exportItemErr ie export_avail)
| otherwise -- Phew! It's OK!
- = addOccurrenceName Compulsory name `thenRn_`
- returnRn (unitAvailEnv ie export_avail)
+ = returnRn (unitAvailEnv ie export_avail)
where
maybe_in_scope = lookupNameEnv name_env (ieName ie)
Just name = maybe_in_scope
%************************************************************************
\begin{code}
-ieOcc ie = rdrNameOcc (ieName ie)
-
badImportItemErr mod ie sty
- = ppSep [ppStr "Module", pprModule sty mod, ppStr "does not export", ppr sty ie]
+ = ppSep [ppPStr SLIT("Module"), pprModule sty mod, ppPStr SLIT("does not export"), ppr sty ie]
modExportErr mod sty
- = ppCat [ ppStr "Unknown module in export list: module", ppPStr mod]
+ = ppCat [ ppPStr SLIT("Unknown module in export list: module"), ppPStr mod]
exportItemErr export_item NotAvailable sty
- = ppSep [ ppStr "Export item not in scope:", ppr sty export_item ]
+ = ppSep [ ppPStr SLIT("Export item not in scope:"), ppr sty export_item ]
exportItemErr export_item avail sty
- = ppHang (ppStr "Export item not fully in scope:")
- 4 (ppAboves [ppCat [ppStr "Wanted: ", ppr sty export_item],
- ppCat [ppStr "Available: ", ppr sty (ieOcc export_item), pprAvail sty avail]])
+ = ppHang (ppPStr SLIT("Export item not fully in scope:"))
+ 4 (ppAboves [ppCat [ppPStr SLIT("Wanted: "), ppr sty export_item],
+ ppCat [ppPStr SLIT("Available: "), ppr sty (ieOcc export_item), pprAvail sty avail]])
availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
- = ppHang (ppCat [ppStr "Conflicting exports for local name: ", ppr sty occ_name])
+ = ppHang (ppCat [ppPStr SLIT("Conflicting exports for local name: "), ppr sty occ_name])
4 (ppAboves [ppr sty ie1, ppr sty ie2])
\end{code}
projects / ghc-hetmet.git / blobdiff