import HsSyn
import RdrHsSyn ( RdrNameIE )
-import RnHsSyn ( RenamedTyClDecl )
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
- mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv
+ mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv, rdrEnvToList,
+ unqualifyRdrName
)
import HsTypes ( hsTyVarName, replaceTyVarName )
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
extendLocalRdrEnv
)
import RnMonad
-import Name ( Name,
+import Name ( Name,
getSrcLoc, nameIsLocalOrFrom,
mkLocalName, mkGlobalName,
mkIPName, nameOccName, nameModule_maybe,
import OccName ( OccName, occNameUserString, occNameFlavour )
import Module ( ModuleName, moduleName, mkVanillaModule,
mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
-import PrelNames ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap,
+import PrelNames ( mkUnboundName,
derivingOccurrences,
mAIN_Name, pREL_MAIN_Name,
- ioTyConName, integerTyConName, doubleTyConName, intTyConName,
+ ioTyConName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
eqStringName, printName,
- hasKey, fractionalClassKey, numClassKey,
bindIOName, returnIOName, failIOName
)
import TysWiredIn ( unitTyCon ) -- A little odd
mod = rdrNameModule rdr_name
occ = rdrNameOcc rdr_name
in
- loadInterface (ppr rdr_name) mod ImportBySystem `thenRn` \ iface ->
+ loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface ->
case [ name | (_,avails) <- mi_exports iface,
avail <- avails,
name <- availNames avail,
-- free var at every function application!)
\end{code}
-\begin{code}
-rnSyntaxNames :: GlobalRdrEnv -> FreeVars -> RnMG (FreeVars, SyntaxMap)
--- Look up the re-bindable syntactic sugar names
--- Any errors arising from these lookups may surprise the
--- programmer, since they aren't explicitly mentioned, and
--- the src line will be unhelpful (ToDo)
+%************************************************************************
+%* *
+\subsection{Re-bindable desugaring names}
+%* *
+%************************************************************************
+
+Haskell 98 says that when you say "3" you get the "fromInteger" from the
+Standard Prelude, regardless of what is in scope. However, to experiment
+with having a language that is less coupled to the standard prelude, we're
+trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
+happens to be in scope. Then you can
+ import Prelude ()
+ import MyPrelude as Prelude
+to get the desired effect.
+
+At the moment this just happens for
+ * fromInteger, fromRational on literals (in expressions and patterns)
+ * negate (in expressions)
+ * minus (arising from n+k patterns)
+
+We store the relevant Name in the HsSyn tree, in
+ * HsIntegral/HsFractional
+ * NegApp
+ * NPlusKPatIn
+respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName,
+fromRationalName etc), but the renamer changes this to the appropriate user
+name if Opt_NoImplicitPrelude is on. That is what lookupSyntaxName does.
-rnSyntaxNames gbl_env source_fvs
+\begin{code}
+lookupSyntaxName :: Name -- The standard name
+ -> RnMS Name -- Possibly a non-standard name
+lookupSyntaxName std_name
= doptRn Opt_NoImplicitPrelude `thenRn` \ no_prelude ->
if not no_prelude then
- returnRn (source_fvs, vanillaSyntaxMap)
+ returnRn std_name -- Normal case
else
-
- -- There's a -fno-implicit-prelude flag,
- -- so build the re-mapping function
let
- reqd_syntax_list = filter is_reqd syntaxList
- is_reqd (n,_) = n `elemNameSet` source_fvs
- lookup (n,rn) = lookupSrcName gbl_env rn `thenRn` \ rn' ->
- returnRn (n,rn')
+ rdr_name = mkRdrUnqual (nameOccName std_name)
+ -- Get the similarly named thing from the local environment
in
- mapRn lookup reqd_syntax_list `thenRn` \ rn_syntax_list ->
- let
- -- Delete the proxies and add the actuals
- proxies = map fst rn_syntax_list
- actuals = map snd rn_syntax_list
- new_source_fvs = (proxies `delFVs` source_fvs) `plusFV` mkFVs actuals
-
- syntax_env = mkNameEnv rn_syntax_list
- syntax_map n = lookupNameEnv syntax_env n `orElse` n
- in
- returnRn (new_source_fvs, syntax_map)
+ lookupOccRn rdr_name
\end{code}
newLocalsRn rdr_names_w_loc
= getNameSupplyRn `thenRn` \ name_supply ->
let
- n = length rdr_names_w_loc
(us', us1) = splitUniqSupply (nsUniqs name_supply)
- uniqs = uniqsFromSupply n us1
+ uniqs = uniqsFromSupply us1
names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
| ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
]
\begin{code}
mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
-> Bool -- True <=> want unqualified import
- -> Bool -- True <=> want qualified import
- -> [AvailInfo] -- What's to be hidden (but only the unqualified
- -- version is hidden)
-> (Name -> Provenance)
- -> Avails -- Whats imported and how
+ -> Avails -- Whats imported
+ -> Avails -- What's to be hidden
+ -- I.e. import (imports - hides)
-> Deprecations
-> GlobalRdrEnv
-mkGlobalRdrEnv this_mod unqual_imp qual_imp hides
- mk_provenance avails deprecs
- = gbl_env2
+mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
+ = gbl_env3
where
-- Make the name environment. We're talking about a
-- single module here, so there must be no name clashes.
-- In practice there only ever will be if it's the module
-- being compiled.
- -- Add the things that are available
+ -- Add qualified names for the things that are available
+ -- (Qualified names are always imported)
gbl_env1 = foldl add_avail emptyRdrEnv avails
- -- Delete things that are hidden
+ -- Delete (qualified names of) things that are hidden
gbl_env2 = foldl del_avail gbl_env1 hides
+ -- Add unqualified names
+ gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2)
+ | otherwise = gbl_env2
+
+ add_unqual env (qual_name, elts)
+ = foldl add_one env elts
+ where
+ add_one env elt = addOneToGlobalRdrEnv env unqual_name elt
+ unqual_name = unqualifyRdrName qual_name
+ -- The qualified import should only have added one
+ -- binding for each qualified name! But if there's an error in
+ -- the module (multiple bindings for the same name) we may get
+ -- duplicates. So the simple thing is to do the fold.
+
+ del_avail env avail
+ = foldl delOneFromGlobalRdrEnv env rdr_names
+ where
+ rdr_names = map (mkRdrQual this_mod . nameOccName)
+ (availNames avail)
+
+
add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
add_avail env avail = foldl add_name env (availNames avail)
- add_name env name
- | qual_imp && unqual_imp = env3
- | unqual_imp = env2
- | qual_imp = env1
- | otherwise = env
+ add_name env name -- Add qualified name only
+ = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
where
- env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
- env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) elt
- env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) elt
occ = nameOccName name
elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
- del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
- where
- rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
-
mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
-- Used to construct a GlobalRdrEnv for an interface that we've
-- read from a .hi file. We can't construct the original top-level
mkIfaceGlobalRdrEnv m_avails
= foldl add emptyRdrEnv m_avails
where
- add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False []
- (\n -> LocalDef) avails NoDeprecs)
+ add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True
+ (\n -> LocalDef) avails [] NoDeprecs)
-- The NoDeprecs is a bit of a hack I suppose
\end{code}
= pushSrcLocRn loc $
addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
$$
- (ptext SLIT("in") <+> descriptor))
+ descriptor)
warnDeprec :: Name -> DeprecTxt -> RnM d ()
warnDeprec name txt
quotes (ppr name) <+> text "is deprecated:",
nest 4 (ppr txt) ])
\end{code}
+
projects / ghc-hetmet.git / blobdiff