From bb88e732b7383c10496c0f60c3bdea2c22362cc6 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 26 Aug 2004 15:45:08 +0000 Subject: [PATCH] [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. --- ghc/compiler/basicTypes/MkId.lhs | 6 ++-- ghc/compiler/basicTypes/Name.lhs | 67 ++++++++++++++++++++++------------- ghc/compiler/main/HscTypes.lhs | 1 - ghc/compiler/prelude/PrelNames.lhs | 19 ---------- ghc/compiler/prelude/TysPrim.lhs | 3 +- ghc/compiler/prelude/TysWiredIn.lhs | 52 ++++++++++++++------------- ghc/compiler/rename/RnNames.lhs | 9 ++--- ghc/compiler/types/TypeRep.lhs | 3 +- 8 files changed, 82 insertions(+), 78 deletions(-) diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs index cbbe8ec..dcd057d 100644 --- a/ghc/compiler/basicTypes/MkId.lhs +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -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 diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index 29b2b3e..adb1082 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -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 diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 5718016..5f1ce2d 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -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 ) diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index c1813e4..893fed2 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -91,25 +91,6 @@ isUnboundName name = name `hasKey` unboundKey %************************************************************************ %* * -\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} %* * %************************************************************************ diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index f971348..0cc59d9 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -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 diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index 3b41cb6..eb8124f 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -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 diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 9e15a4b..6781ee7 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -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 { diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs index 0e0f88f..a867cad 100644 --- a/ghc/compiler/types/TypeRep.lhs +++ b/ghc/compiler/types/TypeRep.lhs @@ -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} -- 1.7.10.4