{-
(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 DataName = Bool
True
isDataConNameSpace _        = Bool
False

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

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

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

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

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

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

pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief DataName  = Char -> SDoc
char 'd'
pprNameSpaceBrief VarName   = Char -> SDoc
char 'v'
pprNameSpaceBrief TvName    = String -> SDoc
text "tv"
pprNameSpaceBrief TcClsName = String -> SDoc
text "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 VarName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteNameSpace DataName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteNameSpace TvName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteNameSpace 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 sp1 :: NameSpace
sp1 s1 :: FastString
s1) == :: OccName -> OccName -> Bool
== (OccName sp2 :: NameSpace
sp2 s2 :: 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 sp1 :: NameSpace
sp1 s1 :: FastString
s1) (OccName sp2 :: NameSpace
sp2 s2 :: 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 _   = String -> Constr
abstractConstr "OccName"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OccName
gunfold _ _  = String -> Constr -> c OccName
forall a. HasCallStack => String -> a
error "gunfold"
  dataTypeOf :: OccName -> DataType
dataTypeOf _ = String -> DataType
mkNoRepType "OccName"

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

instance NFData OccName where
  rnf :: OccName -> ()
rnf x :: OccName
x = OccName
x OccName -> () -> ()
forall a b. a -> b -> b
`seq` ()

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

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

instance OutputableBndr OccName where
    pprBndr :: BindingSite -> OccName -> SDoc
pprBndr _ = OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr
    pprInfixOcc :: OccName -> SDoc
pprInfixOcc n :: 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 n :: 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 sp :: NameSpace
sp occ :: FastString
occ)
  = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ sty :: 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 sty :: 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
$ \dflags :: 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 ('[' : c :: Char
c : _) | Char -> Bool
isAlphaNum Char
c = []
    strip_th_unique (c :: Char
c : cs :: 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 occ_sp :: NameSpace
occ_sp str :: String
str = NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp (String -> FastString
mkFastString String
str)

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

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

mkVarOccFS :: FastString -> OccName
mkVarOccFS :: FastString -> OccName
mkVarOccFS fs :: 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 fs :: 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 space :: NameSpace
space name :: 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 ns1 :: NameSpace
ns1 ns2 :: 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 VarName = NameSpace
DataName
otherNameSpace DataName = NameSpace
VarName
otherNameSpace TvName = NameSpace
TcClsName
otherNameSpace 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 VarName   fs :: FastString
fs) = FastString -> Unique
mkVarOccUnique  FastString
fs
  getUnique (OccName DataName  fs :: FastString
fs) = FastString -> Unique
mkDataOccUnique FastString
fs
  getUnique (OccName TvName    fs :: FastString
fs) = FastString -> Unique
mkTvOccUnique   FastString
fs
  getUnique (OccName TcClsName fs :: 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 x :: OccName
x y :: 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 x :: UniqFM a
x) y :: OccName
y z :: 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 x :: UniqFM a
x) l :: [(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 x :: UniqFM a
x) y :: 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     l :: [(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 x :: OccName
x (A y :: 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 :: a -> b -> b
a b :: b
b (A c :: 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 x :: UniqFM a
x)         = UniqFM a -> [a]
forall elt. UniqFM elt -> [elt]
eltsUFM UniqFM a
x
plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv (A x :: UniqFM a
x) (A y :: 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 f :: a -> a -> a
f (A x :: UniqFM a
x) (A y :: 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 f :: a -> a -> a
f (A x :: UniqFM a
x) y :: OccName
y z :: 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 f :: a -> b -> b
f g :: a -> b
g (A x :: UniqFM b
x) y :: OccName
y z :: 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 f :: a -> b
f (A x :: 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 comb :: a -> a -> a
comb l :: [(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 x :: UniqFM a
x) y :: 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 x :: UniqFM a
x) y :: [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 x :: elt -> Bool
x (A y :: 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 fn :: Maybe elt -> Maybe elt
fn (A y :: UniqFM elt
y) k :: 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 x :: 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 ppr_elt :: a -> SDoc
ppr_elt (A env :: 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 s1 :: OccSet
s1 s2 :: 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 _ s :: FastString
s) = FastString -> String
unpackFS FastString
s

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

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

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

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

isTcOcc :: OccName -> Bool
isTcOcc (OccName TcClsName _) = Bool
True
isTcOcc _                     = 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 VarName  _) = Bool
True
isValOcc (OccName DataName _) = Bool
True
isValOcc _                    = Bool
False

isDataOcc :: OccName -> Bool
isDataOcc (OccName DataName _) = Bool
True
isDataOcc _                    = 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 DataName s :: FastString
s) = FastString -> Bool
isLexConSym FastString
s
isDataSymOcc _                    = 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 DataName s :: FastString
s)  = FastString -> Bool
isLexConSym FastString
s
isSymOcc (OccName TcClsName s :: FastString
s) = FastString -> Bool
isLexSym FastString
s
isSymOcc (OccName VarName s :: FastString
s)   = FastString -> Bool
isLexSym FastString
s
isSymOcc (OccName TvName s :: FastString
s)    = FastString -> Bool
isLexSym FastString
s
-- Pretty inefficient!

parenSymOcc :: OccName -> SDoc -> SDoc
-- ^ Wrap parens around an operator
parenSymOcc :: OccName -> SDoc -> SDoc
parenSymOcc occ :: OccName
occ doc :: 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 occ :: OccName
occ = FastString -> Char
headFS (OccName -> FastString
occNameFS OccName
occ) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'

{-
************************************************************************
*                                                                      *
\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 occ_sp :: NameSpace
occ_sp sys_prefix :: FastString
sys_prefix str :: [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 occ :: OccName
occ =
   case OccName -> String
occNameString OccName
occ of
     '$':c :: Char
c:_ | Char -> Bool
isAlphaNum Char
c -> Bool
True   -- E.g.  $wfoo
     c :: Char
c:':':_ | Char -> Bool
isAlphaNum Char
c -> Bool
True   -- E.g.  N:blah   newtype coercions
     _other :: String
_other                 -> Bool
False

isDefaultMethodOcc :: OccName -> Bool
isDefaultMethodOcc :: OccName -> Bool
isDefaultMethodOcc occ :: OccName
occ =
   case OccName -> String
occNameString OccName
occ of
     '$':'d':'m':_ -> Bool
True
     _ -> 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 occ :: OccName
occ =
   case OccName -> String
occNameString OccName
occ of
     '$':'t':'c':_ -> Bool
True  -- mkTyConRepOcc
     '$':'t':'r':_ -> Bool
True  -- Module binding
     _ -> 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  "$W"
mkWorkerOcc :: OccName -> OccName
mkWorkerOcc         = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$w"
mkMatcherOcc :: OccName -> OccName
mkMatcherOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$m"
mkBuilderOcc :: OccName -> OccName
mkBuilderOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$b"
mkDefaultMethodOcc :: OccName -> OccName
mkDefaultMethodOcc  = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$dm"
mkClassOpAuxOcc :: OccName -> OccName
mkClassOpAuxOcc     = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$c"
mkDictOcc :: OccName -> OccName
mkDictOcc           = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$d"
mkIPOcc :: OccName -> OccName
mkIPOcc             = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$i"
mkSpecOcc :: OccName -> OccName
mkSpecOcc           = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$s"
mkForeignExportOcc :: OccName -> OccName
mkForeignExportOcc  = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  "$f"
mkRepEqOcc :: OccName -> OccName
mkRepEqOcc          = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tvName   "$r"   -- In RULES involving Coercible
mkClassDataConOcc :: OccName -> OccName
mkClassDataConOcc   = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
dataName "C:"     -- Data con for a class
mkNewTyCoOcc :: OccName -> OccName
mkNewTyCoOcc        = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName   "N:"   -- Coercion for newtypes
mkInstTyCoOcc :: OccName -> OccName
mkInstTyCoOcc       = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName   "D:"   -- Coercion for type functions
mkEqPredCoOcc :: OccName -> OccName
mkEqPredCoOcc       = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
tcName   "$co"

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

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

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

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

mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv sp :: NameSpace
sp px :: FastString
px occ :: 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 datacon_occ :: OccName
datacon_occ = NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
varName OccName
datacon_occ

mkSuperDictAuxOcc :: Int -> OccName -> OccName
mkSuperDictAuxOcc :: Int -> OccName -> OccName
mkSuperDictAuxOcc index :: Int
index cls_tc_occ :: OccName
cls_tc_occ
  = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
varName "$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 index :: Int
index cls_tc_occ :: OccName
cls_tc_occ
  = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
varName "$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 uniq :: Unique
uniq occ :: OccName
occ
   = NameSpace -> FastString -> [FastString] -> OccName
mk_deriv NameSpace
varName "$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 str :: String
str = NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
tcName ('R' Char -> String -> String
forall a. a -> [a] -> [a]
: ':' 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 info_str :: String
info_str is_boot :: Bool
is_boot set :: 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   = "$fx"
           | Bool
otherwise = "$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 occ :: OccName
occ = NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
VarName ("$t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occNameString OccName
occ)
mkDataCOcc :: OccName -> OccSet -> OccName
mkDataCOcc occ :: OccName
occ = NameSpace -> String -> OccSet -> OccName
chooseUniqueOcc NameSpace
VarName ("$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 ns :: NameSpace
ns str :: String
str set :: OccSet
set = OccName -> Int -> OccName
forall t. (Show t, Num t) => OccName -> t -> OccName
loop (NameSpace -> String -> OccName
mkOccName NameSpace
ns String
str) (0::Int)
  where
  loop :: OccName -> t -> OccName
loop occ :: OccName
occ n :: 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
+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 VarName _) = OccName
occ
mkMethodOcc occ :: OccName
occ                     = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName "$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 (Trac #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.


Node [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 env :: UniqFM elt
env (OccName _ fs :: 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 1

-- see Note [Tidying multiple names at once]
avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
avoidClashesOccEnv env :: TidyOccEnv
env occs :: [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 env :: UniqFM elt
env _        [] = UniqFM elt
env
    go env :: UniqFM elt
env seenOnce :: UniqFM ()
seenOnce ((OccName _ fs :: FastString
fs):occs :: [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 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 env :: TidyOccEnv
env occ :: OccName
occ@(OccName occ_sp :: NameSpace
occ_sp fs :: 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 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
       Nothing -> (TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM TidyOccEnv
env FastString
base1 2, NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp FastString
base1)
       Just n :: Int
n  -> Int -> Int -> (TidyOccEnv, OccName)
find 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]
++ "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
+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

          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 1) FastString
base1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+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_ bh :: BinHandle
bh VarName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh DataName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
    put_ bh :: BinHandle
bh TvName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
    put_ bh :: BinHandle
bh TcClsName = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3
    get :: BinHandle -> IO NameSpace
get bh :: BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              0 -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
VarName
              1 -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
DataName
              2 -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
TvName
              _ -> do NameSpace -> IO NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
TcClsName

instance Binary OccName where
    put_ :: BinHandle -> OccName -> IO ()
put_ bh :: BinHandle
bh (OccName aa :: NameSpace
aa ab :: 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 bh :: 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)