Skip to content
Snippets Groups Projects
Commit da162afc authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

[project @ 2000-10-31 17:30:16 by simonpj] 

PrelBase compiles!
parent 12467fbf
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 274 additions and 271 deletions
ghc/compiler/basicTypes/Id.lhs
+ 4
− 1
View file @ da162afc
......@@ -251,9 +251,12 @@ hasNoBinding id = case idFlavour id of
-- Don't drop a binding for an exported Id,
-- if it otherwise looks dead.
isExportedId :: Id -> Bool
isExportedId id = case idFlavour id of
isExportedId id = isUserExportedId id -- Try this
{-
case idFlavour id of
VanillaId -> False
other -> True -- All the others are no-discard
-}
-- Say if an Id was exported by the user
-- Implies isExportedId (see mkId above)
......
ghc/compiler/basicTypes/Name.lhs
+ 23
− 12
View file @ da162afc
......@@ -45,7 +45,7 @@ module Name (
import OccName -- All of it
import Module ( Module, moduleName, mkVanillaModule,
printModulePrefix, isModuleInThisPackage )
import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import RdrName ( RdrName, mkRdrOrig, mkRdrIfaceUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_Static, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( builtinSrcLoc, noSrcLoc, SrcLoc )
import Unique ( Unique, Uniquable(..), u2i, pprUnique, pprUnique10 )
......@@ -301,7 +301,7 @@ tidyTopName mod env
System -> localise -- System local Ids
Local -> localise -- User non-exported Ids
Exported -> globalise -- User-exported things
Global _ -> no_op -- Constructors, class selectors etc
Global _ -> no_op -- Constructors, class selectors, default methods
where
no_op = (env, name)
......@@ -354,14 +354,8 @@ hashName name = iBox (u2i (nameUnique name))
nameRdrName :: Name -> RdrName
-- Makes a qualified name for top-level (Global) names, whether locally defined or not
-- and an unqualified name just for Locals
nameRdrName (Name { n_occ = occ, n_sort = Global mod }) = mkRdrQual (moduleName mod) occ
nameRdrName (Name { n_occ = occ }) = mkRdrUnqual occ
ifaceNameRdrName :: Name -> RdrName
-- Makes a qualified naem for imported things,
-- and an unqualified one for local things
ifaceNameRdrName n | isLocallyDefined n = mkRdrUnqual (nameOccName n)
| otherwise = mkRdrQual (moduleName (nameModule n)) (nameOccName n)
nameRdrName (Name { n_occ = occ, n_sort = Global mod }) = mkRdrOrig (moduleName mod) occ
nameRdrName (Name { n_occ = occ }) = mkRdrIfaceUnqual occ
isDllName :: Name -> Bool
-- Does this name refer to something in a different DLL?
......@@ -477,15 +471,32 @@ pprLocal sty uniq occ pp_export
| otherwise = pprOccName occ
pprGlobal sty uniq mod occ
| codeStyle sty = ppr (moduleName mod) <> char '_' <> pprOccName occ
| codeStyle sty
|| ifaceStyle sty = ppr (moduleName mod) <> char '_' <> pprOccName occ
| debugStyle sty = ppr (moduleName mod) <> dot <> pprOccName occ <>
text "{-" <> pprUnique10 uniq <> text "-}"
| printModulePrefix mod = ppr (moduleName mod) <> dot <> pprOccName occ
| otherwise = pprOccName occ
pprSysLocal sty uniq occ
| codeStyle sty = pprUnique uniq
| otherwise = pprOccName occ <> char '_' <> pprUnique uniq
{-
pprNameBndr :: Name -> SDoc
-- Print a binding occurrence of a name.
-- In interface files we can omit the "M." prefix, which tides things up a lot
pprNameBndr name
= getPprStyle $ \ sty ->
case sort of
Global mod | ifaceStyle sty -> pprLocal sty uniq occ empty
| otherwise -> pprGlobal sty uniq mod occ
System -> pprSysLocal sty uniq occ
Local -> pprLocal sty uniq occ empty
Exported -> pprLocal sty uniq occ (char 'x')
-}
\end{code}
......@@ -514,7 +525,7 @@ isLocalOrFrom :: NamedThing a => Module -> a -> Bool
getSrcLoc = nameSrcLoc . getName
isLocallyDefined = nameIsLocallyDefined . getName
getOccString = occNameString . getOccName
toRdrName = ifaceNameRdrName . getName
toRdrName = nameRdrName . getName
isFrom mod x = nameIsFrom mod (getName x)
isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x)
\end{code}
......
ghc/compiler/basicTypes/RdrName.lhs
+ 53
− 25
View file @ da162afc
......@@ -9,15 +9,14 @@ module RdrName (
RdrName,
-- Construction
mkRdrUnqual, mkRdrQual,
mkUnqual, mkQual,
mkSysUnqual, mkSysQual,
mkPreludeQual, qualifyRdrName, mkRdrNameWkr,
mkRdrUnqual, mkRdrQual, mkRdrOrig, mkRdrIfaceUnqual,
mkUnqual, mkQual, mkIfaceOrig, mkOrig,
qualifyRdrName, mkRdrNameWkr,
dummyRdrVarName, dummyRdrTcName,
-- Destruction
rdrNameModule, rdrNameOcc, setRdrNameOcc,
isRdrDataCon, isRdrTyVar, isQual, isUnqual,
isRdrDataCon, isRdrTyVar, isQual, isSourceQual, isUnqual, isIface,
-- Environment
RdrNameEnv,
......@@ -31,7 +30,7 @@ module RdrName (
#include "HsVersions.h"
import OccName ( NameSpace, tcName,
OccName, UserFS,
OccName, UserFS, EncodedFS,
mkSysOccFS,
mkOccFS, mkVarOcc,
isDataOcc, isTvOcc, mkWorkerOcc
......@@ -55,7 +54,18 @@ import Util ( thenCmp )
data RdrName = RdrName Qual OccName
data Qual = Unqual
| Qual ModuleName -- The (encoded) module name
| IfaceUnqual -- An unqualified name from an interface file;
-- implicitly its module is that of the enclosing
-- interface file; don't look it up in the environment
| Qual ModuleName -- A qualified name written by the user in source code
-- The module isn't necessarily the module where
-- the thing is defined; just the one from which it
-- is imported
| Orig ModuleName -- This is an *original* name; the module is the place
-- where the thing was defined
\end{code}
......@@ -68,6 +78,7 @@ data Qual = Unqual
\begin{code}
rdrNameModule :: RdrName -> ModuleName
rdrNameModule (RdrName (Qual m) _) = m
rdrNameModule (RdrName (Orig m) _) = m
rdrNameOcc :: RdrName -> OccName
rdrNameOcc (RdrName _ occ) = occ
......@@ -81,9 +92,19 @@ setRdrNameOcc (RdrName q _) occ = RdrName q occ
mkRdrUnqual :: OccName -> RdrName
mkRdrUnqual occ = RdrName Unqual occ
mkRdrIfaceUnqual :: OccName -> RdrName
mkRdrIfaceUnqual occ = RdrName IfaceUnqual occ
mkRdrQual :: ModuleName -> OccName -> RdrName
mkRdrQual mod occ = RdrName (Qual mod) occ
mkRdrOrig :: ModuleName -> OccName -> RdrName
mkRdrOrig mod occ = RdrName (Orig mod) occ
mkIfaceOrig :: NameSpace -> (EncodedFS, EncodedFS) -> RdrName
mkIfaceOrig ns (m,n) = RdrName (Orig (mkSysModuleNameFS m)) (mkSysOccFS ns n)
-- These two are used when parsing source files
-- They do encode the module and occurrence names
mkUnqual :: NameSpace -> FAST_STRING -> RdrName
......@@ -92,16 +113,8 @@ mkUnqual sp n = RdrName Unqual (mkOccFS sp n)
mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
mkQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkOccFS sp n)
-- These two are used when parsing interface files
-- They do not encode the module and occurrence name
mkSysUnqual :: NameSpace -> FAST_STRING -> RdrName
mkSysUnqual sp n = RdrName Unqual (mkSysOccFS sp n)
mkSysQual :: NameSpace -> (FAST_STRING, FAST_STRING) -> RdrName
mkSysQual sp (m,n) = RdrName (Qual (mkSysModuleNameFS m)) (mkSysOccFS sp n)
mkPreludeQual :: NameSpace -> ModuleName -> FAST_STRING -> RdrName
mkPreludeQual sp mod n = RdrName (Qual mod) (mkOccFS sp n)
mkOrig :: NameSpace -> ModuleName -> UserFS -> RdrName
mkOrig sp mod n = RdrName (Orig mod) (mkOccFS sp n)
qualifyRdrName :: ModuleName -> RdrName -> RdrName
-- Sets the module name of a RdrName, even if it has one already
......@@ -126,10 +139,18 @@ dummyRdrTcName = RdrName Unqual (mkOccFS tcName SLIT("TC-DUMMY"))
isRdrDataCon (RdrName _ occ) = isDataOcc occ
isRdrTyVar (RdrName _ occ) = isTvOcc occ
isUnqual (RdrName Unqual _) = True
isUnqual other = False
isUnqual (RdrName Unqual _) = True
isUnqual (RdrName IfaceUnqual _) = True
isUnqual other = False
isQual rdr_name = not (isUnqual rdr_name)
isSourceQual (RdrName (Qual _) _) = True
isSourceQual _ = False
isIface (RdrName (Orig _) _) = True
isIface (RdrName IfaceUnqual _) = True
isIface other = False
\end{code}
......@@ -143,8 +164,10 @@ isQual rdr_name = not (isUnqual rdr_name)
instance Outputable RdrName where
ppr (RdrName qual occ) = pp_qual qual <> ppr occ
where
pp_qual Unqual = empty
pp_qual (Qual mod) = ppr mod <> dot
pp_qual Unqual = empty
pp_qual IfaceUnqual = empty
pp_qual (Qual mod) = ppr mod <> dot
pp_qual (Orig mod) = ppr mod <> dot
pprUnqualRdrName (RdrName qual occ) = ppr occ
......@@ -162,10 +185,15 @@ instance Ord RdrName where
= (o1 `compare` o2) `thenCmp`
(q1 `cmpQual` q2)
cmpQual Unqual Unqual = EQ
cmpQual Unqual (Qual _) = LT
cmpQual (Qual _) Unqual = GT
cmpQual (Qual m1) (Qual m2) = m1 `compare` m2
cmpQual Unqual Unqual = EQ
cmpQual IfaceUnqual IfaceUnqual = EQ
cmpQual (Qual m1) (Qual m2) = m1 `compare` m2
cmpQual (Orig m1) (Orig m2) = m1 `compare` m2
cmpQual Unqual _ = LT
cmpQual IfaceUnqual (Qual _) = LT
cmpQual IfaceUnqual (Orig _) = LT
cmpQual (Qual _) (Orig _) = LT
cmpQual _ _ = GT
\end{code}
......
ghc/compiler/main/CmdLineOpts.lhs
+ 1
− 3
View file @ da162afc
......@@ -85,7 +85,6 @@ module CmdLineOpts (
opt_IgnoreAsserts,
opt_IgnoreIfacePragmas,
opt_NoHiCheck,
opt_NoImplicitPrelude,
opt_OmitBlackHoling,
opt_OmitInterfacePragmas,
opt_NoPruneTyDecls,
......@@ -273,6 +272,7 @@ data DynFlag
| Opt_AllowUndecidableInstances
| Opt_GlasgowExts
| Opt_Generics
| Opt_NoImplicitPrelude
-- misc
| Opt_ReportCompile
......@@ -422,7 +422,6 @@ opt_HistorySize = lookup_def_int "-fhistory-size" 20
opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts")
opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas")
opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check")
opt_NoImplicitPrelude = lookUp SLIT("-fno-implicit-prelude")
opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing")
opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas")
......@@ -472,7 +471,6 @@ isStaticHscFlag f =
"fticky-ticky",
"fall-strict",
"fdicts-strict",
"fgenerics",
"firrefutable-tuples",
"fnumbers-strict",
"fparallel",
......
ghc/compiler/main/DriverFlags.hs
+ 2
− 1
View file @ da162afc
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.13 2000/10/27 15:11:37 sewardj Exp $
-- $Id: DriverFlags.hs,v 1.14 2000/10/31 17:30:17 simonpj Exp $
--
-- Driver flags
--
......@@ -392,6 +392,7 @@ dynamic_flags = [
------ Compiler flags -----------------------------------------------
, ( "fglasgow-exts", NoArg (setDynFlag Opt_GlasgowExts) )
, ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) )
, ( "fallow-overlapping-instances",
NoArg (setDynFlag Opt_AllowOverlappingInstances) )
......
ghc/compiler/parser/ParseUtil.lhs
+ 5
− 5
View file @ da162afc
......@@ -31,13 +31,13 @@ module ParseUtil (
import Lex
import HsSyn -- Lots of it
import SrcLoc
import RdrHsSyn ( mkNPlusKPatIn, unitTyCon_RDR,
RdrBinding(..),
import RdrHsSyn ( RdrBinding(..),
RdrNameHsType, RdrNameBangType, RdrNameContext,
RdrNameHsTyVar, RdrNamePat, RdrNameHsExpr, RdrNameGRHSs,
RdrNameHsRecordBinds, RdrNameMonoBinds, RdrNameConDetails
)
import RdrName
import PrelNames ( unitTyCon_RDR, minus_RDR )
import CallConv
import OccName ( dataName, varName, tcClsName,
occNameSpace, setOccNameSpace, occNameUserString )
......@@ -202,7 +202,9 @@ checkPat e [] = case e of
OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral k _))
| plus == plus_RDR
-> returnP (mkNPlusKPatIn n lit)
-> returnP (NPlusKPatIn n lit minus_RDR)
where
plus_RDR = mkUnqual varName SLIT("+") -- Hack
OpApp l op fix r -> checkPat l [] `thenP` \l ->
checkPat r [] `thenP` \r ->
......@@ -334,6 +336,4 @@ groupBindings binds = group Nothing binds
= case bind of
RdrValBinding b@(FunMonoBind _ _ _ _) -> group (Just b) binds
other -> bind `RdrAndBindings` group Nothing binds
plus_RDR = mkUnqual varName SLIT("+")
\end{code}
ghc/compiler/parser/Parser.y
+ 4
− 4
View file @ da162afc
{-
-----------------------------------------------------------------------------
$Id: Parser.y,v 1.45 2000/10/26 16:51:44 sewardj Exp $
$Id: Parser.y,v 1.46 2000/10/31 17:30:17 simonpj Exp $
Haskell grammar.
......@@ -19,7 +19,7 @@ import RdrHsSyn
import Lex
import ParseUtil
import RdrName
import PrelInfo ( mAIN_Name )
import PrelNames
import OccName ( UserFS, varName, ipName, tcName, dataName, tcClsName, tvName )
import SrcLoc ( SrcLoc )
import Module
......@@ -732,8 +732,8 @@ aexp1 :: { RdrNameHsExpr }
: ipvar { HsIPVar $1 }
| var_or_con { $1 }
| literal { HsLit $1 }
| INTEGER { HsOverLit (mkHsIntegralLit $1) }
| RATIONAL { HsOverLit (mkHsFractionalLit $1) }
| INTEGER { HsOverLit (HsIntegral $1 fromInteger_RDR) }
| RATIONAL { HsOverLit (HsFractional $1 fromRational_RDR) }
| '(' exp ')' { HsPar $2 }
| '(' exp ',' texps ')' { ExplicitTuple ($2 : reverse $4) Boxed}
| '(#' texps '#)' { ExplicitTuple (reverse $2) Unboxed }
......
ghc/compiler/parser/RdrHsSyn.lhs
+ 14
− 58
View file @ da162afc
......@@ -50,13 +50,7 @@ module RdrHsSyn (
extractHsCtxtRdrTyVars, extractGenericPatTyVars,
mkHsOpApp, mkClassDecl, mkClassOpSig, mkConDecl,
mkHsNegApp, mkHsIntegralLit, mkHsFractionalLit, mkNPlusKPatIn,
-- some built-in names (all :: RdrName)
unitCon_RDR, unitTyCon_RDR, nilCon_RDR, listTyCon_RDR,
tupleCon_RDR, tupleTyCon_RDR, ubxTupleCon_RDR, ubxTupleTyCon_RDR,
funTyCon_RDR,
mkHsNegApp,
cvBinds,
cvMonoBindsAndSigs,
......@@ -68,18 +62,16 @@ module RdrHsSyn (
#include "HsVersions.h"
import HsSyn -- Lots of it
import CmdLineOpts ( opt_NoImplicitPrelude )
import HsPat ( collectSigTysFromPats )
import OccName ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc,
mkSuperDictSelOcc, mkDefaultMethodOcc, mkGenOcc1,
mkGenOcc2, varName, dataName, tcName
mkGenOcc2,
)
import PrelNames ( pRELUDE_Name, mkTupNameStr )
import RdrName ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc,
mkUnqual, mkPreludeQual
import PrelNames ( negate_RDR )
import RdrName ( RdrName, isRdrTyVar, mkRdrIfaceUnqual, rdrNameOcc,
)
import List ( nub )
import BasicTypes ( Boxity(..), RecFlag(..) )
import BasicTypes ( RecFlag(..) )
import Class ( DefMeth (..) )
\end{code}
......@@ -224,10 +216,10 @@ mkClassDecl cxt cname tyvars fds sigs mbinds loc
where
cls_occ = rdrNameOcc cname
data_occ = mkClassDataConOcc cls_occ
dname = mkRdrUnqual data_occ
dwname = mkRdrUnqual (mkWorkerOcc data_occ)
tname = mkRdrUnqual (mkClassTyConOcc cls_occ)
sc_sel_names = [ mkRdrUnqual (mkSuperDictSelOcc n cls_occ)
dname = mkRdrIfaceUnqual data_occ
dwname = mkRdrIfaceUnqual (mkWorkerOcc data_occ)
tname = mkRdrIfaceUnqual (mkClassTyConOcc cls_occ)
sc_sel_names = [ mkRdrIfaceUnqual (mkSuperDictSelOcc n cls_occ)
| n <- [1..length cxt]]
-- We number off the superclass selectors, 1, 2, 3 etc so that we
-- can construct names for the selectors. Thus
......@@ -241,22 +233,22 @@ mkClassDecl cxt cname tyvars fds sigs mbinds loc
-- mkTyData :: ??
mkTyData new_or_data context tname list_var list_con i maybe src
= let t_occ = rdrNameOcc tname
name1 = mkRdrUnqual (mkGenOcc1 t_occ)
name2 = mkRdrUnqual (mkGenOcc2 t_occ)
name1 = mkRdrIfaceUnqual (mkGenOcc1 t_occ)
name2 = mkRdrIfaceUnqual (mkGenOcc2 t_occ)
in TyData new_or_data context
tname list_var list_con i maybe src name1 name2
mkClassOpSig (DefMeth x) op ty loc
= ClassOpSig op (Just (DefMeth dm_rn)) ty loc
where
dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc op))
dm_rn = mkRdrIfaceUnqual (mkDefaultMethodOcc (rdrNameOcc op))
mkClassOpSig x op ty loc =
ClassOpSig op (Just x) ty loc
mkConDecl cname ex_vars cxt details loc
= ConDecl cname wkr_name ex_vars cxt details loc
where
wkr_name = mkRdrUnqual (mkWorkerOcc (rdrNameOcc cname))
wkr_name = mkRdrIfaceUnqual (mkWorkerOcc (rdrNameOcc cname))
\end{code}
\begin{code}
......@@ -278,19 +270,7 @@ mkHsNegApp (HsLit (HsDoublePrim i)) = HsLit (HsDoublePrim (-i))
mkHsNegApp (HsOverLit (HsIntegral i n)) = HsOverLit (HsIntegral (-i) n)
mkHsNegApp (HsOverLit (HsFractional f n)) = HsOverLit (HsFractional (-f) n)
mkHsNegApp expr = NegApp expr (prelQual varName SLIT("negate"))
\end{code}
\begin{code}
mkHsIntegralLit :: Integer -> HsOverLit RdrName
mkHsIntegralLit i = HsIntegral i (prelQual varName SLIT("fromInteger"))
mkHsFractionalLit :: Rational -> HsOverLit RdrName
mkHsFractionalLit f = HsFractional f (prelQual varName SLIT("fromRational"))
mkNPlusKPatIn :: RdrName -> HsOverLit RdrName -> RdrNamePat
mkNPlusKPatIn n k = NPlusKPatIn n k (prelQual varName SLIT("-"))
mkHsNegApp expr = NegApp expr negate_RDR
\end{code}
A useful function for building @OpApps@. The operator is always a
......@@ -300,30 +280,6 @@ variable, and we don't know the fixity yet.
mkHsOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
\end{code}
\begin{code}
-----------------------------------------------------------------------------
-- Built-in names
-- Qualified Prelude names are always in scope; so we can just say Prelude.[]
-- for the list type constructor, say. But it's not so easy when we say
-- -fno-implicit-prelude. Then you just get whatever "[]" happens to be in scope.
unitCon_RDR, unitTyCon_RDR, nilCon_RDR, listTyCon_RDR :: RdrName
tupleCon_RDR, tupleTyCon_RDR :: Int -> RdrName
ubxTupleCon_RDR, ubxTupleTyCon_RDR :: Int -> RdrName
unitCon_RDR = prelQual dataName SLIT("()")
unitTyCon_RDR = prelQual tcName SLIT("()")
nilCon_RDR = prelQual dataName SLIT("[]")
listTyCon_RDR = prelQual tcName SLIT("[]")
funTyCon_RDR = prelQual tcName SLIT("(->)")
tupleCon_RDR arity = prelQual dataName (snd (mkTupNameStr Boxed arity))
tupleTyCon_RDR arity = prelQual tcName (snd (mkTupNameStr Boxed arity))
ubxTupleCon_RDR arity = prelQual dataName (snd (mkTupNameStr Unboxed arity))
ubxTupleTyCon_RDR arity = prelQual tcName (snd (mkTupNameStr Unboxed arity))
prelQual ns occ | opt_NoImplicitPrelude = mkUnqual ns occ
| otherwise = mkPreludeQual ns pRELUDE_Name occ
\end{code}
%************************************************************************
%* *
......
ghc/compiler/prelude/PrelNames.lhs
+ 84
− 58
View file @ da162afc
......@@ -37,8 +37,8 @@ module PrelNames (
#include "HsVersions.h"
import Module ( ModuleName, mkPrelModule, mkModuleName )
import OccName ( NameSpace, varName, dataName, tcName, clsName )
import RdrName ( RdrName, mkPreludeQual )
import OccName ( NameSpace, UserFS, varName, dataName, tcName, clsName )
import RdrName ( RdrName, mkOrig )
import UniqFM
import Unique ( Unique, Uniquable(..), hasKey,
mkPreludeMiscIdUnique, mkPreludeDataConUnique,
......@@ -217,7 +217,7 @@ pREL_FLOAT = mkPrelModule pREL_FLOAT_Name
%************************************************************************
\begin{code}
mkTupNameStr :: Boxity -> Int -> (ModuleName, FAST_STRING)
mkTupNameStr :: Boxity -> Int -> (ModuleName, UserFS)
mkTupNameStr Boxed 0 = (pREL_BASE_Name, SLIT("()"))
mkTupNameStr Boxed 1 = panic "Name.mkTupNameStr: 1 ???"
......@@ -235,7 +235,7 @@ mkTupNameStr Unboxed n = (pREL_GHC_Name, _PK_ ("(#" ++ nOfThem (n-1) ',' ++ "#)"
mkTupConRdrName :: NameSpace -> Boxity -> Arity -> RdrName
mkTupConRdrName space boxity arity = case mkTupNameStr boxity arity of
(mod, occ) -> mkPreludeQual space mod occ
(mod, occ) -> mkOrig space mod occ
\end{code}
......@@ -245,7 +245,7 @@ mkTupConRdrName space boxity arity = case mkTupNameStr boxity arity of
%* *
%************************************************************************
These RdrNames are not really "built in", but some parts of the
Many of these Names are not really "built in", but some parts of the
compiler (notably the deriving mechanism) need to mention their names,
and it's convenient to write them all down in one place.
......@@ -417,16 +417,21 @@ The following names are known to the compiler, but they don't require
pre-assigned keys. Mostly these names are used in generating deriving
code, which is passed through the renamer anyway.
THEY ARE ALL ORIGINAL NAMES, HOWEVER
\begin{code}
unpackCString_RDR = varQual_RDR pREL_BASE_Name SLIT("unpackCString#")
unpackCStringFoldr_RDR = varQual_RDR pREL_BASE_Name SLIT("unpackFoldrCString#")
unpackCStringUtf8_RDR = varQual_RDR pREL_BASE_Name SLIT("unpackCStringUtf8#")
deRefStablePtr_RDR = varQual_RDR pREL_STABLE_Name SLIT("deRefStablePtr")
makeStablePtr_RDR = varQual_RDR pREL_STABLE_Name SLIT("makeStablePtr")
bindIO_RDR = varQual_RDR pREL_IO_BASE_Name SLIT("bindIO")
returnIO_RDR = varQual_RDR pREL_IO_BASE_Name SLIT("returnIO")
main_RDR = varQual_RDR mAIN_Name SLIT("main")
-- Lists and tuples
tupleCon_RDR, tupleTyCon_RDR :: Int -> RdrName
ubxTupleCon_RDR, ubxTupleTyCon_RDR :: Int -> RdrName
tupleCon_RDR = mkTupConRdrName dataName Boxed
tupleTyCon_RDR = mkTupConRdrName tcName Boxed
ubxTupleCon_RDR = mkTupConRdrName dataName Unboxed
ubxTupleTyCon_RDR = mkTupConRdrName tcName Unboxed
unitCon_RDR = dataQual_RDR pREL_BASE_Name SLIT("()")
unitTyCon_RDR = tcQual_RDR pREL_BASE_Name SLIT("()")
and_RDR = varQual_RDR pREL_BASE_Name SLIT("&&")
not_RDR = varQual_RDR pREL_BASE_Name SLIT("not")
compose_RDR = varQual_RDR pREL_BASE_Name SLIT(".")
......@@ -464,20 +469,78 @@ maxBound_RDR = varQual_RDR pREL_ENUM_Name SLIT("maxBound")
assertErr_RDR = varQual_RDR pREL_ERR_Name SLIT("assertError")
\end{code}
These RDR names also have known keys, so we need to get back the RDR names to
populate the occurrence list above.
\begin{code}
funTyCon_RDR = nameRdrName funTyConName
nilCon_RDR = nameRdrName nilDataConName
listTyCon_RDR = nameRdrName listTyConName
ioTyCon_RDR = nameRdrName ioTyConName
intTyCon_RDR = nameRdrName intTyConName
eq_RDR = nameRdrName eqName
ge_RDR = nameRdrName geName
numClass_RDR = nameRdrName numClassName
ordClass_RDR = nameRdrName ordClassName
map_RDR = nameRdrName mapName
append_RDR = nameRdrName appendName
foldr_RDR = nameRdrName foldrName
build_RDR = nameRdrName buildName
enumFromTo_RDR = nameRdrName enumFromToName
returnM_RDR = nameRdrName returnMName
thenM_RDR = nameRdrName thenMName
failM_RDR = nameRdrName failMName
false_RDR = nameRdrName falseDataConName
true_RDR = nameRdrName trueDataConName
error_RDR = nameRdrName errorName
getTag_RDR = nameRdrName getTagName
fromEnum_RDR = nameRdrName fromEnumName
toEnum_RDR = nameRdrName toEnumName
enumFrom_RDR = nameRdrName enumFromName
mkInt_RDR = nameRdrName intDataConName
enumFromThen_RDR = nameRdrName enumFromThenName
enumFromThenTo_RDR = nameRdrName enumFromThenToName
ratioDataCon_RDR = nameRdrName ratioDataConName
plusInteger_RDR = nameRdrName plusIntegerName
timesInteger_RDR = nameRdrName timesIntegerName
enumClass_RDR = nameRdrName enumClassName
monadClass_RDR = nameRdrName monadClassName
ioDataCon_RDR = nameRdrName ioDataConName
cCallableClass_RDR = nameRdrName cCallableClassName
cReturnableClass_RDR = nameRdrName cReturnableClassName
eqClass_RDR = nameRdrName eqClassName
eqString_RDR = nameRdrName eqStringName
unpackCString_RDR = nameRdrName unpackCStringName
unpackCStringFoldr_RDR = nameRdrName unpackCStringFoldrName
unpackCStringUtf8_RDR = nameRdrName unpackCStringUtf8Name
deRefStablePtr_RDR = nameRdrName deRefStablePtrName
makeStablePtr_RDR = nameRdrName makeStablePtrName
bindIO_RDR = nameRdrName bindIOName
returnIO_RDR = nameRdrName returnIOName
main_RDR = nameRdrName mainName
fromInteger_RDR = nameRdrName fromIntegerName
fromRational_RDR = nameRdrName fromRationalName
minus_RDR = nameRdrName minusName
\end{code}
%************************************************************************
%* *
\subsection{Local helpers}
%* *
%************************************************************************
\begin{code}
varQual mod str uq = mkKnownKeyGlobal (mkPreludeQual varName mod str) uq
dataQual mod str uq = mkKnownKeyGlobal (mkPreludeQual dataName mod str) uq
tcQual mod str uq = mkKnownKeyGlobal (mkPreludeQual tcName mod str) uq
clsQual mod str uq = mkKnownKeyGlobal (mkPreludeQual clsName mod str) uq
All these are original names; hence mkOrig
varQual_RDR mod str = mkPreludeQual varName mod str
dataQual_RDR mod str = mkPreludeQual dataName mod str
\begin{code}
varQual mod str uq = mkKnownKeyGlobal (varQual_RDR mod str) uq
dataQual mod str uq = mkKnownKeyGlobal (dataQual_RDR mod str) uq
tcQual mod str uq = mkKnownKeyGlobal (tcQual_RDR mod str) uq
clsQual mod str uq = mkKnownKeyGlobal (clsQual_RDR mod str) uq
varQual_RDR mod str = mkOrig varName mod str
tcQual_RDR mod str = mkOrig tcName mod str
clsQual_RDR mod str = mkOrig clsName mod str
dataQual_RDR mod str = mkOrig dataName mod str
\end{code}
%************************************************************************
......@@ -790,43 +853,6 @@ deriving_occ_info
-- or for taggery.
-- ordClass: really it's the methods that are actually used.
-- numClass: for Int literals
-- these RDR names also have known keys, so we need to get back the RDR names to
-- populate the occurrence list above.
ioTyCon_RDR = nameRdrName ioTyConName
intTyCon_RDR = nameRdrName intTyConName
eq_RDR = nameRdrName eqName
ge_RDR = nameRdrName geName
numClass_RDR = nameRdrName numClassName
ordClass_RDR = nameRdrName ordClassName
map_RDR = nameRdrName mapName
append_RDR = nameRdrName appendName
foldr_RDR = nameRdrName foldrName
build_RDR = nameRdrName buildName
enumFromTo_RDR = nameRdrName enumFromToName
returnM_RDR = nameRdrName returnMName
thenM_RDR = nameRdrName thenMName
failM_RDR = nameRdrName failMName
false_RDR = nameRdrName falseDataConName
true_RDR = nameRdrName trueDataConName
error_RDR = nameRdrName errorName
getTag_RDR = nameRdrName getTagName
fromEnum_RDR = nameRdrName fromEnumName
toEnum_RDR = nameRdrName toEnumName
enumFrom_RDR = nameRdrName enumFromName
mkInt_RDR = nameRdrName intDataConName
enumFromThen_RDR = nameRdrName enumFromThenName
enumFromThenTo_RDR = nameRdrName enumFromThenToName
ratioDataCon_RDR = nameRdrName ratioDataConName
plusInteger_RDR = nameRdrName plusIntegerName
timesInteger_RDR = nameRdrName timesIntegerName
enumClass_RDR = nameRdrName enumClassName
monadClass_RDR = nameRdrName monadClassName
ioDataCon_RDR = nameRdrName ioDataConName
cCallableClass_RDR = nameRdrName cCallableClassName
cReturnableClass_RDR = nameRdrName cReturnableClassName
eqClass_RDR = nameRdrName eqClassName
eqString_RDR = nameRdrName eqStringName
\end{code}
......
ghc/compiler/prelude/PrimOp.lhs
+ 2
− 2
View file @ da162afc
......@@ -33,7 +33,7 @@ import Demand ( wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
import Var ( TyVar )
import CallConv ( CallConv, pprCallConv )
import Name ( Name, mkWiredInName )
import RdrName ( RdrName, mkRdrQual )
import RdrName ( RdrName, mkRdrOrig )
import OccName ( OccName, pprOccName, mkVarOcc )
import TyCon ( TyCon, tyConArity )
import Type ( Type, mkForAllTys, mkFunTy, mkFunTys, mkTyVarTys,
......@@ -445,7 +445,7 @@ mkPrimOpIdName op
= mkWiredInName pREL_GHC (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
primOpRdrName :: PrimOp -> RdrName
primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
primOpRdrName op = mkRdrOrig pREL_GHC_Name (primOpOcc op)
primOpOcc :: PrimOp -> OccName
primOpOcc op = case (primOpInfo op) of
......
ghc/compiler/prelude/TysPrim.lhs
+ 2
− 2
View file @ da162afc
......@@ -57,7 +57,7 @@ import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
)
import Unique ( Unique, mkAlphaTyVarUnique )
import Name ( mkKnownKeyGlobal )
import RdrName ( mkPreludeQual )
import RdrName ( mkOrig )
import PrelNames
import Outputable
\end{code}
......@@ -151,7 +151,7 @@ pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ArgVrcs -> PrimRep ->
pcPrimTyCon key str arity arg_vrcs rep
= the_tycon
where
name = mkKnownKeyGlobal (mkPreludeQual tcName pREL_GHC_Name str) key
name = mkKnownKeyGlobal (mkOrig tcName pREL_GHC_Name str) key
the_tycon = mkPrimTyCon name kind arity arg_vrcs rep
kind = mkArrowKinds (take arity (repeat boxedTypeKind)) result_kind
result_kind | isFollowableRep rep = boxedTypeKind -- Represented by a GC-ish ptr
......
ghc/compiler/rename/ParseIface.y
+ 14
− 17
View file @ da162afc
......@@ -53,7 +53,7 @@ import HscTypes ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..),
ImportVersion, WhatsImported(..),
RdrAvailInfo )
import RdrName ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
import RdrName ( RdrName, mkRdrIfaceUnqual, mkIfaceOrig )
import Name ( OccName )
import OccName ( mkSysOccFS,
tcName, varName, ipName, dataName, clsName, tvName, uvName,
......@@ -606,14 +606,14 @@ var_occ :: { OccName }
: var_fs { mkSysOccFS varName $1 }
var_name :: { RdrName }
var_name : var_occ { mkRdrUnqual $1 }
var_name : var_occ { mkRdrIfaceUnqual $1 }
qvar_name :: { RdrName }
qvar_name : var_name { $1 }
| qvar_fs { mkSysQual varName $1 }
| qvar_fs { mkIfaceOrig varName $1 }
ipvar_name :: { RdrName }
: IPVARID { mkSysUnqual ipName (tailFS $1) }
: IPVARID { mkRdrIfaceUnqual (mkSysOccFS ipName (tailFS $1)) }
var_names :: { [RdrName] }
var_names : { [] }
......@@ -640,41 +640,38 @@ data_occ :: { OccName }
: data_fs { mkSysOccFS dataName $1 }
data_name :: { RdrName }
: data_occ { mkRdrUnqual $1 }
: data_occ { mkRdrIfaceUnqual $1 }
qdata_name :: { RdrName }
qdata_name : data_name { $1 }
| qdata_fs { mkSysQual dataName $1 }
| qdata_fs { mkIfaceOrig dataName $1 }
var_or_data_name :: { RdrName }
: var_name { $1 }
| data_name { $1 }
---------------------------------------------------
tc_fs :: { EncodedFS }
: data_fs { $1 }
tc_occ :: { OccName }
: tc_fs { mkSysOccFS tcName $1 }
: data_fs { mkSysOccFS tcName $1 }
tc_name :: { RdrName }
: tc_occ { mkRdrUnqual $1 }
: tc_occ { mkRdrIfaceUnqual $1 }
qtc_name :: { RdrName }
: tc_name { $1 }
| qdata_fs { mkSysQual tcName $1 }
| qdata_fs { mkIfaceOrig tcName $1 }
---------------------------------------------------
cls_name :: { RdrName }
: data_fs { mkSysUnqual clsName $1 }
: data_fs { mkRdrIfaceUnqual (mkSysOccFS clsName $1) }
qcls_name :: { RdrName }
: cls_name { $1 }
| qdata_fs { mkSysQual clsName $1 }
| qdata_fs { mkIfaceOrig clsName $1 }
---------------------------------------------------
uv_name :: { RdrName }
: VARID { mkSysUnqual uvName $1 }
: VARID { mkRdrIfaceUnqual (mkSysOccFS uvName $1) }
uv_bndr :: { RdrName }
: uv_name { $1 }
......@@ -685,8 +682,8 @@ uv_bndrs :: { [RdrName] }
---------------------------------------------------
tv_name :: { RdrName }
: VARID { mkSysUnqual tvName $1 }
| VARSYM { mkSysUnqual tvName $1 {- Allow t2 as a tyvar -} }
: VARID { mkRdrIfaceUnqual (mkSysOccFS tvName $1) }
| VARSYM { mkRdrIfaceUnqual (mkSysOccFS tvName $1) {- Allow t2 as a tyvar -} }
tv_bndr :: { HsTyVarBndr RdrName }
: tv_name '::' akind { IfaceTyVar $1 $3 }
......
ghc/compiler/rename/RnEnv.lhs
+ 47
− 65
View file @ da162afc
......@@ -10,8 +10,8 @@ module RnEnv where -- Export everything
import HsSyn
import RdrHsSyn ( RdrNameIE )
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
mkRdrUnqual, qualifyRdrName, lookupRdrEnv
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isSourceQual, isUnqual, isIface,
mkRdrUnqual, mkRdrIfaceUnqual, qualifyRdrName, lookupRdrEnv
)
import HsTypes ( hsTyVarName, replaceTyVarName )
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
......@@ -29,7 +29,6 @@ import NameSet
import OccName ( OccName, occNameUserString, occNameFlavour )
import Module ( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS )
import FiniteMap
import Unique ( Unique )
import UniqSupply
import SrcLoc ( SrcLoc, noSrcLoc )
import Outputable
......@@ -62,7 +61,7 @@ newTopBinder mod rdr_name loc
-- There should never be a qualified name in a binding position (except in instance decls)
-- The parser doesn't check this because the same parser parses instance decls
(if isQual rdr_name then
(if isSourceQual rdr_name then
qualNameErr (text "its declaration") (rdr_name,loc)
else
returnRn ()
......@@ -172,28 +171,15 @@ lookupBndrRn rdr_name
Nothing -> lookupTopBndrRn rdr_name
lookupTopBndrRn rdr_name
= getModeRn `thenRn` \ mode ->
case mode of
InterfaceMode -> -- Look in the global name cache
lookupOrigName rdr_name
SourceMode -> -- Source mode, so look up a *qualified* version
-- of the name, so that we get the right one even
-- if there are many with the same occ name
-- There must *be* a binding
getModuleRn `thenRn` \ mod ->
getGlobalNameEnv `thenRn` \ global_env ->
case lookupRdrEnv global_env (qualifyRdrName (moduleName mod) rdr_name) of
Just ((name,_):rest) -> ASSERT( null rest )
returnRn name
Nothing -> -- Almost always this case is a compiler bug.
-- But consider a type signature that doesn't have
-- a corresponding binder:
-- module M where { f :: Int->Int }
-- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons)
-- and we don't want to panic. So we report an out-of-scope error
failWithRn (mkUnboundName rdr_name)
(unknownNameErr rdr_name)
| isIface rdr_name
= lookupOrigName rdr_name
| otherwise -- Source mode, so look up a *qualified* version
= -- of the name, so that we get the right one even
-- if there are many with the same occ name
-- There must *be* a binding
getModuleRn `thenRn` \ mod ->
lookupSrcGlobalOcc (qualifyRdrName (moduleName mod) rdr_name)
-- lookupSigOccRn is used for type signatures and pragmas
-- Is this valid?
......@@ -220,25 +206,23 @@ lookupOccRn rdr_name
-- environment. It's used only for
-- record field names
-- class op names in class and instance decls
lookupGlobalOccRn rdr_name
= getModeRn `thenRn` \ mode ->
case mode of {
-- When processing interface files, the global env
-- is always empty, so go straight to the name cache
InterfaceMode -> lookupOrigName rdr_name ;
| isIface rdr_name
= lookupOrigName rdr_name
SourceMode ->
| otherwise
= lookupSrcGlobalOcc rdr_name
getGlobalNameEnv `thenRn` \ global_env ->
lookupSrcGlobalOcc rdr_name
-- Lookup a source-code rdr-name
= getGlobalNameEnv `thenRn` \ global_env ->
case lookupRdrEnv global_env rdr_name of
Just [(name,_)] -> returnRn name
Just stuff@((name,_):_)
-> addNameClashErrRn rdr_name stuff `thenRn_`
returnRn name
Nothing -> -- Not found when processing source code; so fail
failWithRn (mkUnboundName rdr_name)
(unknownNameErr rdr_name)
}
Just [(name,_)] -> returnRn name
Just stuff@((name,_):_) -> addNameClashErrRn rdr_name stuff `thenRn_`
returnRn name
Nothing -> failWithRn (mkUnboundName rdr_name)
(unknownNameErr rdr_name)
lookupGlobalRn :: GlobalRdrEnv -> RdrName -> RnM d (Maybe Name)
-- Checks that there is exactly one
......@@ -273,15 +257,15 @@ The name cache should have the correct provenance, though.
\begin{code}
lookupOrigName :: RdrName -> RnM d Name
lookupOrigName rdr_name
| isQual rdr_name
= newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
| otherwise
= -- An Unqual is allowed; interface files contain
= ASSERT( isIface rdr_name )
if isQual rdr_name then
newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
else
-- An Unqual is allowed; interface files contain
-- unqualified names for locally-defined things, such as
-- constructors of a data type.
getModuleRn `thenRn ` \ mod ->
newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
getModuleRn `thenRn ` \ mod ->
newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
lookupOrigNames :: [RdrName] -> RnM d NameSet
lookupOrigNames rdr_names
......@@ -311,16 +295,15 @@ lookupSysBinder rdr_name
%*********************************************************
\begin{code}
newLocalsRn :: (Unique -> OccName -> SrcLoc -> Name)
-> [(RdrName,SrcLoc)]
newLocalsRn :: [(RdrName,SrcLoc)]
-> RnMS [Name]
newLocalsRn mk_name rdr_names_w_loc
newLocalsRn rdr_names_w_loc
= getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
let
n = length rdr_names_w_loc
(us', us1) = splitUniqSupply us
uniqs = uniqsFromSupply n us1
names = [ mk_name uniq (rdrNameOcc rdr_name) loc
names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
| ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
]
in
......@@ -339,7 +322,7 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
-- Check for duplicate names
checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
-- Warn about shadowing, but only in source modules
(case mode of
......@@ -347,14 +330,7 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
other -> returnRn ()
) `thenRn_`
let
mk_name = case mode of
SourceMode -> mkLocalName
InterfaceMode -> mkImportedLocalName
-- Keep track of whether the name originally came from
-- an interface file.
in
newLocalsRn mk_name rdr_names_w_loc `thenRn` \ names ->
newLocalsRn rdr_names_w_loc `thenRn` \ names ->
let
new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
in
......@@ -395,11 +371,17 @@ bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
thing_inside (name':names')
bindLocalNames names enclosed_scope
= getLocalNameEnv `thenRn` \ name_env ->
= getModeRn `thenRn` \ mode ->
let
-- This is gruesome, but I can't think of a better way just now
mk_rdr_name = case mode of
SourceMode -> mkRdrUnqual
InterfaceMode -> mkRdrIfaceUnqual
pairs = [(mk_rdr_name (nameOccName n), n) | n <- names]
in
getLocalNameEnv `thenRn` \ name_env ->
setLocalNameEnv (addListToRdrEnv name_env pairs)
enclosed_scope
where
pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
-------------------------------------
bindLocalRn doc rdr_name enclosed_scope
......@@ -491,7 +473,7 @@ checkDupOrQualNames doc_str rdr_names_w_loc
mapRn_ (qualNameErr doc_str) quals `thenRn_`
checkDupNames doc_str rdr_names_w_loc
where
quals = filter (isQual.fst) rdr_names_w_loc
quals = filter (isSourceQual . fst) rdr_names_w_loc
checkDupNames doc_str rdr_names_w_loc
= -- Check for duplicated names in a binding group
......
ghc/compiler/rename/RnNames.lhs
+ 16
− 15
View file @ da162afc
......@@ -10,7 +10,7 @@ module RnNames (
#include "HsVersions.h"
import CmdLineOpts ( DynFlag(..), opt_NoImplicitPrelude )
import CmdLineOpts ( DynFlag(..) )
import HsSyn ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..),
ForeignDecl(..), ForKind(..), isDynamicExtName,
......@@ -82,7 +82,9 @@ getGlobalNames this_mod (HsModule _ _ exports imports decls _ mod_loc)
-- PROCESS IMPORT DECLS
-- Do the non {- SOURCE -} ones first, so that we get a helpful
-- warning for {- SOURCE -} ones that are unnecessary
doptRn Opt_NoImplicitPrelude `thenRn` \ opt_no_prelude ->
let
all_imports = mk_prel_imports opt_no_prelude ++ imports
(source, ordinary) = partition is_source_import all_imports
is_source_import (ImportDecl _ ImportByUserSource _ _ _ _) = True
is_source_import other = False
......@@ -117,22 +119,22 @@ getGlobalNames this_mod (HsModule _ _ exports imports decls _ mod_loc)
)
where
this_mod_name = moduleName this_mod
all_imports = prel_imports ++ imports
-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-- because the former doesn't even look at Prelude.hi for instance declarations,
-- whereas the latter does.
prel_imports | this_mod_name == pRELUDE_Name ||
explicit_prelude_import ||
opt_NoImplicitPrelude
= []
| otherwise = [ImportDecl pRELUDE_Name
ImportByUser
False {- Not qualified -}
Nothing {- No "as" -}
Nothing {- No import list -}
mod_loc]
mk_prel_imports no_prelude
| this_mod_name == pRELUDE_Name ||
explicit_prelude_import ||
no_prelude
= []
| otherwise = [ImportDecl pRELUDE_Name
ImportByUser
False {- Not qualified -}
Nothing {- No "as" -}
Nothing {- No import list -}
mod_loc]
explicit_prelude_import
= not (null [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ])
......@@ -222,8 +224,7 @@ getLocalDeclBinders mod rec_exp_fn (ForD (ForeignDecl nm kind _ ext_nm _ loc))
returnRn [avail]
| otherwise -- a foreign export
= lookupOrigName nm `thenRn_`
returnRn []
= returnRn []
where
binds_haskell_name (FoImport _) = True
binds_haskell_name FoLabel = True
......
ghc/compiler/rename/RnSource.lhs
+ 1
− 1
View file @ da162afc
......@@ -409,7 +409,7 @@ rnClassBinds (ClassDecl _ _ _ _ _ mbinds _ _ ) -- G
not (tv `elemRdrEnv` name_env)]
in
checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
newLocalsRn mkLocalName gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
newLocalsRn gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
returnRn (ClassDecl context cname tyvars fds sigs mbinds' names src_loc, meth_fvs)
where
......
ghc/compiler/types/Generics.lhs
+ 1
− 1
View file @ da162afc
......@@ -231,7 +231,7 @@ mkTyConGenInfo :: DynFlags -> TyCon -> Name -> Name -> Maybe (EP Id)
-- for the fromT and toT conversion functions.
mkTyConGenInfo dflags tycon from_name to_name
| dopt Opt_Generics dflags
| not (dopt Opt_Generics dflags)
= Nothing
| null datacons -- Abstractly imported types don't have
......
ghc/compiler/types/InstEnv.lhs
+ 1
− 1
View file @ da162afc
......@@ -276,7 +276,7 @@ extendInstEnv dflags env infos
go env msgs [] = (env, msgs)
go env msgs (dfun:dfuns) = case addToInstEnv dflags env dfun of
Succeeded new_env -> go new_env msgs dfuns
Failed dfun' -> go env (msg:msgs) infos
Failed dfun' -> go env (msg:msgs) dfuns
where
msg = dupInstErr dfun dfun'
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment