mkTyVarOcc, mkTyVarOccFS,
mkTcOcc, mkTcOccFS,
mkClsOcc, mkClsOccFS,
- mkDFunOcc,
+ mkDFunOcc,
mkTupleOcc,
setOccNameSpace,
-- ** Derived 'OccName's
isDerivedOccName,
- mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc,
+ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkGenDefMethodOcc,
mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
+ mkGenD, mkGenR, mkGenRCo, mkGenC, mkGenS,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
mkInstTyCoOcc, mkEqPredCoOcc,
startsVarSym, startsVarId, startsConSym, startsConId
) where
+#include "Typeable.h"
+
import Util
import Unique
import BasicTypes
import FastString
import Outputable
import Binary
+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}
%************************************************************************
{ occNameSpace :: !NameSpace
, occNameFS :: !FastString
}
+ deriving Typeable
\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 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
%************************************************************************
%* *
\end{code}
\begin{code}
-mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
- mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
- mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
+mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkGenDefMethodOcc,
+ mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc,
+ mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
+ mkGenD, mkGenR, mkGenRCo,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkDataConWrapperOcc = mk_simple_deriv varName "$W"
mkWorkerOcc = mk_simple_deriv varName "$w"
mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
+mkGenDefMethodOcc = mk_simple_deriv varName "$gdm"
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
mkTag2ConOcc = mk_simple_deriv varName "$tag2con_"
mkMaxTagOcc = mk_simple_deriv varName "$maxtag_"
--- Generic derivable classes
+-- Generic derivable classes (old)
mkGenOcc1 = mk_simple_deriv varName "$gfrom"
mkGenOcc2 = mk_simple_deriv varName "$gto"
+-- Generic deriving mechanism (new)
+mkGenD = mk_simple_deriv tcName "D1"
+
+mkGenC :: OccName -> Int -> OccName
+mkGenC occ m = mk_deriv tcName ("C1_" ++ show m) (occNameString occ)
+
+mkGenS :: OccName -> Int -> Int -> OccName
+mkGenS occ m n = mk_deriv tcName ("S1_" ++ show m ++ "_" ++ show n)
+ (occNameString occ)
+
+mkGenR = mk_simple_deriv tcName "Rep_"
+mkGenRCo = mk_simple_deriv tcName "CoRep_"
+
-- data T = MkT ... deriving( Data ) needs defintions for
-- $tT :: Data.Generics.Basics.DataType
-- $cMkT :: Data.Generics.Basics.Constr
Just n -> -- Already used: make a new guess,
-- change the guess base, and try again
tidyOccName (extendOccEnv in_scope occ (n+1))
- (mkOccName occ_sp (unpackFS fs ++ show n))
+ (mkOccName occ_sp (base_occ ++ show n))
+ where
+ base_occ = reverse (dropWhile isDigit (reverse (unpackFS fs)))
\end{code}
%************************************************************************