[project @ 2005-02-25 13:06:31 by simonpj]
[ghc-hetmet.git] / ghc / compiler / basicTypes / Name.lhs
index 07aaad0..4ea51b6 100644 (file)
@@ -10,21 +10,23 @@ module Name (
 
        -- The Name type
        Name,                                   -- Abstract
-       mkInternalName, mkSystemName, 
-       mkSystemNameEncoded, mkSystemTvNameEncoded, mkFCallName,
-       mkIPName,
-       mkExternalName, mkKnownKeyExternalName, mkWiredInName,
+       BuiltInSyntax(..), 
+       mkInternalName, mkSystemName,
+       mkSystemVarName, mkSystemVarNameEncoded, mkSysTvName, 
+       mkFCallName, mkIPName,
+       mkExternalName, mkWiredInName,
 
        nameUnique, setNameUnique,
        nameOccName, nameModule, nameModule_maybe,
-       setNameOcc, setNameModuleAndLoc, 
-       hashName, externaliseName, localiseName,
+       setNameOcc, 
+       hashName, localiseName,
 
-       nameSrcLoc, eqNameByOcc,
+       nameSrcLoc, nameParent, nameParent_maybe,
 
        isSystemName, isInternalName, isExternalName,
-       isTyVarName, isDllName, isWiredInName,
-       nameIsLocalOrFrom, isHomePackageName,
+       isTyVarName, isWiredInName, isBuiltInSyntax,
+       wiredInNameTyThing_maybe, 
+       nameIsLocalOrFrom,
        
        -- Class NamedThing and overloaded friends
        NamedThing(..),
@@ -33,12 +35,13 @@ module Name (
 
 #include "HsVersions.h"
 
+import {-# SOURCE #-} TypeRep( TyThing )
+
 import OccName         -- All of it
-import Module          ( Module, ModuleName, moduleName, isHomeModule )
-import CmdLineOpts     ( opt_Static )
-import SrcLoc          ( noSrcLoc, isWiredInLoc, wiredInSrcLoc, SrcLoc )
+import Module          ( Module )
+import SrcLoc          ( noSrcLoc, wiredInSrcLoc, SrcLoc )
 import Unique          ( Unique, Uniquable(..), getKey, pprUnique )
-import FastTypes
+import Maybes          ( orElse )
 import Outputable
 \end{code}
 
@@ -61,16 +64,24 @@ data Name = Name {
 -- the SrcLoc in a Name all that often.
 
 data NameSort
-  = External Module    -- (a) TyCon, Class, their derived Ids, dfun Id
-                       -- (b) Imported Id
-                       -- (c) Top-level Id in the original source, even if
-                       --      locally defined
+  = External Module (Maybe Name)
+       -- (Just parent) => this Name is a subordinate name of 'parent'
+       -- e.g. data constructor of a data type, method of a class
+       -- Nothing => not a subordinate
+  | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
+       -- A variant of External, for wired-in things
 
   | Internal           -- A user-defined Id or TyVar
                        -- defined in the module being compiled
 
   | 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:
@@ -96,6 +107,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 
@@ -112,48 +131,48 @@ nameIsLocalOrFrom :: Module -> Name -> Bool
 isInternalName   :: Name -> Bool
 isExternalName   :: Name -> Bool
 isSystemName     :: Name -> Bool
-isHomePackageName :: Name -> Bool
 isWiredInName    :: Name -> Bool
 
-isWiredInName name = isWiredInLoc (n_loc name)
+isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
+isWiredInName other                            = False
 
-isExternalName (Name {n_sort = External _}) = True
-isExternalName other                       = False
+wiredInNameTyThing_maybe :: Name -> Maybe TyThing
+wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ _ thing _}) = Just thing
+wiredInNameTyThing_maybe other                                = Nothing
 
-nameModule (Name { n_sort = External mod }) = mod
-nameModule name                                    = pprPanic "nameModule" (ppr name)
+isBuiltInSyntax (Name {n_sort = WiredIn _ _ _ BuiltInSyntax}) = True
+isBuiltInSyntax other                                        = False
 
-nameModule_maybe (Name { n_sort = External mod }) = Just mod
-nameModule_maybe name                            = Nothing
+isExternalName (Name {n_sort = External _ _})    = True
+isExternalName (Name {n_sort = WiredIn _ _ _ _}) = True
+isExternalName other                            = False
 
 isInternalName name = not (isExternalName name)
 
-nameIsLocalOrFrom from (Name {n_sort = External mod}) = mod == from
-nameIsLocalOrFrom from other                         = True
+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 :: Name -> Name
+nameParent name = case nameParent_maybe name of
+                       Just parent -> parent
+                       Nothing     -> name
 
-isHomePackageName (Name {n_sort = External mod}) = isHomeModule mod
-isHomePackageName other                                 = True         -- Internal and system names
+nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
+nameModule_maybe (Name { n_sort = External mod _})    = Just mod
+nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
+nameModule_maybe name                                = Nothing
 
-isDllName :: Name -> Bool      -- Does this name refer to something in a different DLL?
-isDllName nm = not opt_Static && not (isHomePackageName nm)
+nameIsLocalOrFrom from name
+  | isExternalName name = from == nameModule name
+  | otherwise          = True
 
 isTyVarName :: Name -> Bool
 isTyVarName name = isTvOcc (nameOccName name)
 
 isSystemName (Name {n_sort = System}) = True
 isSystemName other                   = False
-
-eqNameByOcc :: Name -> Name -> Bool
--- Compare using the strings, not the unique
--- See notes with HsCore.eq_ufVar
-eqNameByOcc (Name {n_sort = sort1, n_occ = occ1})
-           (Name {n_sort = sort2, n_occ = occ2})
-  = sort1 `eq_sort` sort2 && occ1 == occ2
-  where
-    eq_sort (External m1) (External m2) = moduleName m1 == moduleName m2
-    eq_sort (External _)  _            = False
-    eq_sort _            (External _)   = False
-    eq_sort _           _              = True
 \end{code}
 
 
@@ -175,32 +194,32 @@ mkInternalName uniq occ loc = Name { n_uniq = uniq, n_sort = Internal, n_occ = o
        --      * for interface files we tidyCore first, which puts the uniques
        --        into the print name (see setNameVisibility below)
 
-mkExternalName :: Unique -> Module -> OccName -> SrcLoc -> Name
-mkExternalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = External mod,
-                                        n_occ = occ, n_loc = loc }
+mkExternalName :: Unique -> Module -> OccName -> Maybe Name -> SrcLoc -> Name
+mkExternalName uniq mod occ mb_parent loc 
+  = Name { n_uniq = uniq, n_sort = External mod mb_parent,
+           n_occ = occ, n_loc = loc }
 
-mkKnownKeyExternalName :: Module -> OccName -> Unique -> Name
-mkKnownKeyExternalName mod occ uniq
-  = mkExternalName uniq mod occ noSrcLoc
+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 built_in,
+          n_occ = occ, n_loc = wiredInSrcLoc }
 
-mkWiredInName :: Module -> OccName -> Unique -> Name
-mkWiredInName mod occ uniq = mkExternalName uniq mod occ wiredInSrcLoc
+mkSystemName :: Unique -> OccName -> Name
+mkSystemName uniq occ = Name { n_uniq = uniq, n_sort = System, 
+                              n_occ = occ, n_loc = noSrcLoc }
 
-mkSystemName :: Unique -> UserFS -> Name
-mkSystemName uniq fs = Name { n_uniq = uniq, n_sort = System, 
-                             n_occ = mkVarOcc fs, n_loc = noSrcLoc }
+mkSystemVarName :: Unique -> UserFS -> Name
+mkSystemVarName uniq fs = mkSystemName uniq (mkVarOcc fs)
 
 -- Use this version when the string is already encoded.  Avoids duplicating
 -- the string each time a new name is created.
-mkSystemNameEncoded :: Unique -> EncodedFS -> Name
-mkSystemNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System, 
-                                    n_occ = mkSysOccFS varName fs, 
-                                    n_loc = noSrcLoc }
+mkSystemVarNameEncoded :: Unique -> EncodedFS -> Name
+mkSystemVarNameEncoded uniq fs = mkSystemName uniq (mkSysOccFS varName fs) 
 
-mkSystemTvNameEncoded :: Unique -> EncodedFS -> Name
-mkSystemTvNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System, 
-                                      n_occ = mkSysOccFS tvName fs, 
-                                      n_loc = noSrcLoc }
+mkSysTvName :: Unique -> EncodedFS -> Name
+mkSysTvName uniq fs = mkSystemName uniq (mkSysOccFS tvName fs) 
 
 mkFCallName :: Unique -> EncodedString -> Name
        -- The encoded string completely describes the ccall
@@ -224,16 +243,8 @@ setNameUnique name uniq = name {n_uniq = uniq}
 setNameOcc :: Name -> OccName -> Name
 setNameOcc name occ = name {n_occ = occ}
 
-externaliseName :: Name -> Module -> Name
-externaliseName n mod = n { n_sort = External mod }
-                               
 localiseName :: Name -> Name
 localiseName n = n { n_sort = Internal }
-                               
-setNameModuleAndLoc :: Name -> Module -> SrcLoc -> Name
-setNameModuleAndLoc name mod loc = name {n_sort = set (n_sort name), n_loc = loc}
-                      where
-                        set (External _) = External mod
 \end{code}
 
 
@@ -245,7 +256,7 @@ setNameModuleAndLoc name mod loc = name {n_sort = set (n_sort name), n_loc = loc
 
 \begin{code}
 hashName :: Name -> Int
-hashName name = iBox (getKey (nameUnique name))
+hashName name = getKey (nameUnique name)
 \end{code}
 
 
@@ -287,41 +298,52 @@ instance NamedThing Name where
 
 \begin{code}
 instance Outputable Name where
-       -- When printing interfaces, all Internals have been given nice print-names
     ppr name = pprName name
 
 instance OutputableBndr Name where
     pprBndr _ name = pprName name
 
-pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
   = getPprStyle $ \ sty ->
     case sort of
-      External mod -> pprExternal sty name uniq mod occ
-      System       -> pprSystem sty uniq occ
-      Internal     -> pprInternal sty uniq occ
-
-pprExternal sty name uniq mod occ
-  | codeStyle sty        = ppr (moduleName mod) <> char '_' <> pprOccName occ
-
-  | debugStyle sty       = ppr (moduleName mod) <> dot <> pprOccName occ <> 
-                           text "{-" <> pprUnique uniq <> text "-}"
-
-  | unqualStyle sty name = pprOccName occ
-  | otherwise           = ppr (moduleName mod) <> dot <> pprOccName occ
+      WiredIn mod _ _ builtin -> pprExternal sty uniq mod occ True  builtin
+      External mod _         -> pprExternal sty uniq mod occ False UserSyntax
+      System                         -> pprSystem sty uniq occ
+      Internal               -> pprInternal sty uniq occ
+
+pprExternal sty uniq mod occ is_wired is_builtin
+  | codeStyle sty        = ppr mod <> char '_' <> ppr_occ_name occ
+       -- In code style, always qualify
+       -- ToDo: maybe we could print all wired-in things unqualified
+       --       in code style, to reduce symbol table bloat?
+  | debugStyle sty       = ppr mod <> dot <> ppr_occ_name occ
+                          <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty,
+                                           text (briefOccNameFlavour occ), 
+                                           pprUnique uniq])
+  | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
+       -- never qualify builtin syntax
+  | unqualStyle sty mod occ = ppr_occ_name occ
+  | otherwise              = ppr mod <> dot <> ppr_occ_name occ
 
 pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
-  | debugStyle sty = pprOccName occ <> 
-                    text "{-" <> pprUnique uniq <> text "-}"
-  | otherwise      = pprOccName occ    -- User style
+  | debugStyle sty = ppr_occ_name occ <> braces (hsep [text (briefOccNameFlavour occ), 
+                                                      pprUnique uniq])
+  | otherwise      = ppr_occ_name occ  -- User style
 
 -- Like Internal, except that we only omit the unique in Iface style
 pprSystem sty uniq occ
   | codeStyle sty  = pprUnique uniq
-  | otherwise     = pprOccName occ <> char '_' <> pprUnique uniq
+  | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq
+                    <> braces (text (briefOccNameFlavour occ))
+  | otherwise     = ppr_occ_name occ <> char '_' <> pprUnique uniq
                                -- If the tidy phase hasn't run, the OccName
                                -- is unlikely to be informative (like 's'),
                                -- so print the unique
+
+ppr_occ_name occ = pprEncodedFS (occNameFS occ)
+       -- Don't use pprOccName; instead, just print the string of the OccName; 
+       -- we print the namespace in the debug stuff above
 \end{code}
 
 %************************************************************************