{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- #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
        NameSpace, -- Abstract

        nameSpacesRelated,

        -- ** Construction
        -- $real_vs_source_data_constructors
        tcName, clsName, tcClsName, dataName, varName,
        tvName, srcDataName,

        -- ** Pretty Printing
        pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,

        -- * The 'OccName' type
        OccName,        -- Abstract, instance of Outputable
        pprOccName,

        -- ** Construction
        mkOccName, mkOccNameFS,
        mkVarOcc, mkVarOccFS,
        mkDataOcc, mkDataOccFS,
        mkTyVarOcc, mkTyVarOccFS,
        mkTcOcc, mkTcOccFS,
        mkClsOcc, mkClsOccFS,
        mkDFunOcc,
        setOccNameSpace,
        demoteOccName,
        HasOccName(..),

        -- ** Derived 'OccName's
        isDerivedOccName,
        mkDataConWrapperOcc, mkWorkerOcc,
        mkMatcherOcc, mkBuilderOcc,
        mkDefaultMethodOcc, isDefaultMethodOcc, isTypeableBindOcc,
        mkNewTyCoOcc, mkClassOpAuxOcc,
        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
        mkClassDataConOcc, mkDictOcc, mkIPOcc,
        mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
        mkGenR, mkGen1R,
        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
        mkSuperDictSelOcc, mkSuperDictAuxOcc,
        mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
        mkInstTyCoOcc, mkEqPredCoOcc,
        mkRecFldSelOcc,
        mkTyConRepOcc,

        -- ** Deconstruction
        occNameFS, occNameString, occNameSpace,

        isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
        parenSymOcc, startsWithUnderscore,

        isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,

        -- * The 'OccEnv' type
        OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
        lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
        occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
        extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
        alterOccEnv, pprOccEnv,

        -- * The 'OccSet' type
        OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
        extendOccSetList,
        unionOccSets, unionManyOccSets, minusOccSet, elemOccSet,
        isEmptyOccSet, intersectOccSet, intersectsOccSet,
        filterOccSet,

        -- * Tidying up
        TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv,
        tidyOccName, avoidClashesOccEnv,

        -- FsEnv
        FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
    ) where

import GhcPrelude

import Util
import Unique
import DynFlags
import UniqFM
import UniqSet
import FastString
import FastStringEnv
import Outputable
import Lexeme
import Binary
import Control.DeepSeq
import Data.Char
import Data.Data

{-
************************************************************************
*                                                                      *
\subsection{Name space}
*                                                                      *
************************************************************************
-}

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.
               deriving( NameSpace -> NameSpace -> Bool
(NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool) -> Eq NameSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameSpace -> NameSpace -> Bool
$c/= :: NameSpace -> NameSpace -> Bool
== :: NameSpace -> NameSpace -> Bool
$c== :: NameSpace -> NameSpace -> Bool
Eq, Eq NameSpace
Eq NameSpace
-> (NameSpace -> NameSpace -> Ordering)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> NameSpace)
-> (NameSpace -> NameSpace -> NameSpace)
-> Ord NameSpace
NameSpace -> NameSpace -> Bool
NameSpace -> NameSpace -> Ordering
NameSpace -> NameSpace -> NameSpace
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NameSpace -> NameSpace -> NameSpace
$cmin :: NameSpace -> NameSpace -> NameSpace
max :: NameSpace -> NameSpace -> NameSpace
$cmax :: NameSpace -> NameSpace -> NameSpace
>= :: NameSpace -> NameSpace -> Bool
$c>= :: NameSpace -> NameSpace -> Bool
> :: NameSpace -> NameSpace -> Bool
$c> :: NameSpace -> NameSpace -> Bool
<= :: NameSpace -> NameSpace -> Bool
$c<= :: NameSpace -> NameSpace -> Bool
< :: NameSpace -> NameSpace -> Bool
$c< :: NameSpace -> NameSpace -> Bool
compare :: NameSpace -> NameSpace -> Ordering
$ccompare :: NameSpace -> NameSpace -> Ordering
$cp1Ord :: Eq NameSpace
Ord )

-- Note [Data Constructors]
-- see also: Note [Data Constructor Naming] in DataCon.hs
--
-- $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@
--
-- 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
tcName :: NameSpace
tcName    = NameSpace
TcClsName           -- Type constructors
clsName :: NameSpace
clsName   = NameSpace
TcClsName           -- Classes
tcClsName :: NameSpace
tcClsName = NameSpace
TcClsName           -- Not sure which!

dataName :: NameSpace
dataName    = NameSpace
DataName
srcDataName :: NameSpace
srcDataName = NameSpace
DataName  -- Haskell-source data constructors should be
                        -- in the Data name space

tvName :: NameSpace
tvName      = NameSpace
TvName
varName :: NameSpace
varName     = NameSpace
VarName

isDataConNameSpace :: NameSpace -> Bool
isDataConNameSpace :: NameSpace -> Bool
isDataConNameSpace NameSpace
DataName = Bool
True
isDataConNameSpace NameSpace
_        = Bool
False

isTcClsNameSpace :: NameSpace -> Bool
isTcClsNameSpace :: NameSpace -> Bool
isTcClsNameSpace NameSpace
TcClsName = Bool
True
isTcClsNameSpace NameSpace
_         = Bool
False

isTvNameSpace :: NameSpace -> Bool
isTvNameSpace :: NameSpace -> Bool
isTvNameSpace NameSpace
TvName = Bool
True
isTvNameSpace NameSpace
_      = Bool
False

isVarNameSpace :: NameSpace -> Bool     -- Variables or type variables, but not constructors
isVarNameSpace :: NameSpace -> Bool
isVarNameSpace NameSpace
TvName  = Bool
True
isVarNameSpace NameSpace
VarName = Bool
True
isVarNameSpace NameSpace
_       = Bool
False

isValNameSpace :: NameSpace -> Bool
isValNameSpace :: NameSpace -> Bool
isValNameSpace NameSpace
DataName = Bool
True
isValNameSpace NameSpace
VarName  = Bool
True
isValNameSpace NameSpace
_        = Bool
False

pprNameSpace :: NameSpace -> SDoc
pprNameSpace :: NameSpace -> SDoc
pprNameSpace NameSpace
DataName  = String -> SDoc
text String
"data constructor"
pprNameSpace NameSpace
VarName   = String -> SDoc
text String
"variable"
pprNameSpace NameSpace
TvName    = String -> SDoc
text String
"type variable"
pprNameSpace NameSpace
TcClsName = String -> SDoc
text String
"type constructor or class"

pprNonVarNameSpace :: NameSpace -> SDoc
pprNonVarNameSpace :: NameSpace -> SDoc
pprNonVarNameSpace NameSpace
VarName = SDoc
empty
pprNonVarNameSpace NameSpace
ns = NameSpace -> SDoc
pprNameSpace NameSpace
ns

pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief NameSpace
DataName  = Char -> SDoc
char Char
'd'
pprNameSpaceBrief NameSpace
VarName   = Char -> SDoc
char Char
'v'
pprNameSpaceBrief NameSpace
TvName    = String -> SDoc
text String
"tv"
pprNameSpaceBrief NameSpace
TcClsName = String -> SDoc
text String
"tc"

-- demoteNameSpace lowers the NameSpace if possible.  We can not know
-- in advance, since a TvName can appear in an HsTyVar.
-- See Note [Demotion] in RnEnv
demoteNameSpace :: NameSpace -> Maybe NameSpace
demoteNameSpace :: NameSpace -> Maybe NameSpace
demoteNameSpace NameSpace
VarName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteNameSpace NameSpace
DataName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteNameSpace NameSpace
TvName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteNameSpace NameSpace
TcClsName = NameSpace -> Maybe NameSpace
forall a. a -> Maybe a
Just NameSpace
DataName

{-
************************************************************************
*                                                                      *
\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
*                                                                      *
************************************************************************
-}

-- | Occurrence Name
--
-- In this context that means:
-- "classified (i.e. as a type name, value name, etc) but not qualified
-- and not yet resolved"
data OccName = OccName
    { OccName -> NameSpace
occNameSpace  :: !NameSpace
    , OccName -> FastString
occNameFS     :: !FastString
    }

instance Eq OccName where
    (OccName NameSpace
sp1 FastString
s1) == :: OccName -> OccName -> Bool
== (OccName NameSpace
sp2 FastString
s2) = FastString
s1 FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
s2 Bool -> Bool -> Bool
&& NameSpace
sp1 NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
sp2

instance Ord OccName where
        -- Compares lexicographically, *not* by Unique of the string
    compare :: OccName -> OccName -> Ordering
compare (OccName NameSpace
sp1 FastString
s1) (OccName NameSpace
sp2 FastString
s2)
        = (FastString
s1  FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` FastString
s2) Ordering -> Ordering -> Ordering
`thenCmp` (NameSpace
sp1 NameSpace -> NameSpace -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` NameSpace
sp2)

instance Data OccName where
  -- don't traverse?
  toConstr :: OccName -> Constr
toConstr OccName
_   = String -> Constr
abstractConstr String
"OccName"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OccName
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c OccName
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: OccName -> DataType
dataTypeOf OccName
_ = String -> DataType
mkNoRepType String
"OccName"

instance HasOccName OccName where
  occName :: OccName -> OccName
occName = OccName -> OccName
forall a. a -> a
id

instance NFData OccName where
  rnf :: OccName -> ()
rnf OccName
x = OccName
x OccName -> () -> ()
`seq` ()

{-
************************************************************************
*                                                                      *
\subsection{Printing}
*                                                                      *
************************************************************************
-}

instance Outputable OccName where
    ppr :: OccName -> SDoc
ppr = OccName -> SDoc
pprOccName

instance OutputableBndr OccName where
    pprBndr :: BindingSite -> OccName -> SDoc
pprBndr BindingSite
_ = OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr
    pprInfixOcc :: OccName -> SDoc
pprInfixOcc OccName
n = Bool -> SDoc -> SDoc
pprInfixVar (OccName -> Bool
isSymOcc OccName
n) (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
n)
    pprPrefixOcc :: OccName -> SDoc
pprPrefixOcc OccName
n = Bool -> SDoc -> SDoc
pprPrefixVar (OccName -> Bool
isSymOcc OccName
n) (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
n)

pprOccName :: OccName -> SDoc
pprOccName :: OccName -> SDoc
pprOccName (OccName NameSpace
sp FastString
occ)
  = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
    if PprStyle -> Bool
codeStyle PprStyle
sty
    then FastZString -> SDoc
ztext (FastString -> FastZString
zEncodeFS FastString
occ)
    else SDoc
pp_occ SDoc -> SDoc -> SDoc
<> PprStyle -> SDoc
pp_debug PprStyle
sty
  where
    pp_debug :: PprStyle -> SDoc
pp_debug PprStyle
sty | PprStyle -> Bool
debugStyle PprStyle
sty = SDoc -> SDoc
braces (NameSpace -> SDoc
pprNameSpaceBrief NameSpace
sp)
                 | Bool
otherwise      = SDoc
empty

    pp_occ :: SDoc
pp_occ = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
             if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressUniques DynFlags
dflags
             then String -> SDoc
text (String -> String
strip_th_unique (FastString -> String
unpackFS FastString
occ))
             else FastString -> SDoc
ftext FastString
occ

        -- See Note [Suppressing uniques in OccNames]
    strip_th_unique :: String -> String
strip_th_unique (Char
'[' : Char
c : String
_) | Char -> Bool
isAlphaNum Char
c = []
    strip_th_unique (Char
c : String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
strip_th_unique String
cs
    strip_th_unique []       = []

{-
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

************************************************************************
*                                                                      *
\subsection{Construction}
*                                                                      *
************************************************************************
-}

mkOccName :: NameSpace -> String -> OccName
mkOccName :: NameSpace -> String -> OccName
mkOccName NameSpace
occ_sp String
str = NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp (String -> FastString
mkFastString String
str)

mkOccNameFS :: NameSpace -> FastString -> OccName
mkOccNameFS :: NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
occ_sp FastString
fs = NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp FastString
fs

mkVarOcc :: String -> OccName
mkVarOcc :: String -> OccName
mkVarOcc String
s = NameSpace -> String -> OccName
mkOccName NameSpace
varName String
s

mkVarOccFS :: FastString -> OccName
mkVarOccFS :: FastString -> OccName
mkVarOccFS FastString
fs = NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
varName FastString
fs

mkDataOcc :: String -> OccName
mkDataOcc :: String -> OccName
mkDataOcc = NameSpace -> String -> OccName
mkOccName NameSpace
dataName

mkDataOccFS :: FastString -> OccName
mkDataOccFS :: FastString -> OccName
mkDataOccFS = NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
dataName

mkTyVarOcc :: String -> OccName
mkTyVarOcc :: String -> OccName
mkTyVarOcc = NameSpace -> String -> OccName
mkOccName NameSpace
tvName

mkTyVarOccFS :: FastString -> OccName
mkTyVarOccFS :: FastString -> OccName
mkTyVarOccFS FastString
fs = NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
tvName FastString
fs

mkTcOcc :: String -> OccName
mkTcOcc :: String -> OccName
mkTcOcc = NameSpace -> String -> OccName
mkOccName NameSpace
tcName

mkTcOccFS :: FastString -> OccName
mkTcOccFS :: FastString -> OccName
mkTcOccFS = NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
tcName

mkClsOcc :: String -> OccName
mkClsOcc :: String -> OccName
mkClsOcc = NameSpace -> String -> OccName
mkOccName NameSpace
clsName

mkClsOccFS :: FastString -> OccName
mkClsOccFS :: FastString -> OccName
mkClsOccFS = NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
clsName

-- demoteOccName lowers the Namespace of OccName.
-- see Note [Demotion]
demoteOccName :: OccName -> Maybe OccName
demoteOccName :: OccName -> Maybe OccName
demoteOccName (OccName NameSpace
space FastString
name) = do
  NameSpace
space' <- NameSpace -> Maybe NameSpace
demoteNameSpace NameSpace
space
  OccName -> Maybe OccName
forall (m :: * -> *) a. Monad m => a -> m a
return (OccName -> Maybe OccName) -> OccName -> Maybe OccName
forall a b. (a -> b) -> a -> b
$ NameSpace -> FastString -> OccName
OccName NameSpace
space' FastString
name

-- Name spaces are related if there is a chance to mean the one when one writes
-- the other, i.e. variables <-> data constructors and type variables <-> type constructors
nameSpacesRelated :: NameSpace -> NameSpace -> Bool
nameSpacesRelated :: NameSpace -> NameSpace -> Bool
nameSpacesRelated NameSpace
ns1 NameSpace
ns2 = NameSpace
ns1 NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
ns2 Bool -> Bool -> Bool
|| NameSpace -> NameSpace
otherNameSpace NameSpace
ns1 NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
ns2

otherNameSpace :: NameSpace -> NameSpace
otherNameSpace :: NameSpace -> NameSpace
otherNameSpace NameSpace
VarName = NameSpace
DataName
otherNameSpace NameSpace
DataName = NameSpace
VarName
otherNameSpace NameSpace
TvName = NameSpace
TcClsName
otherNameSpace NameSpace
TcClsName = NameSpace
TvName



{- | Other names in the compiler add additional information to an OccName.
This class provides a consistent way to access the underlying OccName. -}
class HasOccName name where
  occName :: name -> OccName

{-
************************************************************************
*                                                                      *
                Environments
*                                                                      *
************************************************************************

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, 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 representing the name space.  This in turn makes it
easy to build an OccEnv.
-}

instance Uniquable OccName where
      -- See Note [The Unique of an OccName]
  getUnique :: OccName -> Unique
getUnique (OccName NameSpace
VarName   FastString
fs) = FastString -> Unique
mkVarOccUnique  FastString
fs
  getUnique (OccName NameSpace
DataName  FastString
fs) = FastString -> Unique
mkDataOccUnique FastString
fs
  getUnique (OccName NameSpace
TvName    FastString
fs) = FastString -> Unique
mkTvOccUnique   FastString
fs
  getUnique (OccName NameSpace
TcClsName FastString
fs) = FastString -> Unique
mkTcOccUnique   FastString
fs

newtype OccEnv a = A (UniqFM a)
  deriving Typeable (OccEnv a)
DataType
Constr
Typeable (OccEnv a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (OccEnv a))
-> (OccEnv a -> Constr)
-> (OccEnv a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (OccEnv a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (OccEnv a)))
-> ((forall b. Data b => b -> b) -> OccEnv a -> OccEnv a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OccEnv a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OccEnv a -> r)
-> (forall u. (forall d. Data d => d -> u) -> OccEnv a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OccEnv a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a))
-> Data (OccEnv a)
OccEnv a -> DataType
OccEnv a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (OccEnv a))
(forall b. Data b => b -> b) -> OccEnv a -> OccEnv a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (OccEnv a)
forall a. Data a => Typeable (OccEnv a)
forall a. Data a => OccEnv a -> DataType
forall a. Data a => OccEnv a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> OccEnv a -> OccEnv a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> OccEnv a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> OccEnv a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (OccEnv a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (OccEnv a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (OccEnv a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OccEnv a -> u
forall u. (forall d. Data d => d -> u) -> OccEnv a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (OccEnv a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (OccEnv a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (OccEnv a))
$cA :: Constr
$tOccEnv :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
gmapMp :: (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
gmapM :: (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> OccEnv a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> OccEnv a -> u
gmapQ :: (forall d. Data d => d -> u) -> OccEnv a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> OccEnv a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OccEnv a -> r
gmapT :: (forall b. Data b => b -> b) -> OccEnv a -> OccEnv a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> OccEnv a -> OccEnv a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (OccEnv a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (OccEnv a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (OccEnv a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (OccEnv a))
dataTypeOf :: OccEnv a -> DataType
$cdataTypeOf :: forall a. Data a => OccEnv a -> DataType
toConstr :: OccEnv a -> Constr
$ctoConstr :: forall a. Data a => OccEnv a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (OccEnv a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (OccEnv a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a)
$cp1Data :: forall a. Data a => Typeable (OccEnv a)
Data

emptyOccEnv :: OccEnv a
unitOccEnv  :: OccName -> a -> OccEnv a
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
delFromOccEnv      :: OccEnv a -> OccName -> OccEnv a
delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a
filterOccEnv       :: (elt -> Bool) -> OccEnv elt -> OccEnv elt
alterOccEnv        :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt

emptyOccEnv :: OccEnv a
emptyOccEnv      = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A UniqFM a
forall elt. UniqFM elt
emptyUFM
unitOccEnv :: OccName -> a -> OccEnv a
unitOccEnv OccName
x a
y = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ OccName -> a -> UniqFM a
forall key elt. Uniquable key => key -> elt -> UniqFM elt
unitUFM OccName
x a
y
extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv (A UniqFM a
x) OccName
y a
z = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ UniqFM a -> OccName -> a -> UniqFM a
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM a
x OccName
y a
z
extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
extendOccEnvList (A UniqFM a
x) [(OccName, a)]
l = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ UniqFM a -> [(OccName, a)] -> UniqFM a
forall key elt.
Uniquable key =>
UniqFM elt -> [(key, elt)] -> UniqFM elt
addListToUFM UniqFM a
x [(OccName, a)]
l
lookupOccEnv :: OccEnv a -> OccName -> Maybe a
lookupOccEnv (A UniqFM a
x) OccName
y = UniqFM a -> OccName -> Maybe a
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM a
x OccName
y
mkOccEnv :: [(OccName, a)] -> OccEnv a
mkOccEnv     [(OccName, a)]
l    = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ [(OccName, a)] -> UniqFM a
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
listToUFM [(OccName, a)]
l
elemOccEnv :: OccName -> OccEnv a -> Bool
elemOccEnv OccName
x (A UniqFM a
y)       = OccName -> UniqFM a -> Bool
forall key elt. Uniquable key => key -> UniqFM elt -> Bool
elemUFM OccName
x UniqFM a
y
foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
foldOccEnv a -> b -> b
a b
b (A UniqFM a
c)     = (a -> b -> b) -> b -> UniqFM a -> b
forall elt a. (elt -> a -> a) -> a -> UniqFM elt -> a
foldUFM a -> b -> b
a b
b UniqFM a
c
occEnvElts :: OccEnv a -> [a]
occEnvElts (A UniqFM a
x)         = UniqFM a -> [a]
forall elt. UniqFM elt -> [elt]
eltsUFM UniqFM a
x
plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv (A UniqFM a
x) (A UniqFM a
y)   = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ UniqFM a -> UniqFM a -> UniqFM a
forall elt. UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM UniqFM a
x UniqFM a
y
plusOccEnv_C :: (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C a -> a -> a
f (A UniqFM a
x) (A UniqFM a
y)       = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> UniqFM a -> UniqFM a -> UniqFM a
forall elt.
(elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM_C a -> a -> a
f UniqFM a
x UniqFM a
y
extendOccEnv_C :: (a -> a -> a) -> OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv_C a -> a -> a
f (A UniqFM a
x) OccName
y a
z   = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> UniqFM a -> OccName -> a -> UniqFM a
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> key -> elt -> UniqFM elt
addToUFM_C a -> a -> a
f UniqFM a
x OccName
y a
z
extendOccEnv_Acc :: (a -> b -> b) -> (a -> b) -> OccEnv b -> OccName -> a -> OccEnv b
extendOccEnv_Acc a -> b -> b
f a -> b
g (A UniqFM b
x) OccName
y a
z   = UniqFM b -> OccEnv b
forall a. UniqFM a -> OccEnv a
A (UniqFM b -> OccEnv b) -> UniqFM b -> OccEnv b
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> (a -> b) -> UniqFM b -> OccName -> a -> UniqFM b
forall key elt elts.
Uniquable key =>
(elt -> elts -> elts)
-> (elt -> elts) -> UniqFM elts -> key -> elt -> UniqFM elts
addToUFM_Acc a -> b -> b
f a -> b
g UniqFM b
x OccName
y a
z
mapOccEnv :: (a -> b) -> OccEnv a -> OccEnv b
mapOccEnv a -> b
f (A UniqFM a
x)        = UniqFM b -> OccEnv b
forall a. UniqFM a -> OccEnv a
A (UniqFM b -> OccEnv b) -> UniqFM b -> OccEnv b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> UniqFM a -> UniqFM b
forall elt1 elt2. (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
mapUFM a -> b
f UniqFM a
x
mkOccEnv_C :: (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C a -> a -> a
comb [(OccName, a)]
l = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> UniqFM a -> [(OccName, a)] -> UniqFM a
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> [(key, elt)] -> UniqFM elt
addListToUFM_C a -> a -> a
comb UniqFM a
forall elt. UniqFM elt
emptyUFM [(OccName, a)]
l
delFromOccEnv :: OccEnv a -> OccName -> OccEnv a
delFromOccEnv (A UniqFM a
x) OccName
y    = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ UniqFM a -> OccName -> UniqFM a
forall key elt. Uniquable key => UniqFM elt -> key -> UniqFM elt
delFromUFM UniqFM a
x OccName
y
delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a
delListFromOccEnv (A UniqFM a
x) [OccName]
y  = UniqFM a -> OccEnv a
forall a. UniqFM a -> OccEnv a
A (UniqFM a -> OccEnv a) -> UniqFM a -> OccEnv a
forall a b. (a -> b) -> a -> b
$ UniqFM a -> [OccName] -> UniqFM a
forall key elt. Uniquable key => UniqFM elt -> [key] -> UniqFM elt
delListFromUFM UniqFM a
x [OccName]
y
filterOccEnv :: (elt -> Bool) -> OccEnv elt -> OccEnv elt
filterOccEnv elt -> Bool
x (A UniqFM elt
y)       = UniqFM elt -> OccEnv elt
forall a. UniqFM a -> OccEnv a
A (UniqFM elt -> OccEnv elt) -> UniqFM elt -> OccEnv elt
forall a b. (a -> b) -> a -> b
$ (elt -> Bool) -> UniqFM elt -> UniqFM elt
forall elt. (elt -> Bool) -> UniqFM elt -> UniqFM elt
filterUFM elt -> Bool
x UniqFM elt
y
alterOccEnv :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt
alterOccEnv Maybe elt -> Maybe elt
fn (A UniqFM elt
y) OccName
k     = UniqFM elt -> OccEnv elt
forall a. UniqFM a -> OccEnv a
A (UniqFM elt -> OccEnv elt) -> UniqFM elt -> OccEnv elt
forall a b. (a -> b) -> a -> b
$ (Maybe elt -> Maybe elt) -> UniqFM elt -> OccName -> UniqFM elt
forall key elt.
Uniquable key =>
(Maybe elt -> Maybe elt) -> UniqFM elt -> key -> UniqFM elt
alterUFM Maybe elt -> Maybe elt
fn UniqFM elt
y OccName
k

instance Outputable a => Outputable (OccEnv a) where
    ppr :: OccEnv a -> SDoc
ppr OccEnv a
x = (a -> SDoc) -> OccEnv a -> SDoc
forall a. (a -> SDoc) -> OccEnv a -> SDoc
pprOccEnv a -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccEnv a
x

pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc
pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc
pprOccEnv a -> SDoc
ppr_elt (A UniqFM a
env) = (a -> SDoc) -> UniqFM a -> SDoc
forall a. (a -> SDoc) -> UniqFM a -> SDoc
pprUniqFM a -> SDoc
ppr_elt UniqFM a
env

type OccSet = UniqSet OccName

emptyOccSet       :: OccSet
unitOccSet        :: OccName -> OccSet
mkOccSet          :: [OccName] -> OccSet
extendOccSet      :: OccSet -> OccName -> OccSet
extendOccSetList  :: OccSet -> [OccName] -> OccSet
unionOccSets      :: OccSet -> OccSet -> OccSet
unionManyOccSets  :: [OccSet] -> OccSet
minusOccSet       :: OccSet -> OccSet -> OccSet
elemOccSet        :: OccName -> OccSet -> Bool
isEmptyOccSet     :: OccSet -> Bool
intersectOccSet   :: OccSet -> OccSet -> OccSet
intersectsOccSet  :: OccSet -> OccSet -> Bool
filterOccSet      :: (OccName -> Bool) -> OccSet -> OccSet

emptyOccSet :: OccSet
emptyOccSet       = OccSet
forall a. UniqSet a
emptyUniqSet
unitOccSet :: OccName -> OccSet
unitOccSet        = OccName -> OccSet
forall a. Uniquable a => a -> UniqSet a
unitUniqSet
mkOccSet :: [OccName] -> OccSet
mkOccSet          = [OccName] -> OccSet
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet
extendOccSet :: OccSet -> OccName -> OccSet
extendOccSet      = OccSet -> OccName -> OccSet
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet
extendOccSetList :: OccSet -> [OccName] -> OccSet
extendOccSetList  = OccSet -> [OccName] -> OccSet
forall a. Uniquable a => UniqSet a -> [a] -> UniqSet a
addListToUniqSet
unionOccSets :: OccSet -> OccSet -> OccSet
unionOccSets      = OccSet -> OccSet -> OccSet
forall a. UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets
unionManyOccSets :: [OccSet] -> OccSet
unionManyOccSets  = [OccSet] -> OccSet
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
minusOccSet :: OccSet -> OccSet -> OccSet
minusOccSet       = OccSet -> OccSet -> OccSet
forall a. UniqSet a -> UniqSet a -> UniqSet a
minusUniqSet
elemOccSet :: OccName -> OccSet -> Bool
elemOccSet        = OccName -> OccSet -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
elementOfUniqSet
isEmptyOccSet :: OccSet -> Bool
isEmptyOccSet     = OccSet -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet
intersectOccSet :: OccSet -> OccSet -> OccSet
intersectOccSet   = OccSet -> OccSet -> OccSet
forall a. UniqSet a -> UniqSet a -> UniqSet a
intersectUniqSets
intersectsOccSet :: OccSet -> OccSet -> Bool
intersectsOccSet OccSet
s1 OccSet
s2 = Bool -> Bool
not (OccSet -> Bool
isEmptyOccSet (OccSet
s1 OccSet -> OccSet -> OccSet
`intersectOccSet` OccSet
s2))
filterOccSet :: (OccName -> Bool) -> OccSet -> OccSet
filterOccSet      = (OccName -> Bool) -> OccSet -> OccSet
forall a. (a -> Bool) -> UniqSet a -> UniqSet a
filterUniqSet

{-
************************************************************************
*                                                                      *
\subsection{Predicates and taking them apart}
*                                                                      *
************************************************************************
-}

occNameString :: OccName -> String
occNameString :: OccName -> String
occNameString (OccName NameSpace
_ FastString
s) = FastString -> String
unpackFS FastString
s

setOccNameSpace :: NameSpace -> OccName -> OccName
setOccNameSpace :: NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
sp (OccName NameSpace
_ FastString
occ) = NameSpace -> FastString -> OccName
OccName NameSpace
sp FastString
occ

isVarOcc, isTvOcc, isTcOcc, isDataOcc :: OccName -> Bool

isVarOcc :: OccName -> Bool
isVarOcc (OccName NameSpace
VarName FastString
_) = Bool
True
isVarOcc OccName
_                   = Bool
False

isTvOcc :: OccName -> Bool
isTvOcc (OccName NameSpace
TvName FastString
_) = Bool
True
isTvOcc OccName
_                  = Bool
False

isTcOcc :: OccName -> Bool
isTcOcc (OccName NameSpace
TcClsName FastString
_) = Bool
True
isTcOcc OccName
_                     = Bool
False

-- | /Value/ 'OccNames's are those that are either in
-- the variable or data constructor namespaces
isValOcc :: OccName -> Bool
isValOcc :: OccName -> Bool
isValOcc (OccName NameSpace
VarName  FastString
_) = Bool
True
isValOcc (OccName NameSpace
DataName FastString
_) = Bool
True
isValOcc OccName
_                    = Bool
False

isDataOcc :: OccName -> Bool
isDataOcc (OccName NameSpace
DataName FastString
_) = Bool
True
isDataOcc OccName
_                    = Bool
False

-- | Test if the 'OccName' is a data constructor that starts with
-- a symbol (e.g. @:@, or @[]@)
isDataSymOcc :: OccName -> Bool
isDataSymOcc :: OccName -> Bool
isDataSymOcc (OccName NameSpace
DataName FastString
s) = FastString -> Bool
isLexConSym FastString
s
isDataSymOcc OccName
_                    = Bool
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 -> Bool
isSymOcc (OccName NameSpace
DataName FastString
s)  = FastString -> Bool
isLexConSym FastString
s
isSymOcc (OccName NameSpace
TcClsName FastString
s) = FastString -> Bool
isLexSym FastString
s
isSymOcc (OccName NameSpace
VarName FastString
s)   = FastString -> Bool
isLexSym FastString
s
isSymOcc (OccName NameSpace
TvName FastString
s)    = FastString -> Bool
isLexSym FastString
s
-- Pretty inefficient!

parenSymOcc :: OccName -> SDoc -> SDoc
-- ^ Wrap parens around an operator
parenSymOcc :: OccName -> SDoc -> SDoc
parenSymOcc OccName
occ SDoc
doc | OccName -> Bool
isSymOcc OccName
occ = SDoc -> SDoc
parens SDoc
doc
                    | Bool
otherwise    = SDoc
doc

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 :: OccName -> Bool
startsWithUnderscore OccName
occ = FastString -> Char
headFS (OccName -> FastString
occNameFS OccName
occ) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

{-
************************************************************************
*                                                                      *
\subsection{Making system names}
*                                                                      *
************************************************************************

Here's our convention for splitting up the interface file name space:

   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)
   $dmop        Default method for 'op'
   $pnC         n'th superclass selector for class C
   $wf          Worker for function 'f'
   $sf..        Specialised version of f
   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 representation type R

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!
-}

-- | Build an 'OccName' derived from another 'OccName'.
--
-- Note that the pieces of the name are passed in as a @[FastString]@ so that
-- the whole name can be constructed with a single 'concatFS', minimizing
-- unnecessary intermediate allocations.
mk_deriv :: NameSpace
         -> FastString      -- ^ A prefix which distinguishes one sort of
                            -- derived name from another
         -> [FastString]    -- ^ The name we are deriving from in pieces which
                            -- will be concatenated.
         -> OccName
mk_deriv :: NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
occ_sp FastString
sys_prefix [FastString]
str =
    NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
occ_sp ([FastString] -> FastString
concatFS ([FastString] -> FastString) -> [FastString] -> FastString
forall a b. (a -> b) -> a -> b
$ FastString
sys_prefix FastString -> [FastString] -> [FastString]
forall a. a -> [a] -> [a]
: [FastString]
str)

isDerivedOccName :: OccName -> Bool
-- ^ Test for definitions internally generated by GHC.  This predicte
-- is used to suppress printing of internal definitions in some debug prints
isDerivedOccName :: OccName -> Bool
isDerivedOccName OccName
occ =
   case OccName -> String
occNameString OccName
occ of
     Char
'$':Char
c:String
_ | Char -> Bool
isAlphaNum Char
c -> Bool
True   -- E.g.  $wfoo
     Char
c:Char
':':String
_ | Char -> Bool
isAlphaNum Char
c -> Bool
True   -- E.g.  N:blah   newtype coercions
     String
_other                 -> Bool
False

isDefaultMethodOcc :: OccName -> Bool
isDefaultMethodOcc :: OccName -> Bool
isDefaultMethodOcc OccName
occ =
   case OccName -> String
occNameString OccName
occ of
     Char
'$':Char
'd':Char
'm':String
_ -> Bool
True
     String
_ -> Bool
False

-- | Is an 'OccName' one of a Typeable @TyCon@ or @Module@ binding?
-- This is needed as these bindings are renamed differently.
-- See Note [Grand plan for Typeable] in TcTypeable.
isTypeableBindOcc :: OccName -> Bool
isTypeableBindOcc :: OccName -> Bool
isTypeableBindOcc OccName
occ =
   case OccName -> String
occNameString OccName
occ of
     Char
'$':Char
't':Char
'c':String
_ -> Bool
True  -- mkTyConRepOcc
     Char
'$':Char
't':Char
'r':String
_ -> Bool
True  -- Module binding
     String
_ -> Bool
False

mkDataConWrapperOcc, mkWorkerOcc,
        mkMatcherOcc, mkBuilderOcc,
        mkDefaultMethodOcc,
        mkClassDataConOcc, mkDictOcc,
        mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
        mkGenR, mkGen1R,
        mkDataConWorkerOcc, mkNewTyCoOcc,
        mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
        mkTyConRepOcc
   :: OccName -> OccName

-- These derived variables have a prefix that no Haskell value could have
mkDataConWrapperOcc :: OccName -> OccName
mkDataConWrapperOcc = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$W"
mkWorkerOcc :: OccName -> OccName
mkWorkerOcc         = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$w"
mkMatcherOcc :: OccName -> OccName
mkMatcherOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$m"
mkBuilderOcc :: OccName -> OccName
mkBuilderOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$b"
mkDefaultMethodOcc :: OccName -> OccName
mkDefaultMethodOcc  = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$dm"
mkClassOpAuxOcc :: OccName -> OccName
mkClassOpAuxOcc     = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$c"
mkDictOcc :: OccName -> OccName
mkDictOcc           = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$d"
mkIPOcc :: OccName -> OccName
mkIPOcc             = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$i"
mkSpecOcc :: OccName -> OccName
mkSpecOcc           = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$s"
mkForeignExportOcc :: OccName -> OccName
mkForeignExportOcc  = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$f"
mkRepEqOcc :: OccName -> OccName
mkRepEqOcc          = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tvName   FastString
"$r"   -- In RULES involving Coercible
mkClassDataConOcc :: OccName -> OccName
mkClassDataConOcc   = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
dataName FastString
"C:"     -- Data con for a class
mkNewTyCoOcc :: OccName -> OccName
mkNewTyCoOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName   FastString
"N:"   -- Coercion for newtypes
mkInstTyCoOcc :: OccName -> OccName
mkInstTyCoOcc       = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName   FastString
"D:"   -- Coercion for type functions
mkEqPredCoOcc :: OccName -> OccName
mkEqPredCoOcc       = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName   FastString
"$co"

-- Used in derived instances
mkCon2TagOcc :: OccName -> OccName
mkCon2TagOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$con2tag_"
mkTag2ConOcc :: OccName -> OccName
mkTag2ConOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$tag2con_"
mkMaxTagOcc :: OccName -> OccName
mkMaxTagOcc         = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$maxtag_"

-- TyConRepName stuff; see Note [Grand plan for Typeable] in TcTypeable
mkTyConRepOcc :: OccName -> OccName
mkTyConRepOcc OccName
occ = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName FastString
prefix OccName
occ
  where
    prefix :: FastString
prefix | OccName -> Bool
isDataOcc OccName
occ = FastString
"$tc'"
           | Bool
otherwise     = FastString
"$tc"

-- Generic deriving mechanism
mkGenR :: OccName -> OccName
mkGenR   = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName FastString
"Rep_"
mkGen1R :: OccName -> OccName
mkGen1R  = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName FastString
"Rep1_"

-- Overloaded record field selectors
mkRecFldSelOcc :: String -> OccName
mkRecFldSelOcc :: String -> OccName
mkRecFldSelOcc String
s = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
varName FastString
"$sel" [String -> FastString
fsLit String
s]

mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
sp FastString
px OccName
occ = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
sp FastString
px [OccName -> FastString
occNameFS OccName
occ]

-- Data constructor workers are made by setting the name space
-- of the data constructor OccName (which should be a DataName)
-- to VarName
mkDataConWorkerOcc :: OccName -> OccName
mkDataConWorkerOcc OccName
datacon_occ = NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
varName OccName
datacon_occ

mkSuperDictAuxOcc :: Int -> OccName -> OccName
mkSuperDictAuxOcc :: Int -> OccName -> OccName
mkSuperDictAuxOcc Int
index OccName
cls_tc_occ
  = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
varName FastString
"$cp" [String -> FastString
fsLit (String -> FastString) -> String -> FastString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
index, OccName -> FastString
occNameFS OccName
cls_tc_occ]

mkSuperDictSelOcc :: Int        -- ^ Index of superclass, e.g. 3
                  -> OccName    -- ^ Class, e.g. @Ord@
                  -> OccName    -- ^ Derived 'Occname', e.g. @$p3Ord@
mkSuperDictSelOcc :: Int -> OccName -> OccName
mkSuperDictSelOcc Int
index OccName
cls_tc_occ
  = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
varName FastString
"$p" [String -> FastString
fsLit (String -> FastString) -> String -> FastString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
index, OccName -> FastString
occNameFS OccName
cls_tc_occ]

mkLocalOcc :: Unique            -- ^ Unique to combine with the 'OccName'
           -> OccName           -- ^ Local name, e.g. @sat@
           -> OccName           -- ^ Nice unique version, e.g. @$L23sat@
mkLocalOcc :: Unique -> OccName -> OccName
mkLocalOcc Unique
uniq OccName
occ
   = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
varName FastString
"$L" [String -> FastString
fsLit (String -> FastString) -> String -> FastString
forall a b. (a -> b) -> a -> b
$ Unique -> String
forall a. Show a => a -> String
show Unique
uniq, OccName -> FastString
occNameFS OccName
occ]
        -- The Unique might print with characters
        -- that need encoding (e.g. 'z'!)

-- | 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 :: String -> OccSet -> OccName
mkInstTyTcOcc String
str = NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
tcName (Char
'R' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: String
str)

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?
          -> 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 :: String -> Bool -> OccSet -> OccName
mkDFunOcc String
info_str Bool
is_boot OccSet
set
  = NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
VarName (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
info_str) OccSet
set
  where
    prefix :: String
prefix | Bool
is_boot   = String
"$fx"
           | Bool
otherwise = String
"$f"

mkDataTOcc, mkDataCOcc
  :: OccName            -- ^ TyCon or data con string
  -> OccSet             -- ^ avoid these Occs
  -> OccName            -- ^ E.g. @$f3OrdMaybe@
-- data T = MkT ... deriving( Data ) needs definitions for
--      $tT   :: Data.Generics.Basics.DataType
--      $cMkT :: Data.Generics.Basics.Constr
mkDataTOcc :: OccName -> OccSet -> OccName
mkDataTOcc OccName
occ = NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
VarName (String
"$t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occNameString OccName
occ)
mkDataCOcc :: OccName -> OccSet -> OccName
mkDataCOcc OccName
occ = NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
VarName (String
"$c" String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occNameString OccName
occ)

{-
Sometimes we need to pick an OccName that has not already been used,
given a set of in-use OccNames.
-}

chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
ns String
str OccSet
set = OccName -> Int -> OccName
forall t. (Show t, Num t) => OccName -> t -> OccName
loop (NameSpace -> String -> OccName
mkOccName NameSpace
ns String
str) (Int
0::Int)
  where
  loop :: OccName -> t -> OccName
loop OccName
occ t
n
   | OccName
occ OccName -> OccSet -> Bool
`elemOccSet` OccSet
set = OccName -> t -> OccName
loop (NameSpace -> String -> OccName
mkOccName NameSpace
ns (String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
n)) (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
   | Bool
otherwise            = OccName
occ

{-
We used to add a '$m' to indicate a method, but that gives rise to bad
error messages from the type checker when we print the function name or pattern
of an instance-decl binding.  Why? Because the binding is zapped
to use the method name in place of the selector name.
(See TcClassDcl.tcMethodBind)

The way it is now, -ddump-xx output may look confusing, but
you can always say -dppr-debug to get the uniques.

However, we *do* have to zap the first character to be lower case,
because overloaded constructors (blarg) generate methods too.
And convert to VarName space

e.g. a call to constructor MkFoo where
        data (Ord a) => Foo a = MkFoo a

If this is necessary, we do it by prefixing '$m'.  These
guys never show up in error messages.  What a hack.
-}

mkMethodOcc :: OccName -> OccName
mkMethodOcc :: OccName -> OccName
mkMethodOcc occ :: OccName
occ@(OccName NameSpace
VarName FastString
_) = OccName
occ
mkMethodOcc OccName
occ                     = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName FastString
"$m" OccName
occ

{-
************************************************************************
*                                                                      *
\subsection{Tidying them up}
*                                                                      *
************************************************************************

Before we print chunks of code we like to rename it so that
we don't have to print lots of silly uniques in it.  But we mustn't
accidentally introduce name clashes!  So the idea is that we leave the
OccName alone unless it accidentally clashes with one that is already
in scope; if so, we tack on '1' at the end and try again, then '2', and
so on till we find a unique one.

There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1'
because that isn't a single lexeme.  So we encode it to 'lle' and *then*
tack on the '1', if necessary.

Note [TidyOccEnv]
~~~~~~~~~~~~~~~~~
type TidyOccEnv = UniqFM Int

* Domain = The OccName's FastString. These FastStrings are "taken";
           make sure that we don't re-use

* Int, n = A plausible starting point for new guesses
           There is no guarantee that "FSn" is available;
           you must look that up in the TidyOccEnv.  But
           it's a good place to start looking.

* When looking for a renaming for "foo2" we strip off the "2" and start
  with "foo".  Otherwise if we tidy twice we get silly names like foo23.

  However, if it started with digits at the end, we always make a name
  with digits at the end, rather than shortening "foo2" to just "foo",
  even if "foo" is unused.  Reasons:
     - Plain "foo" might be used later
     - We use trailing digits to subtly indicate a unification variable
       in typechecker error message; see TypeRep.tidyTyVarBndr

We have to take care though! Consider a machine-generated module (#10370)
  module Foo where
     a1 = e1
     a2 = e2
     ...
     a2000 = e2000
Then "a1", "a2" etc are all marked taken.  But now if we come across "a7" again,
we have to do a linear search to find a free one, "a2001".  That might just be
acceptable once.  But if we now come across "a8" again, we don't want to repeat
that search.

So we use the TidyOccEnv mapping for "a" (not "a7" or "a8") as our base for
starting the search; and we make sure to update the starting point for "a"
after we allocate a new one.


Note [Tidying multiple names at once]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Consider

    > :t (id,id,id)

Every id contributes a type variable to the type signature, and all of them are
"a". If we tidy them one by one, we get

    (id,id,id) :: (a2 -> a2, a1 -> a1, a -> a)

which is a bit unfortunate, as it unfairly renames only one of them. What we
would like to see is

    (id,id,id) :: (a3 -> a3, a2 -> a2, a1 -> a1)

To achieve this, the function avoidClashesOccEnv can be used to prepare the
TidyEnv, by “blocking” every name that occurs twice in the map. This way, none
of the "a"s will get the privilege of keeping this name, and all of them will
get a suitable number by tidyOccName.

This prepared TidyEnv can then be used with tidyOccName. See tidyTyCoVarBndrs
for an example where this is used.

This is #12382.

-}

type TidyOccEnv = UniqFM Int    -- The in-scope OccNames
  -- See Note [TidyOccEnv]

emptyTidyOccEnv :: TidyOccEnv
emptyTidyOccEnv :: TidyOccEnv
emptyTidyOccEnv = TidyOccEnv
forall elt. UniqFM elt
emptyUFM

initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
initTidyOccEnv :: [OccName] -> TidyOccEnv
initTidyOccEnv = (TidyOccEnv -> OccName -> TidyOccEnv)
-> TidyOccEnv -> [OccName] -> TidyOccEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TidyOccEnv -> OccName -> TidyOccEnv
forall elt. Num elt => UniqFM elt -> OccName -> UniqFM elt
add TidyOccEnv
forall elt. UniqFM elt
emptyUFM
  where
    add :: UniqFM elt -> OccName -> UniqFM elt
add UniqFM elt
env (OccName NameSpace
_ FastString
fs) = UniqFM elt -> FastString -> elt -> UniqFM elt
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM elt
env FastString
fs elt
1

-- see Note [Tidying multiple names at once]
avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
avoidClashesOccEnv TidyOccEnv
env [OccName]
occs = TidyOccEnv -> UniqFM () -> [OccName] -> TidyOccEnv
forall elt.
Num elt =>
UniqFM elt -> UniqFM () -> [OccName] -> UniqFM elt
go TidyOccEnv
env UniqFM ()
forall elt. UniqFM elt
emptyUFM [OccName]
occs
  where
    go :: UniqFM elt -> UniqFM () -> [OccName] -> UniqFM elt
go UniqFM elt
env UniqFM ()
_        [] = UniqFM elt
env
    go UniqFM elt
env UniqFM ()
seenOnce ((OccName NameSpace
_ FastString
fs):[OccName]
occs)
      | FastString
fs FastString -> UniqFM elt -> Bool
forall key elt. Uniquable key => key -> UniqFM elt -> Bool
`elemUFM` UniqFM elt
env      = UniqFM elt -> UniqFM () -> [OccName] -> UniqFM elt
go UniqFM elt
env UniqFM ()
seenOnce                  [OccName]
occs
      | FastString
fs FastString -> UniqFM () -> Bool
forall key elt. Uniquable key => key -> UniqFM elt -> Bool
`elemUFM` UniqFM ()
seenOnce = UniqFM elt -> UniqFM () -> [OccName] -> UniqFM elt
go (UniqFM elt -> FastString -> elt -> UniqFM elt
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM elt
env FastString
fs elt
1) UniqFM ()
seenOnce  [OccName]
occs
      | Bool
otherwise             = UniqFM elt -> UniqFM () -> [OccName] -> UniqFM elt
go UniqFM elt
env (UniqFM () -> FastString -> () -> UniqFM ()
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM ()
seenOnce FastString
fs ()) [OccName]
occs

tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
tidyOccName TidyOccEnv
env occ :: OccName
occ@(OccName NameSpace
occ_sp FastString
fs)
  | Bool -> Bool
not (FastString
fs FastString -> TidyOccEnv -> Bool
forall key elt. Uniquable key => key -> UniqFM elt -> Bool
`elemUFM` TidyOccEnv
env)
  = -- Desired OccName is free, so use it,
    -- and record in 'env' that it's no longer available
    (TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM TidyOccEnv
env FastString
fs Int
1, OccName
occ)

  | Bool
otherwise
  = case TidyOccEnv -> FastString -> Maybe Int
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM TidyOccEnv
env FastString
base1 of
       Maybe Int
Nothing -> (TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM TidyOccEnv
env FastString
base1 Int
2, NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp FastString
base1)
       Just Int
n  -> Int -> Int -> (TidyOccEnv, OccName)
find Int
1 Int
n
  where
    base :: String  -- Drop trailing digits (see Note [TidyOccEnv])
    base :: String
base  = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isDigit (FastString -> String
unpackFS FastString
fs)
    base1 :: FastString
base1 = String -> FastString
mkFastString (String
base String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"1")

    find :: Int -> Int -> (TidyOccEnv, OccName)
find !Int
k !Int
n
      = case TidyOccEnv -> FastString -> Maybe Int
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM TidyOccEnv
env FastString
new_fs of
          Just {} -> Int -> Int -> (TidyOccEnv, OccName)
find (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 :: Int) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k)
                       -- By using n+k, the n argument to find goes
                       --    1, add 1, add 2, add 3, etc which
                       -- moves at quadratic speed through a dense patch

          Maybe Int
Nothing -> (TidyOccEnv
new_env, NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp FastString
new_fs)
       where
         new_fs :: FastString
new_fs = String -> FastString
mkFastString (String
base String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
         new_env :: TidyOccEnv
new_env = TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM (TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM TidyOccEnv
env FastString
new_fs Int
1) FastString
base1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                     -- Update:  base1,  so that next time we'll start where we left off
                     --          new_fs, so that we know it is taken
                     -- If they are the same (n==1), the former wins
                     -- See Note [TidyOccEnv]


{-
************************************************************************
*                                                                      *
                Binary instance
    Here rather than BinIface because OccName is abstract
*                                                                      *
************************************************************************
-}

instance Binary NameSpace where
    put_ :: BinHandle -> NameSpace -> IO ()
put_ BinHandle
bh NameSpace
VarName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh NameSpace
DataName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh NameSpace
TvName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    put_ BinHandle
bh NameSpace
TcClsName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
    get :: BinHandle -> IO NameSpace
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
VarName
              Word8
1 -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
DataName
              Word8
2 -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
TvName
              Word8
_ -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
TcClsName

instance Binary OccName where
    put_ :: BinHandle -> OccName -> IO ()
put_ BinHandle
bh (OccName NameSpace
aa FastString
ab) = do
            BinHandle -> NameSpace -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh NameSpace
aa
            BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ab
    get :: BinHandle -> IO OccName
get BinHandle
bh = do
          NameSpace
aa <- BinHandle -> IO NameSpace
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          FastString
ab <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          OccName -> IO OccName
forall (m :: * -> *) a. Monad m => a -> m a
return (NameSpace -> FastString -> OccName
OccName NameSpace
aa FastString
ab)