[project @ 2004-08-26 15:44:50 by simonpj]
authorsimonpj <unknown>
Thu, 26 Aug 2004 15:45:08 +0000 (15:45 +0000)
committersimonpj <unknown>
Thu, 26 Aug 2004 15:45:08 +0000 (15:45 +0000)
-------------------------------
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
ghc/compiler/basicTypes/Name.lhs
ghc/compiler/main/HscTypes.lhs
ghc/compiler/prelude/PrelNames.lhs
ghc/compiler/prelude/TysPrim.lhs
ghc/compiler/prelude/TysWiredIn.lhs
ghc/compiler/rename/RnNames.lhs
ghc/compiler/types/TypeRep.lhs

index cbbe8ec..dcd057d 100644 (file)
@@ -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
index 29b2b3e..adb1082 100644 (file)
@@ -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
index 5718016..5f1ce2d 100644 (file)
@@ -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 )
index c1813e4..893fed2 100644 (file)
@@ -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}
 %*                                                                     *
 %************************************************************************
index f971348..0cc59d9 100644 (file)
@@ -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
index 3b41cb6..eb8124f 100644 (file)
@@ -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
index 9e15a4b..6781ee7 100644 (file)
@@ -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 {
index 0e0f88f..a867cad 100644 (file)
@@ -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}