Commit bb88e732 authored by simonpj's avatar simonpj

[project @ 2004-08-26 15:44:50 by simonpj]

-------------------------------
	Print built-in sytax right
	-------------------------------

Built-in syntax, like (:) and [], is not "in scope" via the GlobalRdrEnv
in the usual way.  When we print it out, we should also print it in unqualified
form, even though it's not in the environment.

I've finally bitten the (not very big) bullet, and added to Name the information
about whether or not a name is one of these built-in ones.  That entailed changing
the calls to mkWiredInName, but those are exactly the places where you have to
decide whether it's built-in or not, which is fine.


Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])

Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler,
		   not read from an interface file.
		   E.g. Bool, True, Int, Float, and many others

All built-in syntax is for wired-in things.
parent f5eaddd4
......@@ -58,7 +58,7 @@ import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
import Class ( Class, classTyCon, classTyVars, classSelIds )
import Var ( Id, TyVar, Var )
import VarSet ( isEmptyVarSet )
import Name ( mkFCallName, mkWiredInName, Name )
import Name ( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..) )
import OccName ( mkOccFS, varName )
import PrimOp ( PrimOp, primOpSig, primOpOcc, primOpTag )
import ForeignCall ( ForeignCall )
......@@ -663,7 +663,7 @@ mkPrimOpId prim_op
ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
(mkPrimOpIdUnique (primOpTag prim_op))
Nothing (AnId id)
Nothing (AnId id) UserSyntax
id = mkGlobalId (PrimOpId prim_op) name ty info
info = noCafIdInfo
......@@ -807,7 +807,7 @@ another gun with which to shoot yourself in the foot.
\begin{code}
mkWiredInIdName mod fs uniq id
= mkWiredInName mod (mkOccFS varName fs) uniq Nothing (AnId id)
= mkWiredInName mod (mkOccFS varName fs) uniq Nothing (AnId id) UserSyntax
unsafeCoerceName = mkWiredInIdName gHC_PRIM FSLIT("unsafeCoerce#") unsafeCoerceIdKey unsafeCoerceId
nullAddrName = mkWiredInIdName gHC_PRIM FSLIT("nullAddr#") nullAddrIdKey nullAddrId
......
......@@ -10,6 +10,7 @@ module Name (
-- The Name type
Name, -- Abstract
BuiltInSyntax(..),
mkInternalName, mkSystemName,
mkSystemNameEncoded, mkSysTvName,
mkFCallName, mkIPName,
......@@ -23,7 +24,7 @@ module Name (
nameSrcLoc, nameParent, nameParent_maybe,
isSystemName, isInternalName, isExternalName,
isTyVarName, isDllName, isWiredInName,
isTyVarName, isDllName, isWiredInName, isBuiltInSyntax,
wiredInNameTyThing_maybe,
nameIsLocalOrFrom, isHomePackageName,
......@@ -70,7 +71,7 @@ data NameSort
-- e.g. data constructor of a data type, method of a class
-- Nothing => not a subordinate
| WiredIn Module (Maybe Name) TyThing
| WiredIn Module (Maybe Name) TyThing BuiltInSyntax
-- A variant of External, for wired-in things
| Internal -- A user-defined Id or TyVar
......@@ -78,6 +79,11 @@ data NameSort
| System -- A system-defined Id or TyVar. Typically the
-- OccName is very uninformative (like 's')
data BuiltInSyntax = BuiltInSyntax | UserSyntax
-- BuiltInSyntax is for things like (:), [], tuples etc,
-- which have special syntactic forms. They aren't "in scope"
-- as such.
\end{code}
Notes about the NameSorts:
......@@ -103,6 +109,14 @@ Notes about the NameSorts:
If any desugarer sys-locals have survived that far, they get changed to
"ds1", "ds2", etc.
Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])
Wired-in thing => The thing (Id, TyCon) is fully known to the compiler,
not read from an interface file.
E.g. Bool, True, Int, Float, and many others
All built-in syntax is for wired-in things.
\begin{code}
nameUnique :: Name -> Unique
nameOccName :: Name -> OccName
......@@ -123,23 +137,26 @@ isSystemName :: Name -> Bool
isHomePackageName :: Name -> Bool
isWiredInName :: Name -> Bool
isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
isWiredInName other = False
isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
isWiredInName other = False
wiredInNameTyThing_maybe :: Name -> Maybe TyThing
wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ _ thing}) = Just thing
wiredInNameTyThing_maybe other = Nothing
wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ _ thing _}) = Just thing
wiredInNameTyThing_maybe other = Nothing
isExternalName (Name {n_sort = External _ _}) = True
isExternalName (Name {n_sort = WiredIn _ _ _}) = True
isExternalName other = False
isBuiltInSyntax (Name {n_sort = WiredIn _ _ _ BuiltInSyntax}) = True
isBuiltInSyntax other = False
isExternalName (Name {n_sort = External _ _}) = True
isExternalName (Name {n_sort = WiredIn _ _ _ _}) = True
isExternalName other = False
isInternalName name = not (isExternalName name)
nameParent_maybe :: Name -> Maybe Name
nameParent_maybe (Name {n_sort = External _ p}) = p
nameParent_maybe (Name {n_sort = WiredIn _ p _}) = p
nameParent_maybe other = Nothing
nameParent_maybe (Name {n_sort = External _ p}) = p
nameParent_maybe (Name {n_sort = WiredIn _ p _ _}) = p
nameParent_maybe other = Nothing
nameParent :: Name -> Name
nameParent name = case nameParent_maybe name of
......@@ -149,9 +166,9 @@ nameParent name = case nameParent_maybe name of
nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
nameModuleName name = moduleName (nameModule name)
nameModule_maybe (Name { n_sort = External mod _}) = Just mod
nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
nameModule_maybe name = Nothing
nameModule_maybe (Name { n_sort = External mod _}) = Just mod
nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
nameModule_maybe name = Nothing
nameIsLocalOrFrom from name
| isExternalName name = from == nameModule name
......@@ -195,10 +212,11 @@ mkExternalName uniq mod occ mb_parent loc
= Name { n_uniq = uniq, n_sort = External mod mb_parent,
n_occ = occ, n_loc = loc }
mkWiredInName :: Module -> OccName -> Unique -> Maybe Name -> TyThing -> Name
mkWiredInName mod occ uniq mb_parent thing
mkWiredInName :: Module -> OccName -> Unique
-> Maybe Name -> TyThing -> BuiltInSyntax -> Name
mkWiredInName mod occ uniq mb_parent thing built_in
= Name { n_uniq = uniq,
n_sort = WiredIn mod mb_parent thing,
n_sort = WiredIn mod mb_parent thing built_in,
n_occ = occ, n_loc = wiredInSrcLoc }
mkSystemName :: Unique -> UserFS -> Name
......@@ -303,12 +321,14 @@ instance OutputableBndr Name where
pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
= getPprStyle $ \ sty ->
case sort of
External mod mb_p -> pprExternal sty uniq mod occ mb_p False
WiredIn mod mb_p thing -> pprExternal sty uniq mod occ mb_p True
System -> pprSystem sty uniq occ
Internal -> pprInternal sty uniq occ
WiredIn mod _ _ BuiltInSyntax -> pprOccName occ -- Built-in syntax is never qualified
WiredIn mod _ _ UserSyntax -> pprExternal sty uniq mod occ True
External mod _ -> pprExternal sty uniq mod occ False
System -> pprSystem sty uniq occ
Internal -> pprInternal sty uniq occ
pprExternal sty uniq mod occ mb_p is_wired
pprExternal sty uniq mod occ is_wired
| unqualStyle sty mod_name occ = pprOccName occ
| codeStyle sty = ppr mod_name <> char '_' <> pprOccName occ
| debugStyle sty = sep [ppr mod_name <> dot <> pprOccName occ,
hsep [text "{-"
......@@ -318,7 +338,6 @@ pprExternal sty uniq mod occ mb_p is_wired
-- Nothing -> empty
-- Just n -> brackets (ppr n)
, text "-}"]]
| unqualStyle sty mod_name occ = pprOccName occ
| otherwise = ppr mod_name <> dot <> pprOccName occ
where
mod_name = moduleName mod
......
......@@ -89,7 +89,6 @@ import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) )
import FiniteMap ( FiniteMap )
import CoreSyn ( IdCoreRule )
import PrelNames ( isBuiltInSyntaxName )
import Maybes ( orElse )
import Outputable
import SrcLoc ( SrcSpan )
......
......@@ -89,25 +89,6 @@ isUnboundName name = name `hasKey` unboundKey
\end{code}
%************************************************************************
%* *
\subsection{Built-in-syntax names
%* *
%************************************************************************
Built-in syntax names are parsed directly into Exact RdrNames.
This predicate just identifies them.
\begin{code}
isBuiltInSyntaxName :: Name -> Bool
isBuiltInSyntaxName n
= isTupleKey uniq
|| uniq `elem` [listTyConKey, nilDataConKey, consDataConKey,
funTyConKey, parrTyConKey]
where
uniq = nameUnique n
\end{code}
%************************************************************************
%* *
\subsection{Known key Names}
......
......@@ -45,7 +45,7 @@ module TysPrim(
#include "HsVersions.h"
import Var ( TyVar, mkTyVar )
import Name ( Name, mkInternalName, mkWiredInName )
import Name ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
import OccName ( mkVarOcc, mkOccFS, tcName )
import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon,
PrimRep(..) )
......@@ -104,6 +104,7 @@ mkPrimTc fs uniq tycon
uniq
Nothing -- No parent object
(ATyCon tycon) -- Relevant TyCon
UserSyntax -- None are built-in syntax
charPrimTyConName = mkPrimTc FSLIT("Char#") charPrimTyConKey charPrimTyCon
intPrimTyConName = mkPrimTc FSLIT("Int#") intPrimTyConKey intPrimTyCon
......
......@@ -60,7 +60,7 @@ import TysPrim
import Constants ( mAX_TUPLE_SIZE )
import Module ( Module )
import RdrName ( nameRdrName )
import Name ( Name, nameUnique, nameOccName,
import Name ( Name, BuiltInSyntax(..), nameUnique, nameOccName,
nameModule, mkWiredInName )
import OccName ( mkOccFS, tcName, dataName, mkTupleOcc, mkDataConWorkerOcc )
import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
......@@ -115,37 +115,39 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
\end{code}
\begin{code}
mkWiredInTyConName :: Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName mod fs uniq tycon
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName built_in mod fs uniq tycon
= mkWiredInName mod (mkOccFS tcName fs) uniq
Nothing -- No parent object
(ATyCon tycon) -- Relevant TyCon
built_in
mkWiredInDataConName :: Module -> FastString -> Unique -> DataCon -> Name -> Name
mkWiredInDataConName mod fs uniq datacon parent
mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name -> Name
mkWiredInDataConName built_in mod fs uniq datacon parent
= mkWiredInName mod (mkOccFS dataName fs) uniq
(Just parent) -- Name of parent TyCon
(ADataCon datacon) -- Relevant DataCon
built_in
charTyConName = mkWiredInTyConName pREL_BASE FSLIT("Char") charTyConKey charTyCon
charDataConName = mkWiredInDataConName pREL_BASE FSLIT("C#") charDataConKey charDataCon charTyConName
intTyConName = mkWiredInTyConName pREL_BASE FSLIT("Int") intTyConKey intTyCon
intDataConName = mkWiredInDataConName pREL_BASE FSLIT("I#") intDataConKey intDataCon intTyConName
charTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Char") charTyConKey charTyCon
charDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("C#") charDataConKey charDataCon charTyConName
intTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Int") intTyConKey intTyCon
intDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("I#") intDataConKey intDataCon intTyConName
boolTyConName = mkWiredInTyConName pREL_BASE FSLIT("Bool") boolTyConKey boolTyCon
falseDataConName = mkWiredInDataConName pREL_BASE FSLIT("False") falseDataConKey falseDataCon boolTyConName
trueDataConName = mkWiredInDataConName pREL_BASE FSLIT("True") trueDataConKey trueDataCon boolTyConName
listTyConName = mkWiredInTyConName pREL_BASE FSLIT("[]") listTyConKey listTyCon
nilDataConName = mkWiredInDataConName pREL_BASE FSLIT("[]") nilDataConKey nilDataCon listTyConName
consDataConName = mkWiredInDataConName pREL_BASE FSLIT(":") consDataConKey consDataCon listTyConName
boolTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Bool") boolTyConKey boolTyCon
falseDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("False") falseDataConKey falseDataCon boolTyConName
trueDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("True") trueDataConKey trueDataCon boolTyConName
listTyConName = mkWiredInTyConName BuiltInSyntax pREL_BASE FSLIT("[]") listTyConKey listTyCon
nilDataConName = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT("[]") nilDataConKey nilDataCon listTyConName
consDataConName = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT(":") consDataConKey consDataCon listTyConName
floatTyConName = mkWiredInTyConName pREL_FLOAT FSLIT("Float") floatTyConKey floatTyCon
floatDataConName = mkWiredInDataConName pREL_FLOAT FSLIT("F#") floatDataConKey floatDataCon floatTyConName
doubleTyConName = mkWiredInTyConName pREL_FLOAT FSLIT("Double") doubleTyConKey doubleTyCon
doubleDataConName = mkWiredInDataConName pREL_FLOAT FSLIT("D#") doubleDataConKey doubleDataCon doubleTyConName
floatTyConName = mkWiredInTyConName UserSyntax pREL_FLOAT FSLIT("Float") floatTyConKey floatTyCon
floatDataConName = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("F#") floatDataConKey floatDataCon floatTyConName
doubleTyConName = mkWiredInTyConName UserSyntax pREL_FLOAT FSLIT("Double") doubleTyConKey doubleTyCon
doubleDataConName = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("D#") doubleDataConKey doubleDataCon doubleTyConName
parrTyConName = mkWiredInTyConName pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon
parrDataConName = mkWiredInDataConName pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName
parrTyConName = mkWiredInTyConName BuiltInSyntax pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon
parrDataConName = mkWiredInDataConName UserSyntax pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName
boolTyCon_RDR = nameRdrName boolTyConName
false_RDR = nameRdrName falseDataConName
......@@ -207,7 +209,7 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
wrk_key = incrUnique (nameUnique dc_name)
wrk_name = mkWiredInName mod wrk_occ wrk_key
(Just (tyConName tycon))
(AnId (dataConWorkId data_con))
(AnId (dataConWorkId data_con)) UserSyntax
bogus_wrap_name = pprPanic "Wired-in data wrapper id" (ppr dc_name)
-- Wired-in types are too simple to need wrappers
\end{code}
......@@ -240,7 +242,7 @@ mk_tuple boxity arity = (tycon, tuple_con)
tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info
mod = mkTupleModule boxity arity
tc_name = mkWiredInName mod (mkTupleOcc tcName boxity arity) tc_uniq
Nothing (ATyCon tycon)
Nothing (ATyCon tycon) BuiltInSyntax
tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
res_kind | isBoxed boxity = liftedTypeKind
| otherwise = ubxTupleKind
......@@ -251,7 +253,7 @@ mk_tuple boxity arity = (tycon, tuple_con)
tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
tyvar_tys = mkTyVarTys tyvars
dc_name = mkWiredInName mod (mkTupleOcc dataName boxity arity) dc_uniq
(Just tc_name) (ADataCon tuple_con)
(Just tc_name) (ADataCon tuple_con) BuiltInSyntax
tc_uniq = mkTupleTyConUnique boxity arity
dc_uniq = mkTupleDataConUnique boxity arity
gen_info = True -- Tuples all have generics..
......@@ -536,7 +538,7 @@ mkPArrFakeCon arity = data_con
tyvarTys = replicate arity $ mkTyVarTy tyvar
nameStr = mkFastString ("MkPArr" ++ show arity)
name = mkWiredInName pREL_PARR (mkOccFS dataName nameStr) uniq
Nothing (ADataCon data_con)
Nothing (ADataCon data_con) UserSyntax
uniq = mkPArrDataConUnique arity
-- checks whether a data constructor is a fake constructor for parallel arrays
......
......@@ -23,14 +23,15 @@ import LoadIface ( loadSrcInterface )
import TcRnMonad
import FiniteMap
import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName,
import PrelNames ( pRELUDE_Name, isUnboundName,
main_RDR_Unqual )
import Module ( Module, ModuleName, moduleName, mkPackageModule,
moduleNameUserString, isHomeModule,
unitModuleEnvByName, unitModuleEnv,
lookupModuleEnvByName, moduleEnvElts )
import Name ( Name, nameSrcLoc, nameOccName, nameModuleName, isWiredInName,
nameParent, nameParent_maybe, isExternalName, nameModule )
nameParent, nameParent_maybe, isExternalName, nameModule,
isBuiltInSyntax )
import NameSet
import NameEnv
import OccName ( srcDataName, isTcOcc, occNameFlavour, OccEnv,
......@@ -336,10 +337,10 @@ importsFromLocalDecls group
avails' | implicit_prelude = filter not_built_in_syntax avails
| otherwise = avails
not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a))
not_built_in_syntax a = not (all isBuiltInSyntax (availNames a))
-- Only filter it if all the names of the avail are built-in
-- In particular, lists have (:) which is not built in syntax
-- so we don't filter it out. [Sept 03: wrong: see isBuiltInSyntaxName]
-- so we don't filter it out. [Sept 03: wrong: see isBuiltInSyntax]
avail_env = mkAvailEnv avails'
imports = emptyImportAvails {
......
......@@ -34,7 +34,7 @@ import Kind
import Var ( Id, TyVar, tyVarKind )
import VarEnv ( TyVarEnv )
import VarSet ( TyVarSet )
import Name ( Name, NamedThing(..), mkWiredInName )
import Name ( Name, NamedThing(..), BuiltInSyntax(..), mkWiredInName )
import OccName ( mkOccFS, tcName )
import BasicTypes ( IPName, tupleParens )
import TyCon ( TyCon, mkFunTyCon, tyConArity, tupleTyConBoxity, isTupleTyCon, isRecursiveTyCon )
......@@ -290,6 +290,7 @@ funTyConName = mkWiredInName gHC_PRIM
funTyConKey
Nothing -- No parent object
(ATyCon funTyCon) -- Relevant TyCon
BuiltInSyntax
\end{code}
......
Markdown is supported
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