-- GHC uses several kinds of name internally:
--
-- * 'OccName.OccName' represents names as strings with just a little more information:
--- the "namespace" that the name came from, e.g. the namespace of value, type constructors or
+-- the \"namespace\" that the name came from, e.g. the namespace of value, type constructors or
-- data constructors
--
-- * 'RdrName.RdrName': see "RdrName#name_types"
-- ** Derived 'OccName's
isDerivedOccName,
mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc,
- mkDerivedTyConOcc, mkNewTyCoOcc,
+ mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
mkInstTyCoOcc, mkEqPredCoOcc,
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
- mkPArrayTyConOcc, mkPArrayDataConOcc,
- mkPReprTyConOcc,
+ mkPDataTyConOcc, mkPDataDataConOcc,
+ mkPReprTyConOcc,
mkPADFunOcc,
-- ** Deconstruction
occNameFS, occNameString, occNameSpace,
isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
- parenSymOcc, reportIfUnused,
+ parenSymOcc, startsWithUnderscore,
isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
- filterOccEnv, delListFromOccEnv, delFromOccEnv,
+ extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
-- * The 'OccSet' type
OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
startsVarSym, startsVarId, startsConSym, startsConId
) where
+#include "Typeable.h"
+
import Util
import Unique
import BasicTypes
-import StaticFlags
import UniqFM
import UniqSet
import FastString
-import FastTypes
import Outputable
import Binary
-
-import GHC.Exts
+import StaticFlags( opt_SuppressUniques )
import Data.Char
-\end{code}
-
-\begin{code}
--- Unicode TODO: put isSymbol in libcompat
-#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ > 604
-#else
-isSymbol :: a -> Bool
-isSymbol = const False
-#endif
-
+import Data.Data
\end{code}
%************************************************************************
-- Compares lexicographically, *not* by Unique of the string
compare (OccName sp1 s1) (OccName sp2 s2)
= (s1 `compare` s2) `thenCmp` (sp1 `compare` sp2)
+
+INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")
+
+instance Data OccName where
+ -- don't traverse?
+ toConstr _ = abstractConstr "OccName"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "OccName"
\end{code}
pprOccName (OccName sp occ)
= getPprStyle $ \ sty ->
if codeStyle sty
- then ftext (zEncodeFS occ)
- else ftext occ <> if debugStyle sty
- then braces (pprNameSpaceBrief sp)
- else empty
+ then ftext (zEncodeFS occ)
+ else pp_occ <> pp_debug sty
+ where
+ pp_debug sty | debugStyle sty = braces (pprNameSpaceBrief sp)
+ | otherwise = empty
+
+ pp_occ | opt_SuppressUniques = text (strip_th_unique (unpackFS occ))
+ | otherwise = ftext occ
+
+ -- See Note [Suppressing uniques in OccNames]
+ strip_th_unique ('[' : c : _) | isAlphaNum c = []
+ strip_th_unique (c : cs) = c : strip_th_unique cs
+ strip_th_unique [] = []
\end{code}
+Note [Suppressing uniques in OccNames]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This is a hack to de-wobblify the OccNames that contain uniques from
+Template Haskell that have been turned into a string in the OccName.
+See Note [Unique OccNames from Template Haskell] in Convert.hs
%************************************************************************
%* *
OccEnvs are used mainly for the envts in ModIfaces.
+Note [The Unique of an OccName]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
They are efficient, because FastStrings have unique Int# keys. We assume
-this key is less than 2^24, so we can make a Unique using
+this key is less than 2^24, and indeed FastStrings are allocated keys
+sequentially starting at 0.
+
+So we can make a Unique using
mkUnique ns key :: Unique
where 'ns' is a Char reprsenting the name space. This in turn makes it
easy to build an OccEnv.
\begin{code}
instance Uniquable OccName where
- getUnique (OccName ns fs)
- = mkUnique char (iBox (uniqueOfFS fs))
- where -- See notes above about this getUnique function
- char = case ns of
- VarName -> 'i'
- DataName -> 'd'
- TvName -> 'v'
- TcClsName -> 't'
+ -- See Note [The Unique of an OccName]
+ getUnique (OccName VarName fs) = mkVarOccUnique fs
+ getUnique (OccName DataName fs) = mkDataOccUnique fs
+ getUnique (OccName TvName fs) = mkTvOccUnique fs
+ getUnique (OccName TcClsName fs) = mkTcOccUnique fs
newtype OccEnv a = A (UniqFM a)
foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
occEnvElts :: OccEnv a -> [a]
extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
+extendOccEnv_Acc :: (a->b->b) -> (a->b) -> OccEnv b -> OccName -> a -> OccEnv b
plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
mapOccEnv :: (a->b) -> OccEnv a -> OccEnv b
plusOccEnv (A x) (A y) = A $ plusUFM x y
plusOccEnv_C f (A x) (A y) = A $ plusUFM_C f x y
extendOccEnv_C f (A x) y z = A $ addToUFM_C f x y z
+extendOccEnv_Acc f g (A x) y z = A $ addToUFM_Acc f g x y z
mapOccEnv f (A x) = A $ mapUFM f x
mkOccEnv_C comb l = A $ addListToUFM_C comb emptyUFM l
delFromOccEnv (A x) y = A $ delFromUFM x y
\begin{code}
-reportIfUnused :: OccName -> Bool
--- ^ Haskell 98 encourages compilers to suppress warnings about
--- unused names in a pattern if they start with @_@: this implements
--- that test
-reportIfUnused occ = case occNameString occ of
- ('_' : _) -> False
- _other -> True
+startsWithUnderscore :: OccName -> Bool
+-- ^ Haskell 98 encourages compilers to suppress warnings about unsed
+-- names in a pattern if they start with @_@: this implements that test
+startsWithUnderscore occ = case occNameString occ of
+ ('_' : _) -> True
+ _other -> False
\end{code}
mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
- mkInstTyCoOcc, mkEqPredCoOcc,
+ mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
- mkPArrayTyConOcc, mkPArrayDataConOcc, mkPReprTyConOcc, mkPADFunOcc
+ mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc
:: OccName -> OccName
-- These derived variables have a prefix that no Haskell value could have
mkDataConWrapperOcc = mk_simple_deriv varName "$W"
mkWorkerOcc = mk_simple_deriv varName "$w"
mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
+mkClassOpAuxOcc = mk_simple_deriv varName "$c"
mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
mkClassTyConOcc = mk_simple_deriv tcName "T:" -- as a tycon/datacon
mkClassDataConOcc = mk_simple_deriv dataName "D:" -- We go straight to the "real" data con
mkIPOcc = mk_simple_deriv varName "$i"
mkSpecOcc = mk_simple_deriv varName "$s"
mkForeignExportOcc = mk_simple_deriv varName "$f"
-mkNewTyCoOcc = mk_simple_deriv tcName "NTCo:" -- Coercion for newtypes
-mkInstTyCoOcc = mk_simple_deriv tcName "TFCo:" -- Coercion for type functions
-mkEqPredCoOcc = mk_simple_deriv tcName "$co"
+mkNewTyCoOcc = mk_simple_deriv tcName "NTCo:" -- Coercion for newtypes
+mkInstTyCoOcc = mk_simple_deriv tcName "TFCo:" -- Coercion for type functions
+mkEqPredCoOcc = mk_simple_deriv tcName "$co"
-- used in derived instances
mkCon2TagOcc = mk_simple_deriv varName "$con2tag_"
mkVectTyConOcc = mk_simple_deriv tcName ":V_"
mkVectDataConOcc = mk_simple_deriv dataName ":VD_"
mkVectIsoOcc = mk_simple_deriv varName "$VI_"
-mkPArrayTyConOcc = mk_simple_deriv tcName ":VP_"
-mkPArrayDataConOcc = mk_simple_deriv dataName ":VPD_"
+mkPDataTyConOcc = mk_simple_deriv tcName ":VP_"
+mkPDataDataConOcc = mk_simple_deriv dataName ":VPD_"
mkPReprTyConOcc = mk_simple_deriv tcName ":VR_"
mkPADFunOcc = mk_simple_deriv varName "$PA_"
\begin{code}
-- | Derive a name for the representation type constructor of a
-- @data@\/@newtype@ instance.
-mkInstTyTcOcc :: Int -- ^ DFun Index
- -> OccName -- ^ Family name, e.g. @Map@
- -> OccName -- ^ Nice unique version, e.g. @:R23Map@
-mkInstTyTcOcc index occ
- = mk_deriv tcName ("R" ++ show index ++ ":") (occNameString occ)
+mkInstTyTcOcc :: String -- ^ Family name, e.g. @Map@
+ -> OccSet -- ^ avoid these Occs
+ -> OccName -- ^ @R:Map@
+mkInstTyTcOcc str set =
+ chooseUniqueOcc tcName ('R' : ':' : str) set
\end{code}
\begin{code}
mkDFunOcc :: String -- ^ Typically the class and type glommed together e.g. @OrdMaybe@.
-- Only used in debug mode, for extra clarity
-> Bool -- ^ Is this a hs-boot instance DFun?
- -> Int -- ^ Unique index
+ -> OccSet -- ^ avoid these Occs
-> OccName -- ^ E.g. @$f3OrdMaybe@
-- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
-- thing when we compile the mother module. Reason: we don't know exactly
-- what the mother module will call it.
-mkDFunOcc info_str is_boot index
- = mk_deriv VarName prefix string
+mkDFunOcc info_str is_boot set
+ = chooseUniqueOcc VarName (prefix ++ info_str) set
where
prefix | is_boot = "$fx"
| otherwise = "$f"
- string | opt_PprStyle_Debug = show index ++ info_str
- | otherwise = show index
+\end{code}
+
+Sometimes we need to pick an OccName that has not already been used,
+given a set of in-use OccNames.
+
+\begin{code}
+chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName
+chooseUniqueOcc ns str set = loop (mkOccName ns str) (0::Int)
+ where
+ loop occ n
+ | occ `elemOccSet` set = loop (mkOccName ns (str ++ show n)) (n+1)
+ | otherwise = occ
\end{code}
We used to add a '$m' to indicate a method, but that gives rise to bad
projects / ghc-hetmet.git / blobdiff