Initial checkin of HetMet / -XModalTypes modifications
[ghc-hetmet.git] / compiler / basicTypes / Name.lhs
index bbc249f..de8a3a3 100644 (file)
@@ -5,19 +5,45 @@
 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
 
 \begin{code}
-module Name (
-       -- Re-export the OccName stuff
-       module OccName,
+-- |
+-- #name_types#
+-- GHC uses several kinds of name internally:
+--
+-- * 'OccName.OccName': see "OccName#name_types"
+--
+-- * 'RdrName.RdrName': see "RdrName#name_types"
+--
+-- *  'Name.Name' is the type of names that have had their scoping and binding resolved. They
+--   have an 'OccName.OccName' but also a 'Unique.Unique' that disambiguates Names that have
+--   the same 'OccName.OccName' and indeed is used for all 'Name.Name' comparison. Names
+--   also contain information about where they originated from, see "Name#name_sorts"
+--
+-- * 'Id.Id': see "Id#name_types"
+--
+-- * 'Var.Var': see "Var#name_types"
+--
+-- #name_sorts#
+-- Names are one of:
+--
+--  * External, if they name things declared in other modules. Some external
+--    Names are wired in, i.e. they name primitives defined in the compiler itself
+--
+--  * Internal, if they name things in the module being compiled. Some internal
+--    Names are system names, if they are names manufactured by the compiler
 
-       -- The Name type
+module Name (
+       -- * The main types
        Name,                                   -- Abstract
-       BuiltInSyntax(..), 
-       mkInternalName, mkSystemName,
+       BuiltInSyntax(..),
+
+       -- ** Creating 'Name's
+       mkInternalName, mkSystemName, mkDerivedInternalName, 
        mkSystemVarName, mkSysTvName, 
        mkFCallName, mkIPName,
         mkTickBoxOpName,
        mkExternalName, mkWiredInName,
 
+       -- ** Manipulating and deconstructing 'Name's
        nameUnique, setNameUnique,
        nameOccName, nameModule, nameModule_maybe,
        tidyNameOcc, 
@@ -25,30 +51,44 @@ module Name (
 
        nameSrcLoc, nameSrcSpan, pprNameLoc,
 
+       -- ** Predicates on 'Name's
        isSystemName, isInternalName, isExternalName,
-       isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
+       isTyVarName, isTyConName, isDataConName, 
+       isValName, isVarName,
+       isWiredInName, isBuiltInSyntax,
        wiredInNameTyThing_maybe, 
        nameIsLocalOrFrom,
-       
-       -- Class NamedThing and overloaded friends
+
+       -- * Class 'NamedThing' and overloaded friends
        NamedThing(..),
        getSrcLoc, getSrcSpan, getOccString,
-       pprInfixName, pprPrefixName
+
+       pprInfixName, pprPrefixName, pprModulePrefix,
+        getNameDepth, setNameDepth,
+
+       -- Re-export the OccName stuff
+       module OccName
     ) where
 
+#include "Typeable.h"
+
 import {-# SOURCE #-} TypeRep( TyThing )
 
 import OccName
 import Module
 import SrcLoc
 import Unique
+import Util
 import Maybes
 import Binary
+import StaticFlags
 import FastTypes
 import FastString
 import Outputable
 
 import Data.Array
+import Data.Data
+import Data.Word        ( Word32 )
 \end{code}
 
 %************************************************************************
@@ -58,6 +98,8 @@ import Data.Array
 %************************************************************************
  
 \begin{code}
+-- | A unique, unambigious name for something, containing information about where
+-- that thing originated.
 data Name = Name {
                n_sort :: NameSort,     -- What sort of name it is
                n_occ  :: !OccName,     -- Its occurrence name
@@ -70,6 +112,12 @@ data Name = Name {
 -- (and real!) space leaks, due to the fact that we don't look at
 -- the SrcLoc in a Name all that often.
 
+setNameDepth :: Int -> Name -> Name
+setNameDepth depth name = name { n_occ = setOccNameDepth depth (n_occ name) }
+
+getNameDepth :: Name -> Int
+getNameDepth name = getOccNameDepth $ n_occ name
+
 data NameSort
   = External Module
  
@@ -82,10 +130,10 @@ 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"
+-- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples, 
+-- which have special syntactic forms.  They aren't in scope
 -- as such.
+data BuiltInSyntax = BuiltInSyntax | UserSyntax
 \end{code}
 
 Notes about the NameSorts:
@@ -132,6 +180,12 @@ nameSrcLoc  name = srcSpanStart (n_loc name)
 nameSrcSpan name = n_loc  name
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+\subsection{Predicates on names}
+%*                                                                     *
+%************************************************************************
+
 \begin{code}
 nameIsLocalOrFrom :: Module -> Name -> Bool
 isInternalName   :: Name -> Bool
@@ -172,6 +226,15 @@ isTyVarName name = isTvOcc (nameOccName name)
 isTyConName :: Name -> Bool
 isTyConName name = isTcOcc (nameOccName name)
 
+isDataConName :: Name -> Bool
+isDataConName name = isDataOcc (nameOccName name)
+
+isValName :: Name -> Bool
+isValName name = isValOcc (nameOccName name)
+
+isVarName :: Name -> Bool
+isVarName = isVarOcc . nameOccName
+
 isSystemName (Name {n_sort = System}) = True
 isSystemName _                        = False
 \end{code}
@@ -184,6 +247,8 @@ isSystemName _                        = False
 %************************************************************************
 
 \begin{code}
+-- | Create a name which is (for now at least) local to the current module and hence
+-- does not need a 'Module' to disambiguate it from other 'Name's
 mkInternalName :: Unique -> OccName -> SrcSpan -> Name
 mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
        -- NB: You might worry that after lots of huffing and
@@ -195,18 +260,25 @@ mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = Inter
        --      * for interface files we tidyCore first, which puts the uniques
        --        into the print name (see setNameVisibility below)
 
+mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
+mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
+  = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal
+         , n_occ = derive_occ occ, n_loc = loc }
+
+-- | Create a name which definitely originates in the given module
 mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
 mkExternalName uniq mod occ loc 
   = Name { n_uniq = getKeyFastInt uniq, n_sort = External mod,
            n_occ = occ, n_loc = loc }
 
-mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax
-        -> Name
+-- | Create a name which is actually defined by the compiler itself
+mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
 mkWiredInName mod occ uniq thing built_in
   = Name { n_uniq = getKeyFastInt uniq,
           n_sort = WiredIn mod thing built_in,
           n_occ = occ, n_loc = wiredInSrcSpan }
 
+-- | Create a name brought into being by the compiler
 mkSystemName :: Unique -> OccName -> Name
 mkSystemName uniq occ = Name { n_uniq = getKeyFastInt uniq, n_sort = System, 
                               n_occ = occ, n_loc = noSrcSpan }
@@ -215,18 +287,21 @@ mkSystemVarName :: Unique -> FastString -> Name
 mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
 
 mkSysTvName :: Unique -> FastString -> Name
-mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) 
+mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
 
+-- | Make a name for a foreign call
 mkFCallName :: Unique -> String -> Name
        -- The encoded string completely describes the ccall
 mkFCallName uniq str =  Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, 
                               n_occ = mkVarOcc str, n_loc = noSrcSpan }
 
+
 mkTickBoxOpName :: Unique -> String -> Name
 mkTickBoxOpName uniq str 
    = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, 
            n_occ = mkVarOcc str, n_loc = noSrcSpan }
 
+-- | Make the name of an implicit parameter
 mkIPName :: Unique -> OccName -> Name
 mkIPName uniq occ
   = Name { n_uniq = getKeyFastInt uniq,
@@ -249,14 +324,14 @@ tidyNameOcc :: Name -> OccName -> Name
 tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
 tidyNameOcc name                           occ = name { n_occ = occ }
 
+-- | Make the 'Name' into an internal name, regardless of what it was to begin with
 localiseName :: Name -> Name
 localiseName n = n { n_sort = Internal }
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
-\subsection{Predicates and selectors}
+\subsection{Hashing and comparison}
 %*                                                                     *
 %************************************************************************
 
@@ -266,8 +341,10 @@ hashName name = getKey (nameUnique name) + 1
        -- The +1 avoids keys with lots of zeros in the ls bits, which 
        -- interacts badly with the cheap and cheerful multiplication in
        -- hashExpr
-\end{code}
 
+cmpName :: Name -> Name -> Ordering
+cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -276,11 +353,6 @@ hashName name = getKey (nameUnique name) + 1
 %************************************************************************
 
 \begin{code}
-cmpName :: Name -> Name -> Ordering
-cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
-\end{code}
-
-\begin{code}
 instance Eq Name where
     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
@@ -297,6 +369,14 @@ instance Uniquable Name where
 
 instance NamedThing Name where
     getName n = n
+
+INSTANCE_TYPEABLE0(Name,nameTc,"Name")
+
+instance Data Name where
+  -- don't traverse?
+  toConstr _   = abstractConstr "Name"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "Name"
 \end{code}
 
 %************************************************************************
@@ -313,7 +393,7 @@ instance Binary Name where
 
    get bh = do
         i <- get bh
-        return $! (ud_symtab (getUserData bh) ! i)
+        return $! (ud_symtab (getUserData bh) ! fromIntegral (i::Word32))
 \end{code}
 
 %************************************************************************
@@ -341,30 +421,23 @@ pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
 
 pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
 pprExternal sty uniq mod occ is_wired is_builtin
-  | codeStyle sty        = ppr mod <> char '_' <> ppr_z_occ_name occ
+  | codeStyle sty = ppr mod <> char '_' <> ppr_z_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,
-                                pprNameSpaceBrief (occNameSpace occ), 
-                                pprUnique uniq])
-  | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
-       -- never qualify builtin syntax
-  | NameQual modname <- qual_name = ppr modname <> dot <> ppr_occ_name occ
-        -- see HscTypes.mkPrintUnqualified and Outputable.QualifyName:
-  | NameNotInScope1 <- qual_name  = ppr mod <> dot <> ppr_occ_name occ
-  | NameNotInScope2 <- qual_name  = ppr (modulePackageId mod) <> char ':' <>
-                                    ppr (moduleName mod) <> dot <> ppr_occ_name occ
-  | otherwise                    = ppr_occ_name occ
-  where qual_name = qualName sty mod occ
+  | debugStyle sty = ppr mod <> dot <> ppr_occ_name occ
+                    <> braces (hsep [if is_wired then ptext (sLit "(w)") else empty,
+                                     pprNameSpaceBrief (occNameSpace occ), 
+                                     pprUnique uniq])
+  | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
+  | otherwise                  = pprModulePrefix sty mod occ <> ppr_occ_name occ
 
 pprInternal :: PprStyle -> Unique -> OccName -> SDoc
 pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
   | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ), 
                                                       pprUnique uniq])
-  | dumpStyle sty  = ppr_occ_name occ <> char '_' <> pprUnique uniq
+  | dumpStyle sty  = ppr_occ_name occ <> ppr_underscore_unique uniq
                        -- For debug dumps, we're not necessarily dumping
                        -- tidied code, so we need to print the uniques.
   | otherwise      = ppr_occ_name occ  -- User style
@@ -373,13 +446,35 @@ pprInternal sty uniq occ
 pprSystem :: PprStyle -> Unique -> OccName -> SDoc
 pprSystem sty uniq occ
   | codeStyle sty  = pprUnique uniq
-  | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq
+  | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
                     <> braces (pprNameSpaceBrief (occNameSpace occ))
-  | otherwise     = ppr_occ_name occ <> char '_' <> pprUnique uniq
+  | otherwise     = ppr_occ_name occ <> ppr_underscore_unique uniq
                                -- If the tidy phase hasn't run, the OccName
                                -- is unlikely to be informative (like 's'),
                                -- so print the unique
 
+
+pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
+-- Print the "M." part of a name, based on whether it's in scope or not
+-- See Note [Printing original names] in HscTypes
+pprModulePrefix sty mod occ
+  | opt_SuppressModulePrefixes = empty
+  
+  | otherwise
+  = case qualName sty mod occ of                  -- See Outputable.QualifyName:
+      NameQual modname -> ppr modname <> dot       -- Name is in scope       
+      NameNotInScope1  -> ppr mod <> dot           -- Not in scope
+      NameNotInScope2  -> ppr (modulePackageId mod) <> colon     -- Module not in
+                          <> ppr (moduleName mod) <> dot         -- scope eithber
+      _otherwise       -> empty
+
+ppr_underscore_unique :: Unique -> SDoc
+-- Print an underscore separating the name from its unique
+-- But suppress it if we aren't printing the uniques anyway
+ppr_underscore_unique uniq
+  | opt_SuppressUniques = empty
+  | otherwise          = char '_' <> pprUnique uniq
+
 ppr_occ_name :: OccName -> SDoc
 ppr_occ_name occ = ftext (occNameFS occ)
        -- Don't use pprOccName; instead, just print the string of the OccName; 
@@ -408,6 +503,7 @@ pprNameLoc name
 %************************************************************************
 
 \begin{code}
+-- | A class allowing convenient access to the 'Name' of various datatypes
 class NamedThing a where
     getOccName :: a -> OccName
     getName    :: a -> Name