X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FOccName.lhs;h=439a2f88313129eb09c845f6cb0179ef28607c89;hp=a3661a9ab0d093eba7e43ee1574dcc9a8a8c4f33;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index a3661a9..439a2f8 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -1,89 +1,110 @@ -{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-} % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -\section[OccName]{@OccName@} - \begin{code} +-- | +-- #name_types# +-- 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 +-- data constructors +-- +-- * 'RdrName.RdrName': see "RdrName#name_types" +-- +-- * 'Name.Name': see "Name#name_types" +-- +-- * 'Id.Id': see "Id#name_types" +-- +-- * 'Var.Var': see "Var#name_types" module OccName ( - -- * The NameSpace type; abstact - NameSpace, tcName, clsName, tcClsName, dataName, varName, + -- * The 'NameSpace' type + NameSpace, -- Abstract + + -- ** Construction + -- $real_vs_source_data_constructors + tcName, clsName, tcClsName, dataName, varName, tvName, srcDataName, - -- ** Printing + -- ** Pretty Printing pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief, - -- * The OccName type + -- * The 'OccName' type OccName, -- Abstract, instance of Outputable pprOccName, -- ** Construction mkOccName, mkOccNameFS, mkVarOcc, mkVarOccFS, - mkTyVarOcc, + mkDataOcc, mkDataOccFS, + mkTyVarOcc, mkTyVarOccFS, + mkTcOcc, mkTcOccFS, + mkClsOcc, mkClsOccFS, mkDFunOcc, mkTupleOcc, setOccNameSpace, - -- ** Derived OccNames - mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc, + -- ** Derived 'OccName's + isDerivedOccName, + mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, + mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc, + mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, - mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, + mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc, + mkInstTyCoOcc, mkEqPredCoOcc, + mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, + mkPDataTyConOcc, mkPDataDataConOcc, + mkPReprTyConOcc, + mkPADFunOcc, -- ** Deconstruction occNameFS, occNameString, occNameSpace, isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc, - parenSymOcc, reportIfUnused, isTcClsName, isVarName, + parenSymOcc, startsWithUnderscore, + + isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace, isTupleOcc_maybe, - -- The OccEnv type + -- * The 'OccEnv' type OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv, - lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv, + lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C, + extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv, - -- The OccSet type + -- * The 'OccSet' type OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, extendOccSetList, unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts, foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet, - - -- Tidying up + + -- * Tidying up TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv, - -- The basic form of names + -- * Lexical characteristics of Haskell names isLexCon, isLexVar, isLexId, isLexSym, isLexConId, isLexConSym, isLexVarId, isLexVarSym, startsVarSym, startsVarId, startsConSym, startsConId ) where -#include "HsVersions.h" +#include "Typeable.h" -import Util ( thenCmp ) -import Unique ( Unique, mkUnique, Uniquable(..) ) -import BasicTypes ( Boxity(..), Arity ) -import StaticFlags ( opt_PprStyle_Debug ) +import Util +import Unique +import BasicTypes import UniqFM import UniqSet import FastString import Outputable import Binary - -import GLAEXTS - -import Data.Char ( isUpper, isLower, ord ) - --- Unicode TODO: put isSymbol in libcompat -#if __GLASGOW_HASKELL__ > 604 -import Data.Char ( isSymbol ) -#else -isSymbol = const False -#endif - +import StaticFlags( opt_SuppressUniques ) +import Data.Char +import Data.Data \end{code} %************************************************************************ @@ -93,8 +114,8 @@ isSymbol = const False %************************************************************************ \begin{code} -data NameSpace = VarName -- Variables, including "source" data constructors - | DataName -- "Real" data constructors +data NameSpace = VarName -- Variables, including "real" data constructors + | DataName -- "Source" data constructors | TvName -- Type variables | TcClsName -- Type constructors and classes; Haskell has them -- in the same name space for now. @@ -103,21 +124,26 @@ data NameSpace = VarName -- Variables, including "source" data constructors -- Note [Data Constructors] -- see also: Note [Data Constructor Naming] in DataCon.lhs --- --- "Source" data constructors are the data constructors mentioned --- in Haskell source code -- --- "Real" data constructors are the data constructors of the --- representation type, which may not be the same as the source --- type - --- Example: --- data T = T !(Int,Int) +-- $real_vs_source_data_constructors +-- There are two forms of data constructor: +-- +-- [Source data constructors] The data constructors mentioned in Haskell source code +-- +-- [Real data constructors] The data constructors of the representation type, which may not be the same as the source type +-- +-- For example: +-- +-- > data T = T !(Int, Int) +-- +-- The source datacon has type @(Int, Int) -> T@ +-- The real datacon has type @Int -> Int -> T@ -- --- The source datacon has type (Int,Int) -> T --- The real datacon has type Int -> Int -> T -- GHC chooses a representation based on the strictness etc. +tcName, clsName, tcClsName :: NameSpace +dataName, srcDataName :: NameSpace +tvName, varName :: NameSpace -- Though type constructors and classes are in the same name space now, -- the NameSpace type is abstract, so we can easily separate them later @@ -132,29 +158,43 @@ srcDataName = DataName -- Haskell-source data constructors should be tvName = TvName varName = VarName -isTcClsName :: NameSpace -> Bool -isTcClsName TcClsName = True -isTcClsName _ = False +isDataConNameSpace :: NameSpace -> Bool +isDataConNameSpace DataName = True +isDataConNameSpace _ = False + +isTcClsNameSpace :: NameSpace -> Bool +isTcClsNameSpace TcClsName = True +isTcClsNameSpace _ = False + +isTvNameSpace :: NameSpace -> Bool +isTvNameSpace TvName = True +isTvNameSpace _ = False -isVarName :: NameSpace -> Bool -- Variables or type variables, but not constructors -isVarName TvName = True -isVarName VarName = True -isVarName other = False +isVarNameSpace :: NameSpace -> Bool -- Variables or type variables, but not constructors +isVarNameSpace TvName = True +isVarNameSpace VarName = True +isVarNameSpace _ = False + +isValNameSpace :: NameSpace -> Bool +isValNameSpace DataName = True +isValNameSpace VarName = True +isValNameSpace _ = False pprNameSpace :: NameSpace -> SDoc -pprNameSpace DataName = ptext SLIT("data constructor") -pprNameSpace VarName = ptext SLIT("variable") -pprNameSpace TvName = ptext SLIT("type variable") -pprNameSpace TcClsName = ptext SLIT("type constructor or class") +pprNameSpace DataName = ptext (sLit "data constructor") +pprNameSpace VarName = ptext (sLit "variable") +pprNameSpace TvName = ptext (sLit "type variable") +pprNameSpace TcClsName = ptext (sLit "type constructor or class") pprNonVarNameSpace :: NameSpace -> SDoc pprNonVarNameSpace VarName = empty pprNonVarNameSpace ns = pprNameSpace ns +pprNameSpaceBrief :: NameSpace -> SDoc pprNameSpaceBrief DataName = char 'd' pprNameSpaceBrief VarName = char 'v' -pprNameSpaceBrief TvName = ptext SLIT("tv") -pprNameSpaceBrief TcClsName = ptext SLIT("tc") +pprNameSpaceBrief TvName = ptext (sLit "tv") +pprNameSpaceBrief TcClsName = ptext (sLit "tc") \end{code} @@ -177,8 +217,17 @@ instance Eq OccName where (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2 instance Ord OccName where - compare (OccName sp1 s1) (OccName sp2 s2) = (s1 `compare` s2) `thenCmp` - (sp1 `compare` sp2) + -- 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} @@ -196,12 +245,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 %************************************************************************ %* * @@ -222,8 +285,29 @@ mkVarOcc s = mkOccName varName s mkVarOccFS :: FastString -> OccName mkVarOccFS fs = mkOccNameFS varName fs -mkTyVarOcc :: FastString -> OccName -mkTyVarOcc fs = mkOccNameFS tvName fs +mkDataOcc :: String -> OccName +mkDataOcc = mkOccName dataName + +mkDataOccFS :: FastString -> OccName +mkDataOccFS = mkOccNameFS dataName + +mkTyVarOcc :: String -> OccName +mkTyVarOcc = mkOccName tvName + +mkTyVarOccFS :: FastString -> OccName +mkTyVarOccFS fs = mkOccNameFS tvName fs + +mkTcOcc :: String -> OccName +mkTcOcc = mkOccName tcName + +mkTcOccFS :: FastString -> OccName +mkTcOccFS = mkOccNameFS tcName + +mkClsOcc :: String -> OccName +mkClsOcc = mkOccName clsName + +mkClsOccFS :: FastString -> OccName +mkClsOccFS = mkOccNameFS clsName \end{code} @@ -235,24 +319,26 @@ mkTyVarOcc fs = mkOccNameFS tvName fs 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 (I# (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 -type OccEnv a = UniqFM a +newtype OccEnv a = A (UniqFM a) emptyOccEnv :: OccEnv a unitOccEnv :: OccName -> a -> OccEnv a @@ -260,29 +346,42 @@ extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a lookupOccEnv :: OccEnv a -> OccName -> Maybe a mkOccEnv :: [(OccName,a)] -> OccEnv a +mkOccEnv_C :: (a -> a -> a) -> [(OccName,a)] -> OccEnv a 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 - -emptyOccEnv = emptyUFM -unitOccEnv = unitUFM -extendOccEnv = addToUFM -extendOccEnvList = addListToUFM -lookupOccEnv = lookupUFM -mkOccEnv = listToUFM -elemOccEnv = elemUFM -foldOccEnv = foldUFM -occEnvElts = eltsUFM -plusOccEnv = plusUFM -plusOccEnv_C = plusUFM_C -extendOccEnv_C = addToUFM_C -mapOccEnv = mapUFM - -type OccSet = UniqFM OccName +delFromOccEnv :: OccEnv a -> OccName -> OccEnv a +delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a +filterOccEnv :: (elt -> Bool) -> OccEnv elt -> OccEnv elt + +emptyOccEnv = A emptyUFM +unitOccEnv x y = A $ unitUFM x y +extendOccEnv (A x) y z = A $ addToUFM x y z +extendOccEnvList (A x) l = A $ addListToUFM x l +lookupOccEnv (A x) y = lookupUFM x y +mkOccEnv l = A $ listToUFM l +elemOccEnv x (A y) = elemUFM x y +foldOccEnv a b (A c) = foldUFM a b c +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 +delListFromOccEnv (A x) y = A $ delListFromUFM x y +filterOccEnv x (A y) = A $ filterUFM x y + +instance Outputable a => Outputable (OccEnv a) where + ppr (A x) = ppr x + +type OccSet = UniqSet OccName emptyOccSet :: OccSet unitOccSet :: OccName -> OccSet @@ -329,56 +428,63 @@ occNameString (OccName _ s) = unpackFS s setOccNameSpace :: NameSpace -> OccName -> OccName setOccNameSpace sp (OccName _ occ) = OccName sp occ -isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool +isVarOcc, isTvOcc, isTcOcc, isDataOcc :: OccName -> Bool isVarOcc (OccName VarName _) = True -isVarOcc other = False +isVarOcc _ = False isTvOcc (OccName TvName _) = True -isTvOcc other = False +isTvOcc _ = False isTcOcc (OccName TcClsName _) = True -isTcOcc other = False +isTcOcc _ = False +-- | /Value/ 'OccNames's are those that are either in +-- the variable or data constructor namespaces +isValOcc :: OccName -> Bool isValOcc (OccName VarName _) = True isValOcc (OccName DataName _) = True -isValOcc other = False - --- Data constructor operator (starts with ':', or '[]') --- Pretty inefficient! -isDataSymOcc (OccName DataName s) = isLexConSym s -isDataSymOcc (OccName VarName s) - | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s) - -- Jan06: I don't think this should happen -isDataSymOcc other = False +isValOcc _ = False isDataOcc (OccName DataName _) = True isDataOcc (OccName VarName s) | isLexCon s = pprPanic "isDataOcc: check me" (ppr s) -- Jan06: I don't think this should happen -isDataOcc other = False +isDataOcc _ = False --- Any operator (data constructor or variable) +-- | Test if the 'OccName' is a data constructor that starts with +-- a symbol (e.g. @:@, or @[]@) +isDataSymOcc :: OccName -> Bool +isDataSymOcc (OccName DataName s) = isLexConSym s +isDataSymOcc (OccName VarName s) + | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s) + -- Jan06: I don't think this should happen +isDataSymOcc _ = False -- Pretty inefficient! + +-- | Test if the 'OccName' is that for any operator (whether +-- it is a data constructor or variable or whatever) +isSymOcc :: OccName -> Bool isSymOcc (OccName DataName s) = isLexConSym s isSymOcc (OccName TcClsName s) = isLexConSym s isSymOcc (OccName VarName s) = isLexSym s -isSymOcc other = False +isSymOcc (OccName TvName s) = isLexSym s +-- Pretty inefficient! parenSymOcc :: OccName -> SDoc -> SDoc --- Wrap parens around an operator +-- ^ Wrap parens around an operator parenSymOcc occ doc | isSymOcc occ = parens doc | otherwise = doc \end{code} \begin{code} -reportIfUnused :: OccName -> Bool - -- Haskell 98 encourages compilers to suppress warnings about - -- unused names in a pattern if they start with "_". -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} @@ -390,25 +496,30 @@ reportIfUnused occ = case occNameString occ of Here's our convention for splitting up the interface file name space: - d... dictionary identifiers - (local variables, so no name-clash worries) + d... dictionary identifiers + (local variables, so no name-clash worries) + +All of these other OccNames contain a mixture of alphabetic +and symbolic characters, and hence cannot possibly clash with +a user-written type or function name - $f... dict-fun identifiers (from inst decls) - $dm... default methods - $p... superclass selectors - $w... workers - :T... compiler-generated tycons for dictionaries - :D... ...ditto data cons - $sf.. specialised version of f + $f... Dict-fun identifiers (from inst decls) + $dmop Default method for 'op' + $pnC n'th superclass selector for class C + $wf Worker for functtoin 'f' + $sf.. Specialised version of f + T:C Tycon for dictionary for class C + D:C Data constructor for dictionary for class C + NTCo:T Coercion connecting newtype T with its representation type + TFCo:R Coercion connecting a data family to its respresentation type R - in encoded form these appear as Zdfxxx etc +In encoded form these appear as Zdfxxx etc :... keywords (export:, letrec: etc.) --- I THINK THIS IS WRONG! This knowledge is encoded in the following functions. - @mk_deriv@ generates an @OccName@ from the prefix and a string. NB: The string must already be encoded! @@ -419,27 +530,47 @@ mk_deriv :: NameSpace -> OccName mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str) + +isDerivedOccName :: OccName -> Bool +isDerivedOccName occ = + case occNameString occ of + '$':c:_ | isAlphaNum c -> True + ':':c:_ | isAlphaNum c -> True + _other -> False \end{code} \begin{code} mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, - mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc + mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc, + mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc, + mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, + mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, + 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 +mkClassTyConOcc = mk_simple_deriv tcName "T:" -- as a tycon/datacon +mkClassDataConOcc = mk_simple_deriv dataName "D:" -- We go straight to the "real" data con -- for datacons from classes 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" + +-- used in derived instances +mkCon2TagOcc = mk_simple_deriv varName "$con2tag_" +mkTag2ConOcc = mk_simple_deriv varName "$tag2con_" +mkMaxTagOcc = mk_simple_deriv varName "$maxtag_" -- Generic derivable classes mkGenOcc1 = mk_simple_deriv varName "$gfrom" @@ -451,6 +582,17 @@ mkGenOcc2 = mk_simple_deriv varName "$gto" mkDataTOcc = mk_simple_deriv varName "$t" mkDataCOcc = mk_simple_deriv varName "$c" +-- Vectorisation +mkVectOcc = mk_simple_deriv varName "$v_" +mkVectTyConOcc = mk_simple_deriv tcName ":V_" +mkVectDataConOcc = mk_simple_deriv dataName ":VD_" +mkVectIsoOcc = mk_simple_deriv varName "$VI_" +mkPDataTyConOcc = mk_simple_deriv tcName ":VP_" +mkPDataDataConOcc = mk_simple_deriv dataName ":VPD_" +mkPReprTyConOcc = mk_simple_deriv tcName ":VR_" +mkPADFunOcc = mk_simple_deriv varName "$PA_" + +mk_simple_deriv :: NameSpace -> String -> OccName -> OccName mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ) -- Data constructor workers are made by setting the name space @@ -460,40 +602,59 @@ mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ \end{code} \begin{code} -mkSuperDictSelOcc :: Int -- Index of superclass, eg 3 - -> OccName -- Class, eg "Ord" - -> OccName -- eg "$p3Ord" +mkSuperDictSelOcc :: Int -- ^ Index of superclass, e.g. 3 + -> OccName -- ^ Class, e.g. @Ord@ + -> OccName -- ^ Derived 'Occname', e.g. @$p3Ord@ mkSuperDictSelOcc index cls_occ = mk_deriv varName "$p" (show index ++ occNameString cls_occ) -mkLocalOcc :: Unique -- Unique - -> OccName -- Local name (e.g. "sat") - -> OccName -- Nice unique version ("$L23sat") +mkLocalOcc :: Unique -- ^ Unique to combine with the 'OccName' + -> OccName -- ^ Local name, e.g. @sat@ + -> OccName -- ^ Nice unique version, e.g. @$L23sat@ mkLocalOcc uniq occ = mk_deriv varName ("$L" ++ show uniq) (occNameString occ) -- The Unique might print with characters -- that need encoding (e.g. 'z'!) \end{code} +\begin{code} +-- | Derive a name for the representation type constructor of a +-- @data@\/@newtype@ instance. +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" +mkDFunOcc :: String -- ^ Typically the class and type glommed together e.g. @OrdMaybe@. -- Only used in debug mode, for extra clarity - -> Bool -- True <=> hs-boot instance dfun - -> Int -- Unique index - -> OccName -- "$f3OrdMaybe" + -> Bool -- ^ Is this a hs-boot instance DFun? + -> 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 @@ -517,8 +678,8 @@ guys never show up in error messages. What a hack. \begin{code} mkMethodOcc :: OccName -> OccName -mkMethodOcc occ@(OccName VarName fs) = occ -mkMethodOcc occ = mk_simple_deriv varName "$m" occ +mkMethodOcc occ@(OccName VarName _) = occ +mkMethodOcc occ = mk_simple_deriv varName "$m" occ \end{code} @@ -543,6 +704,7 @@ tack on the '1', if necessary. type TidyOccEnv = OccEnv Int -- The in-scope OccNames -- Range gives a plausible starting point for new guesses +emptyTidyOccEnv :: TidyOccEnv emptyTidyOccEnv = emptyOccEnv initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid! @@ -613,18 +775,18 @@ isLexSym cs = isLexConSym cs || isLexVarSym cs ------------- isLexConId cs -- Prefix type or data constructors - | nullFS cs = False -- e.g. "Foo", "[]", "(,)" - | cs == FSLIT("[]") = True - | otherwise = startsConId (headFS cs) + | nullFS cs = False -- e.g. "Foo", "[]", "(,)" + | cs == (fsLit "[]") = True + | otherwise = startsConId (headFS cs) isLexVarId cs -- Ordinary prefix identifiers | nullFS cs = False -- e.g. "x", "_x" | otherwise = startsVarId (headFS cs) isLexConSym cs -- Infix type or data constructors - | nullFS cs = False -- e.g. ":-:", ":", "->" - | cs == FSLIT("->") = True - | otherwise = startsConSym (headFS cs) + | nullFS cs = False -- e.g. ":-:", ":", "->" + | cs == (fsLit "->") = True + | otherwise = startsConSym (headFS cs) isLexVarSym cs -- Infix identifiers | nullFS cs = False -- e.g. "+" @@ -637,6 +799,7 @@ startsConSym c = c == ':' -- Infix data constructors startsVarId c = isLower c || c == '_' -- Ordinary Ids startsConId c = isUpper c || c == '(' -- Ordinary type constructors and data constructors +isSymbolASCII :: Char -> Bool isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-" \end{code}