%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Name]{@Name@: to transmit name info from renamer to typechecker}
mkInternalName, mkSystemName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
+ mkTickBoxOpName,
mkExternalName, mkWiredInName,
nameUnique, setNameUnique,
tidyNameOcc,
hashName, localiseName,
- nameSrcLoc, nameParent, nameParent_maybe, isImplicitName,
+ nameSrcLoc, nameSrcSpan,
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
-- Class NamedThing and overloaded friends
NamedThing(..),
- getSrcLoc, getOccString
+ getSrcLoc, getSrcSpan, getOccString
) where
#include "HsVersions.h"
import {-# SOURCE #-} TypeRep( TyThing )
-import OccName -- All of it
-import Module ( Module )
-import SrcLoc ( noSrcLoc, wiredInSrcLoc, SrcLoc )
-import Unique ( Unique, Uniquable(..), getKey, pprUnique,
- mkUniqueGrimily, getKey# )
-import Maybes ( orElse, isJust )
-import FastString ( FastString, zEncodeFS )
+import OccName
+import Module
+import SrcLoc
+import UniqFM
+import Unique
+import Maybes
+import Binary
+import FastMutInt
+import FastString
import Outputable
-import GLAEXTS ( Int#, Int(..) )
+import Data.IORef
+import GHC.Exts
+import Data.Array
\end{code}
%************************************************************************
n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name
n_uniq :: Int#, -- UNPACK doesn't work, recursive type
- n_loc :: !SrcLoc -- Definition site
+ n_loc :: !SrcSpan -- Definition site
}
-- NOTE: we make the n_loc field strict to eliminate some potential
-- the SrcLoc in a Name all that often.
data NameSort
- = 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
+ = External Module
- | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
+ | WiredIn Module TyThing BuiltInSyntax
-- A variant of External, for wired-in things
| Internal -- A user-defined Id or TyVar
nameOccName :: Name -> OccName
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
+nameSrcSpan :: Name -> SrcSpan
nameUnique name = mkUniqueGrimily (I# (n_uniq name))
nameOccName name = n_occ name
-nameSrcLoc name = n_loc name
+nameSrcLoc name = srcSpanStart (n_loc name)
+nameSrcSpan name = n_loc name
\end{code}
\begin{code}
isSystemName :: 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
-isBuiltInSyntax (Name {n_sort = WiredIn _ _ _ BuiltInSyntax}) = True
-isBuiltInSyntax 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
+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 :: Name -> Name
-nameParent name = case nameParent_maybe name of
- Just parent -> parent
- Nothing -> name
-
-isImplicitName :: Name -> Bool
--- An Implicit Name is one has a parent; that is, one whose definition
--- derives from the parent thing
-isImplicitName name = isJust (nameParent_maybe name)
-
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
+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
%************************************************************************
\begin{code}
-mkInternalName :: Unique -> OccName -> SrcLoc -> Name
+mkInternalName :: Unique -> OccName -> SrcSpan -> Name
mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
-- NB: You might worry that after lots of huffing and
-- puffing we might end up with two local names with distinct
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
-mkExternalName :: Unique -> Module -> OccName -> Maybe Name -> SrcLoc -> Name
-mkExternalName uniq mod occ mb_parent loc
- = Name { n_uniq = getKey# uniq, n_sort = External mod mb_parent,
+mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
+mkExternalName uniq mod occ loc
+ = Name { n_uniq = getKey# uniq, n_sort = External mod,
n_occ = occ, n_loc = loc }
-mkWiredInName :: Module -> OccName -> Unique
- -> Maybe Name -> TyThing -> BuiltInSyntax -> Name
-mkWiredInName mod occ uniq mb_parent thing built_in
+mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax
+ -> Name
+mkWiredInName mod occ uniq thing built_in
= Name { n_uniq = getKey# uniq,
- n_sort = WiredIn mod mb_parent thing built_in,
- n_occ = occ, n_loc = wiredInSrcLoc }
+ n_sort = WiredIn mod thing built_in,
+ n_occ = occ, n_loc = wiredInSrcSpan }
mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System,
- n_occ = occ, n_loc = noSrcLoc }
+ n_occ = occ, n_loc = noSrcSpan }
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
mkFCallName :: Unique -> String -> Name
-- The encoded string completely describes the ccall
mkFCallName uniq str = Name { n_uniq = getKey# uniq, n_sort = Internal,
- n_occ = mkVarOcc str, n_loc = noSrcLoc }
+ n_occ = mkVarOcc str, n_loc = noSrcSpan }
+
+mkTickBoxOpName :: Unique -> String -> Name
+mkTickBoxOpName uniq str
+ = Name { n_uniq = getKey# uniq, n_sort = Internal,
+ n_occ = mkVarOcc str, n_loc = noSrcSpan }
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
= Name { n_uniq = getKey# uniq,
n_sort = Internal,
n_occ = occ,
- n_loc = noSrcLoc }
+ n_loc = noSrcSpan }
\end{code}
\begin{code}
%************************************************************************
\begin{code}
-hashName :: Name -> Int
-hashName name = getKey (nameUnique name)
+hashName :: Name -> Int -- ToDo: should really be Word
+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}
getName n = n
\end{code}
+%************************************************************************
+%* *
+\subsection{Binary}
+%* *
+%************************************************************************
+
+\begin{code}
+instance Binary Name where
+ put_ bh name = do
+ case getUserData bh of {
+ UserData { ud_symtab_map = symtab_map_ref,
+ ud_symtab_next = symtab_next } -> do
+ symtab_map <- readIORef symtab_map_ref
+ case lookupUFM symtab_map name of
+ Just (off,_) -> put_ bh off
+ Nothing -> do
+ off <- readFastMutInt symtab_next
+ writeFastMutInt symtab_next (off+1)
+ writeIORef symtab_map_ref
+ $! addToUFM symtab_map name (off,name)
+ put_ bh off
+ }
+
+ get bh = do
+ i <- get bh
+ return $! (ud_symtab (getUserData bh) ! i)
+\end{code}
%************************************************************************
%* *
pprName name@(Name {n_sort = sort, n_uniq = u#, n_occ = occ})
= getPprStyle $ \ sty ->
case sort of
- WiredIn mod _ _ builtin -> pprExternal sty uniq mod occ True builtin
- External mod _ -> pprExternal sty uniq mod occ False UserSyntax
+ 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
where uniq = mkUniqueGrimily (I# u#)
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
+getSrcSpan :: NamedThing a => a -> SrcSpan
getOccString :: NamedThing a => a -> String
getSrcLoc = nameSrcLoc . getName
+getSrcSpan = nameSrcSpan . getName
getOccString = occNameString . getOccName
\end{code}
projects / ghc-hetmet.git / blobdiff