X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FOccName.lhs;h=9ff53f13400af5a2b0cc9b81fe2e7e510d1a1a9b;hb=707ea5881703d680155aab268bdbf7edc113e3b1;hp=b12a07feae4ba1dfb14c020c778ba378146ecfac;hpb=8a9eb3cd35117c62ac9758d118c6f4109b7330cb;p=ghc-hetmet.git diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index b12a07f..9ff53f1 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -49,7 +49,7 @@ module OccName ( -- ** Derived 'OccName's isDerivedOccName, mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, - mkDerivedTyConOcc, mkNewTyCoOcc, + mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc, mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, @@ -58,7 +58,7 @@ module OccName ( mkInstTyCoOcc, mkEqPredCoOcc, mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, mkPDataTyConOcc, mkPDataDataConOcc, - mkPReprTyConOcc, + mkPReprTyConOcc, mkPADFunOcc, -- ** Deconstruction @@ -75,7 +75,7 @@ module OccName ( 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, @@ -92,16 +92,19 @@ module OccName ( startsVarSym, startsVarId, startsConSym, startsConId ) where +#include "Typeable.h" + import Util import Unique import BasicTypes import UniqFM import UniqSet import FastString -import FastTypes import Outputable import Binary +import StaticFlags( opt_SuppressUniques ) import Data.Char +import Data.Data \end{code} \begin{code} @@ -227,6 +230,14 @@ instance Ord OccName where -- 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} @@ -244,12 +255,26 @@ pprOccName :: OccName -> SDoc 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 %************************************************************************ %* * @@ -304,22 +329,24 @@ mkClsOccFS = mkOccNameFS clsName 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) @@ -334,6 +361,7 @@ elemOccEnv :: OccName -> OccEnv a -> Bool 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 @@ -353,6 +381,7 @@ occEnvElts (A x) = eltsUFM x 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 @@ -525,7 +554,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc, - mkInstTyCoOcc, mkEqPredCoOcc, + mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc, mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc @@ -535,6 +564,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc, 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 @@ -543,9 +573,9 @@ mkDictOcc = mk_simple_deriv varName "$d" 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_"