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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- #name_types#
-- GHC uses several kinds of name internally:
--
-- * 'GHC.Types.Name.Occurrence.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
--
-- * 'GHC.Types.Name.Reader.RdrName': see "GHC.Types.Name.Reader#name_types"
--
-- * 'GHC.Types.Name.Name': see "GHC.Types.Name#name_types"
--
-- * 'GHC.Types.Id.Id': see "GHC.Types.Id#name_types"
--
-- * 'GHC.Types.Var.Var': see "GHC.Types.Var#name_types"

module GHC.Types.Name.Occurrence (
        -- * The 'NameSpace' type
        NameSpace, -- Abstract

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

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

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

        -- ** Construction
        mkOccName, mkOccNameFS,
        mkVarOcc, mkVarOccFS,
        mkRecFieldOcc, mkRecFieldOccFS,
        mkDataOcc, mkDataOccFS,
        mkTyVarOcc, mkTyVarOccFS,
        mkTcOcc, mkTcOccFS,
        mkClsOcc, mkClsOccFS,
        mkDFunOcc,
        setOccNameSpace,
        demoteOccName,
        demoteOccTvName,
        promoteOccName,
        varToRecFieldOcc,
        recFieldToVarOcc,
        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,
        mkTyConRepOcc,

        -- ** Deconstruction
        occNameFS, occNameString, occNameSpace,

        isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
        isFieldOcc, fieldOcc_maybe,
        parenSymOcc, startsWithUnderscore, isUnderscore,

        isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
        isFieldNameSpace, isTermVarOrFieldNameSpace,

        -- * The 'OccEnv' type
        OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
        mapOccEnv, strictMapOccEnv,
        mapMaybeOccEnv,
        lookupOccEnv, lookupOccEnv_AllNameSpaces,
        lookupOccEnv_WithFields, lookupFieldsOccEnv,
        mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
        nonDetOccEnvElts, nonDetFoldOccEnv,
        plusOccEnv, plusOccEnv_C,
        extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
        alterOccEnv, minusOccEnv, minusOccEnv_C, minusOccEnv_C_Ns,
        pprOccEnv, forceOccEnv,
        intersectOccEnv_C,

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

        -- * Dealing with main
        mainOcc, ppMainFn,

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

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

import GHC.Prelude

import GHC.Builtin.Uniques
import GHC.Utils.Misc
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
import GHC.Data.FastString
import GHC.Data.FastString.Env
import GHC.Utils.Outputable
import GHC.Utils.Lexeme
import GHC.Utils.Binary
import GHC.Utils.Panic.Plain

import Control.DeepSeq
import Data.Char
import Data.Data
import qualified Data.Semigroup as S
import GHC.Exts( Int(I#), dataToTag# )

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

data NameSpace
  -- | Variable name space (including "real" data constructors).
  = VarName
  -- | Record field namespace for the given record.
  | FldName
    { NameSpace -> FastString
fldParent :: !FastString
      -- ^ The textual name of the parent of the field.
      --
      --   - For a field of a datatype, this is the name of the first constructor
      --     of the datatype (regardless of whether this constructor has this field).
      --   - For a field of a pattern synonym, this is the name of the pattern synonym.
    }
  -- | "Source" data constructor namespace.
  | DataName
  -- | Type variable namespace.
  | TvName
  -- | Type constructor and class namespace.
  | TcClsName
    -- Haskell has type constructors and classes in the same namespace, for now.
   deriving NameSpace -> NameSpace -> Bool
(NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool) -> Eq NameSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameSpace -> NameSpace -> Bool
== :: NameSpace -> NameSpace -> Bool
$c/= :: NameSpace -> NameSpace -> Bool
/= :: NameSpace -> NameSpace -> Bool
Eq

instance Ord NameSpace where
  compare :: NameSpace -> NameSpace -> Ordering
compare NameSpace
ns1 NameSpace
ns2 =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> Int
I# (NameSpace -> Int#
forall a. DataToTag a => a -> Int#
dataToTag# NameSpace
ns1)) (Int# -> Int
I# (NameSpace -> Int#
forall a. DataToTag a => a -> Int#
dataToTag# NameSpace
ns2)) of
      Ordering
LT -> Ordering
LT
      Ordering
GT -> Ordering
GT
      Ordering
EQ
        | FldName { fldParent :: NameSpace -> FastString
fldParent = FastString
p1 } <- NameSpace
ns1
        , FldName { fldParent :: NameSpace -> FastString
fldParent = FastString
p2 } <- NameSpace
ns2
        -> FastString -> FastString -> Ordering
lexicalCompareFS FastString
p1 FastString
p2
        | Bool
otherwise
        -> Ordering
EQ

instance Uniquable NameSpace where
  getUnique :: NameSpace -> Unique
getUnique (FldName FastString
fs) = FastString -> Unique
mkFldNSUnique  FastString
fs
  getUnique NameSpace
VarName      = Unique
varNSUnique
  getUnique NameSpace
DataName     = Unique
dataNSUnique
  getUnique NameSpace
TvName       = Unique
tvNSUnique
  getUnique NameSpace
TcClsName    = Unique
tcNSUnique

instance NFData NameSpace where
  rnf :: NameSpace -> ()
rnf NameSpace
VarName = ()
  rnf (FldName FastString
par) = FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
par
  rnf NameSpace
DataName = ()
  rnf NameSpace
TvName = ()
  rnf NameSpace
TcClsName = ()

{-
Note [Data Constructors]
~~~~~~~~~~~~~~~~~~~~~~~~
see also: Note [Data Constructor Naming] in GHC.Core.DataCon

$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.

Note [Record field namespacing]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Record fields have a separate namespace from variables, to support
DuplicateRecordFields, e.g. in

  data X = MkX { fld :: Int }
  data Y = MkY { fld :: Bool }

  f x = x { fld = 3 }
  g y = y { fld = False }

we want the two occurrences of "fld" to refer to the field names associated with
the corresponding data type.

The namespace for a record field is as follows:

  - for a data type, it is the textual name of the first constructor of the
    datatype, whether this constructor has this field or not;
  - for a pattern synonym, it is the textual name of the pattern synonym itself.

Record fields are initially parsed as variables, but the renamer resolves their
namespace in GHC.Rename.Names.newRecordFieldLabel, which is called when renaming
record data declarations and record pattern synonym declarations.

To illustrate the namespacing, consider the record field "fld" in the following datatype

  data instance A Int Bool Char
    = MkA1 | MkA2 { fld :: Int } | MkA3 { bar :: Bool, fld :: Int }

Its namespace is `FldName "MkA1"`. This is a convention used throughout GHC
to circumvent the fact that we don't have a way to refer to the type constructor
"A Int Bool Char" in the renamer, as data family instances only get given
'Name's in the typechecker.
-}

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

fieldName :: FastString -> NameSpace
fieldName :: FastString -> NameSpace
fieldName = FastString -> NameSpace
FldName

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 (FldName {}) = Bool
True
isVarNameSpace NameSpace
_            = Bool
False

-- | Is this a term variable or field name namespace?
isTermVarOrFieldNameSpace :: NameSpace -> Bool
isTermVarOrFieldNameSpace :: NameSpace -> Bool
isTermVarOrFieldNameSpace NameSpace
VarName      = Bool
True
isTermVarOrFieldNameSpace (FldName {}) = Bool
True
isTermVarOrFieldNameSpace NameSpace
_            = Bool
False

isValNameSpace :: NameSpace -> Bool
isValNameSpace :: NameSpace -> Bool
isValNameSpace NameSpace
DataName     = Bool
True
isValNameSpace NameSpace
VarName      = Bool
True
isValNameSpace (FldName {}) = Bool
True
isValNameSpace NameSpace
_            = Bool
False

isFieldNameSpace :: NameSpace -> Bool
isFieldNameSpace :: NameSpace -> Bool
isFieldNameSpace (FldName {}) = Bool
True
isFieldNameSpace NameSpace
_            = Bool
False

pprNameSpace :: NameSpace -> SDoc
pprNameSpace :: NameSpace -> SDoc
pprNameSpace NameSpace
DataName    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"data constructor"
pprNameSpace NameSpace
VarName     = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"variable"
pprNameSpace NameSpace
TvName      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type variable"
pprNameSpace NameSpace
TcClsName   = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type constructor or class"
pprNameSpace (FldName FastString
p) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"record field of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
p

pprNonVarNameSpace :: NameSpace -> SDoc
pprNonVarNameSpace :: NameSpace -> SDoc
pprNonVarNameSpace NameSpace
VarName = SDoc
forall doc. IsOutput doc => doc
empty
pprNonVarNameSpace NameSpace
ns = NameSpace -> SDoc
pprNameSpace NameSpace
ns

pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief NameSpace
DataName     = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'd'
pprNameSpaceBrief NameSpace
VarName      = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'v'
pprNameSpaceBrief NameSpace
TvName       = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"tv"
pprNameSpaceBrief NameSpace
TcClsName    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"tc"
pprNameSpaceBrief (FldName {}) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"fld"

-- demoteNameSpace lowers the NameSpace if possible.  We can not know
-- in advance, since a TvName can appear in an HsTyVar.
-- See Note [Demotion] in GHC.Rename.Env.
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
demoteNameSpace (FldName {}) = Maybe NameSpace
forall a. Maybe a
Nothing

-- demoteTvNameSpace lowers the NameSpace of a type variable.
-- See Note [Demotion] in GHC.Rename.Env.
demoteTvNameSpace :: NameSpace -> Maybe NameSpace
demoteTvNameSpace :: NameSpace -> Maybe NameSpace
demoteTvNameSpace NameSpace
TvName = NameSpace -> Maybe NameSpace
forall a. a -> Maybe a
Just NameSpace
VarName
demoteTvNameSpace NameSpace
VarName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteTvNameSpace NameSpace
DataName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteTvNameSpace NameSpace
TcClsName = Maybe NameSpace
forall a. Maybe a
Nothing
demoteTvNameSpace (FldName {}) = Maybe NameSpace
forall a. Maybe a
Nothing

-- promoteNameSpace promotes the NameSpace as follows.
-- See Note [Promotion] in GHC.Rename.Env.
promoteNameSpace :: NameSpace -> Maybe NameSpace
promoteNameSpace :: NameSpace -> Maybe NameSpace
promoteNameSpace NameSpace
DataName = NameSpace -> Maybe NameSpace
forall a. a -> Maybe a
Just NameSpace
TcClsName
promoteNameSpace NameSpace
VarName = NameSpace -> Maybe NameSpace
forall a. a -> Maybe a
Just NameSpace
TvName
promoteNameSpace NameSpace
TcClsName = Maybe NameSpace
forall a. Maybe a
Nothing
promoteNameSpace NameSpace
TvName = Maybe NameSpace
forall a. Maybe a
Nothing
promoteNameSpace (FldName {}) = Maybe NameSpace
forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
\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 -> FastString -> Ordering
lexicalCompareFS FastString
s1 FastString
s2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<> NameSpace -> NameSpace -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NameSpace
sp1 NameSpace
sp2

instance Data OccName where
  -- don't traverse?
  toConstr :: OccName -> Constr
toConstr OccName
_   = [Char] -> Constr
abstractConstr [Char]
"OccName"
  gunfold :: forall (c :: * -> *).
(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
_  = [Char] -> Constr -> c OccName
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: OccName -> DataType
dataTypeOf OccName
_ = [Char] -> DataType
mkNoRepType [Char]
"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 -> () -> ()
forall a b. a -> b -> b
`seq` ()

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

instance Outputable OccName where
    ppr :: OccName -> SDoc
ppr = OccName -> SDoc
forall doc. IsLine doc => OccName -> doc
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 :: IsLine doc => OccName -> doc
pprOccName :: forall doc. IsLine doc => OccName -> doc
pprOccName (OccName NameSpace
sp FastString
occ)
  = doc -> (PprStyle -> SDoc) -> doc
forall doc. IsOutput doc => doc -> (PprStyle -> SDoc) -> doc
docWithStyle (FastZString -> doc
forall doc. IsLine doc => FastZString -> doc
ztext (FastString -> FastZString
zEncodeFS FastString
occ))
    (\PprStyle
_ -> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
occ SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (NameSpace -> SDoc
pprNameSpaceBrief NameSpace
sp)))
{-# SPECIALIZE pprOccName :: OccName -> SDoc #-}
{-# SPECIALIZE pprOccName :: OccName -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Mangle field names to avoid duplicate symbols.
--
-- See Note [Mangling OccNames].
occNameMangledFS :: OccName -> FastString
occNameMangledFS :: OccName -> FastString
occNameMangledFS (OccName NameSpace
ns FastString
fs) =
  case NameSpace
ns of
    -- Fields need to include the constructor, to ensure that we don't define
    -- duplicate symbols when using DuplicateRecordFields.
    FldName FastString
con -> [FastString] -> FastString
concatFS [[Char] -> FastString
fsLit [Char]
"$fld:", FastString
con, FastString
":", FastString
fs]
    -- Otherwise, we can ignore the namespace, as there is no risk of name
    -- clashes.
    NameSpace
_           -> FastString
fs

{- Note [Mangling OccNames]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
When generating a symbol for a Name, we usually discard the NameSpace entirely
(see GHC.Types.Name.pprName). This is because clashes are usually not possible,
e.g. a variable and a data constructor can't clash because data constructors
start with a capital letter or a colon, while variables never do.

However, record field names, in the presence of DuplicateRecordFields, need this
disambiguation. So, for a record field like

  data A = MkA { foo :: Int }

we generate the symbol $fld:MkA:foo. We use the constructor 'MkA' to disambiguate,
and not the TyCon A as one might naively expect: this is explained in
Note [Record field namespacing].
-}

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

mkOccName :: NameSpace -> String -> OccName
mkOccName :: NameSpace -> [Char] -> OccName
mkOccName NameSpace
occ_sp [Char]
str = NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp ([Char] -> FastString
mkFastString [Char]
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 :: [Char] -> OccName
mkVarOcc [Char]
s = NameSpace -> [Char] -> OccName
mkOccName NameSpace
varName [Char]
s

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

mkRecFieldOcc :: FastString -> String -> OccName
mkRecFieldOcc :: FastString -> [Char] -> OccName
mkRecFieldOcc FastString
dc = NameSpace -> [Char] -> OccName
mkOccName (FastString -> NameSpace
fieldName FastString
dc)

mkRecFieldOccFS :: FastString -> FastString -> OccName
mkRecFieldOccFS :: FastString -> FastString -> OccName
mkRecFieldOccFS FastString
dc = NameSpace -> FastString -> OccName
mkOccNameFS (FastString -> NameSpace
fieldName FastString
dc)

varToRecFieldOcc :: HasDebugCallStack => FastString -> OccName -> OccName
varToRecFieldOcc :: HasDebugCallStack => FastString -> OccName -> OccName
varToRecFieldOcc FastString
dc (OccName NameSpace
ns FastString
s) =
  Bool -> OccName -> OccName
forall a. HasCallStack => Bool -> a -> a
assert Bool
makes_sense (OccName -> OccName) -> OccName -> OccName
forall a b. (a -> b) -> a -> b
$ FastString -> FastString -> OccName
mkRecFieldOccFS FastString
dc FastString
s
    where
      makes_sense :: Bool
makes_sense = case NameSpace
ns of
        NameSpace
VarName    -> Bool
True
        FldName {} -> Bool
True
          -- NB: it's OK to change the parent data constructor,
          -- see e.g. test T23220 in which we construct with TH
          -- a datatype using the fields of a different datatype.
        NameSpace
_          -> Bool
False

recFieldToVarOcc :: HasDebugCallStack => OccName -> OccName
recFieldToVarOcc :: HasDebugCallStack => OccName -> OccName
recFieldToVarOcc (OccName NameSpace
_ns FastString
s) = FastString -> OccName
mkVarOccFS FastString
s

mkDataOcc :: String -> OccName
mkDataOcc :: [Char] -> OccName
mkDataOcc = NameSpace -> [Char] -> OccName
mkOccName NameSpace
dataName

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

mkTyVarOcc :: String -> OccName
mkTyVarOcc :: [Char] -> OccName
mkTyVarOcc = NameSpace -> [Char] -> 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 :: [Char] -> OccName
mkTcOcc = NameSpace -> [Char] -> OccName
mkOccName NameSpace
tcName

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

mkClsOcc :: String -> OccName
mkClsOcc :: [Char] -> OccName
mkClsOcc = NameSpace -> [Char] -> 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] in GHC.Rename.Env.
demoteOccName :: OccName -> Maybe OccName
demoteOccName :: OccName -> Maybe OccName
demoteOccName (OccName NameSpace
space FastString
name) = do
  space' <- NameSpace -> Maybe NameSpace
demoteNameSpace NameSpace
space
  return $ OccName space' name

demoteOccTvName :: OccName -> Maybe OccName
demoteOccTvName :: OccName -> Maybe OccName
demoteOccTvName (OccName NameSpace
space FastString
name) = do
  space' <- NameSpace -> Maybe NameSpace
demoteTvNameSpace NameSpace
space
  return $ OccName space' name

-- promoteOccName promotes the NameSpace of OccName.
-- See Note [Promotion] in GHC.Rename.Env.
promoteOccName :: OccName -> Maybe OccName
promoteOccName :: OccName -> Maybe OccName
promoteOccName (OccName NameSpace
space FastString
name) = do
  promoted_space <- NameSpace -> Maybe NameSpace
promoteNameSpace NameSpace
space
  let tyop   = NameSpace -> Bool
isTvNameSpace NameSpace
promoted_space Bool -> Bool -> Bool
&& FastString -> Bool
isLexVarSym FastString
name
      space' = if Bool
tyop then NameSpace
tcClsName else NameSpace
promoted_space   -- special case for type operators (#24570)
  return $ OccName space' name

{- | 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 for the GlobalRdrEnv and for the envts in ModIface.

Note [OccEnv]
~~~~~~~~~~~~~
An OccEnv is a map keyed on OccName. Recall that an OccEnv consists of two
components:

  - a namespace,
  - a textual name (in the form of a FastString).

In general, for a given textual name, there is only one appropriate namespace.
However, sometimes we do get an occurrence that belongs to several namespaces:

  - Symbolic identifiers such as (:+) can belong to both the data constructor and
    type constructor/class namespaces.
  - With duplicate record fields, a field name can belong to several different
    namespaces, one for each parent datatype (or pattern synonym).

So we represent an OccEnv as a nested data structure

  FastStringEnv (UniqFM NameSpace a)

in which we can first look up the textual name, and then choose which of the
namespaces are relevant. This supports the two main uses of OccEnvs:

  1. One wants to look up a specific OccName in the environment, at a specific
     namespace. One looks up the textual name, and then the namespace.
  2. One wants to look up something, but isn't sure in advance of the namespace.
     So one looks up the textual name, and then can decide what to do based on
     the returned map of namespaces.

This data structure isn't performance critical in most situations, but some
improvements to its performance that might be worth it are as follows:

  A. Use a tailor-made data structure for a map keyed on NameSpaces.

     Recall that we have:

        data IntMap a = Bin !Int !Int !(IntMap a) !(IntMap a)
                      | Tip !Key a
                      | Nil

     This is already pretty efficient for singletons, but we don't need the
     empty case (as we would simply omit the parent key in the OccEnv instead
     of storing an empty inner map).

  B. Always ensure the inner map (keyed on namespaces) is evaluated, i.e.
     is never a thunk. For this, we would need to use strict operations on
     the outer FastStringEnv (but we'd keep using lazy operations on the inner
     UniqFM).
-}

-- | A map keyed on 'OccName'. See Note [OccEnv].
newtype OccEnv a = MkOccEnv (FastStringEnv (UniqFM NameSpace a))
  deriving (forall a b. (a -> b) -> OccEnv a -> OccEnv b)
-> (forall a b. a -> OccEnv b -> OccEnv a) -> Functor OccEnv
forall a b. a -> OccEnv b -> OccEnv a
forall a b. (a -> b) -> OccEnv a -> OccEnv b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OccEnv a -> OccEnv b
fmap :: forall a b. (a -> b) -> OccEnv a -> OccEnv b
$c<$ :: forall a b. a -> OccEnv b -> OccEnv a
<$ :: forall a b. a -> OccEnv b -> OccEnv a
Functor

-- | The empty 'OccEnv'.
emptyOccEnv :: OccEnv a
emptyOccEnv :: forall a. OccEnv a
emptyOccEnv = FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv FastStringEnv (UniqFM NameSpace a)
forall a. FastStringEnv a
emptyFsEnv

-- | A singleton 'OccEnv'.
unitOccEnv :: OccName -> a -> OccEnv a
unitOccEnv :: forall a. OccName -> a -> OccEnv a
unitOccEnv (OccName NameSpace
ns FastString
s) a
a = FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ FastString
-> UniqFM NameSpace a -> FastStringEnv (UniqFM NameSpace a)
forall a. FastString -> a -> FastStringEnv a
unitFsEnv FastString
s (NameSpace -> a -> UniqFM NameSpace a
forall key elt. Uniquable key => key -> elt -> UniqFM key elt
unitUFM NameSpace
ns a
a)

-- | Add a single element to an 'OccEnv'.
extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv :: forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) (OccName NameSpace
ns FastString
s) a
a =
  FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
-> FastString
-> UniqFM NameSpace a
-> FastStringEnv (UniqFM NameSpace a)
forall a.
(a -> a -> a)
-> FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv_C UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a
forall {k} (key :: k) elt.
UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM FastStringEnv (UniqFM NameSpace a)
as FastString
s (NameSpace -> a -> UniqFM NameSpace a
forall key elt. Uniquable key => key -> elt -> UniqFM key elt
unitUFM NameSpace
ns a
a)

-- | Extend an 'OccEnv' by a list.
--
-- 'OccName's later on in the list override earlier 'OccName's.
extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
extendOccEnvList :: forall a. OccEnv a -> [(OccName, a)] -> OccEnv a
extendOccEnvList = (OccEnv a -> (OccName, a) -> OccEnv a)
-> OccEnv a -> [(OccName, a)] -> OccEnv a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((OccEnv a -> (OccName, a) -> OccEnv a)
 -> OccEnv a -> [(OccName, a)] -> OccEnv a)
-> (OccEnv a -> (OccName, a) -> OccEnv a)
-> OccEnv a
-> [(OccName, a)]
-> OccEnv a
forall a b. (a -> b) -> a -> b
$ \ OccEnv a
env (OccName
occ, a
a) -> OccEnv a -> OccName -> a -> OccEnv a
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv OccEnv a
env OccName
occ a
a

-- | Look an element up in an 'OccEnv'.
lookupOccEnv :: OccEnv a -> OccName -> Maybe a
lookupOccEnv :: forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) (OccName NameSpace
ns FastString
s)
  = do { m <- FastStringEnv (UniqFM NameSpace a)
-> FastString -> Maybe (UniqFM NameSpace a)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv (UniqFM NameSpace a)
as FastString
s
       ; lookupUFM m ns }

-- | Lookup an element in an 'OccEnv', ignoring 'NameSpace's entirely.
lookupOccEnv_AllNameSpaces :: OccEnv a -> OccName -> [a]
lookupOccEnv_AllNameSpaces :: forall a. OccEnv a -> OccName -> [a]
lookupOccEnv_AllNameSpaces (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) (OccName NameSpace
_ FastString
s)
  = case FastStringEnv (UniqFM NameSpace a)
-> FastString -> Maybe (UniqFM NameSpace a)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv (UniqFM NameSpace a)
as FastString
s of
      Maybe (UniqFM NameSpace a)
Nothing -> []
      Just UniqFM NameSpace a
r  -> UniqFM NameSpace a -> [a]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM NameSpace a
r

-- | Lookup an element in an 'OccEnv', looking in the record field
-- namespace for a variable.
lookupOccEnv_WithFields :: OccEnv a -> OccName -> [a]
lookupOccEnv_WithFields :: forall a. OccEnv a -> OccName -> [a]
lookupOccEnv_WithFields OccEnv a
env OccName
occ =
  case OccEnv a -> OccName -> Maybe a
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv a
env OccName
occ of
      Maybe a
Nothing  -> [a]
fieldGREs
      Just a
gre -> a
gre a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fieldGREs
  where
    fieldGREs :: [a]
fieldGREs
      -- If the 'OccName' is a variable, also look up
      -- in the record field namespaces.
      | OccName -> Bool
isVarOcc OccName
occ
      = OccEnv a -> FastString -> [a]
forall a. OccEnv a -> FastString -> [a]
lookupFieldsOccEnv OccEnv a
env (OccName -> FastString
occNameFS OccName
occ)
      | Bool
otherwise
      = []

-- | Look up all the record fields that match with the given 'FastString'
-- in an 'OccEnv'.
lookupFieldsOccEnv :: OccEnv a -> FastString -> [a]
lookupFieldsOccEnv :: forall a. OccEnv a -> FastString -> [a]
lookupFieldsOccEnv (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) FastString
fld =
  case FastStringEnv (UniqFM NameSpace a)
-> FastString -> Maybe (UniqFM NameSpace a)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv (UniqFM NameSpace a)
as FastString
fld of
    Maybe (UniqFM NameSpace a)
Nothing   -> []
    Just UniqFM NameSpace a
flds -> UniqFM NameSpace a -> [a]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM (UniqFM NameSpace a -> [a]) -> UniqFM NameSpace a -> [a]
forall a b. (a -> b) -> a -> b
$ UniqFM NameSpace a -> UniqFM NameSpace a
forall {k} {key :: k} {elt}. UniqFM key elt -> UniqFM key elt
filter_flds UniqFM NameSpace a
flds
  -- NB: non-determinism is OK: in practice we will either end up resolving
  -- to a single field or throwing an error.
  where
    filter_flds :: UniqFM key elt -> UniqFM key elt
filter_flds = (Unique -> elt -> Bool) -> UniqFM key elt -> UniqFM key elt
forall {k} elt (key :: k).
(Unique -> elt -> Bool) -> UniqFM key elt -> UniqFM key elt
filterUFM_Directly (\ Unique
uniq elt
_ -> Unique -> Bool
isFldNSUnique Unique
uniq)

-- | Create an 'OccEnv' from a list.
--
-- 'OccName's later on in the list override earlier 'OccName's.
mkOccEnv :: [(OccName,a)] -> OccEnv a
mkOccEnv :: forall a. [(OccName, a)] -> OccEnv a
mkOccEnv = OccEnv a -> [(OccName, a)] -> OccEnv a
forall a. OccEnv a -> [(OccName, a)] -> OccEnv a
extendOccEnvList OccEnv a
forall a. OccEnv a
emptyOccEnv

-- | Create an 'OccEnv' from a list, combining different values
-- with the same 'OccName' using the combining function.
mkOccEnv_C :: (a -> a -> a) -- ^ old -> new -> result
           -> [(OccName,a)]
           -> OccEnv a
mkOccEnv_C :: forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C a -> a -> a
f [(OccName, a)]
elts
  = FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (FastStringEnv (UniqFM NameSpace a)
 -> (OccName, a) -> FastStringEnv (UniqFM NameSpace a))
-> FastStringEnv (UniqFM NameSpace a)
-> [(OccName, a)]
-> FastStringEnv (UniqFM NameSpace a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FastStringEnv (UniqFM NameSpace a)
-> (OccName, a) -> FastStringEnv (UniqFM NameSpace a)
g FastStringEnv (UniqFM NameSpace a)
forall a. FastStringEnv a
emptyFsEnv [(OccName, a)]
elts
    where
      g :: FastStringEnv (UniqFM NameSpace a)
-> (OccName, a) -> FastStringEnv (UniqFM NameSpace a)
g FastStringEnv (UniqFM NameSpace a)
env (OccName NameSpace
ns FastString
s, a
a) =
        (UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
-> FastString
-> UniqFM NameSpace a
-> FastStringEnv (UniqFM NameSpace a)
forall a.
(a -> a -> a)
-> FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv_C ((a -> a -> a)
-> UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a
forall {k} elt (key :: k).
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C ((a -> a -> a)
 -> UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a)
-> (a -> a -> a)
-> UniqFM NameSpace a
-> UniqFM NameSpace a
-> UniqFM NameSpace a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
f) FastStringEnv (UniqFM NameSpace a)
env FastString
s (NameSpace -> a -> UniqFM NameSpace a
forall key elt. Uniquable key => key -> elt -> UniqFM key elt
unitUFM NameSpace
ns a
a)

-- | Compute whether there is a value keyed by the given 'OccName'.
elemOccEnv :: OccName -> OccEnv a -> Bool
elemOccEnv :: forall a. OccName -> OccEnv a -> Bool
elemOccEnv (OccName NameSpace
ns FastString
s) (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as)
  = case FastStringEnv (UniqFM NameSpace a)
-> FastString -> Maybe (UniqFM NameSpace a)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv (UniqFM NameSpace a)
as FastString
s of
      Maybe (UniqFM NameSpace a)
Nothing -> Bool
False
      Just UniqFM NameSpace a
m  -> NameSpace
ns NameSpace -> UniqFM NameSpace a -> Bool
forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
`elemUFM` UniqFM NameSpace a
m

-- | Fold over an 'OccEnv'. Non-deterministic, unless the folding function
-- is commutative (i.e. @a1 `f` ( a2 `f` b ) == a2 `f` ( a1 `f` b )@ for all @a1@, @a2@, @b@).
nonDetFoldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv :: forall a b. (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv a -> b -> b
f b
b0 (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) =
  (UniqFM NameSpace a -> b -> b)
-> b -> FastStringEnv (UniqFM NameSpace a) -> b
forall a b. (a -> b -> b) -> b -> FastStringEnv a -> b
nonDetFoldFsEnv ((b -> UniqFM NameSpace a -> b) -> UniqFM NameSpace a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> UniqFM NameSpace a -> b) -> UniqFM NameSpace a -> b -> b)
-> (b -> UniqFM NameSpace a -> b) -> UniqFM NameSpace a -> b -> b
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> b -> UniqFM NameSpace a -> b
forall {k} elt a (key :: k).
(elt -> a -> a) -> a -> UniqFM key elt -> a
nonDetFoldUFM a -> b -> b
f) b
b0 FastStringEnv (UniqFM NameSpace a)
as

-- | Obtain the elements of an 'OccEnv'.
--
-- The resulting order is non-deterministic.
nonDetOccEnvElts :: OccEnv a -> [a]
nonDetOccEnvElts :: forall a. OccEnv a -> [a]
nonDetOccEnvElts = (a -> [a] -> [a]) -> [a] -> OccEnv a -> [a]
forall a b. (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv (:) []

-- | Union of two 'OccEnv's, right-biased.
plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv :: forall a. OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env1) (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env2)
  = FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
forall a.
(a -> a -> a)
-> FastStringEnv a -> FastStringEnv a -> FastStringEnv a
plusFsEnv_C UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a
forall {k} (key :: k) elt.
UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM FastStringEnv (UniqFM NameSpace a)
env1 FastStringEnv (UniqFM NameSpace a)
env2

-- | Union of two 'OccEnv's with a combining function.
plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C :: forall a. (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C a -> a -> a
f (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env1) (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env2)
  = FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
forall a.
(a -> a -> a)
-> FastStringEnv a -> FastStringEnv a -> FastStringEnv a
plusFsEnv_C ((a -> a -> a)
-> UniqFM NameSpace a -> UniqFM NameSpace a -> UniqFM NameSpace a
forall {k} elt (key :: k).
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C a -> a -> a
f) FastStringEnv (UniqFM NameSpace a)
env1 FastStringEnv (UniqFM NameSpace a)
env2

-- | Map over an 'OccEnv' ('Functor' instance).
mapOccEnv :: (a->b) -> OccEnv a -> OccEnv b
mapOccEnv :: forall a b. (a -> b) -> OccEnv a -> OccEnv b
mapOccEnv = (a -> b) -> OccEnv a -> OccEnv b
forall a b. (a -> b) -> OccEnv a -> OccEnv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | 'mapMaybe' for b 'OccEnv'.
mapMaybeOccEnv :: (a -> Maybe b) -> OccEnv a -> OccEnv b
mapMaybeOccEnv :: forall a b. (a -> Maybe b) -> OccEnv a -> OccEnv b
mapMaybeOccEnv a -> Maybe b
f (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env)
  = FastStringEnv (UniqFM NameSpace b) -> OccEnv b
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace b) -> OccEnv b)
-> FastStringEnv (UniqFM NameSpace b) -> OccEnv b
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a -> Maybe (UniqFM NameSpace b))
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace b)
forall {k} elt1 elt2 (key :: k).
(elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapMaybeUFM UniqFM NameSpace a -> Maybe (UniqFM NameSpace b)
g FastStringEnv (UniqFM NameSpace a)
env
    where
      g :: UniqFM NameSpace a -> Maybe (UniqFM NameSpace b)
g UniqFM NameSpace a
as =
        case (a -> Maybe b) -> UniqFM NameSpace a -> UniqFM NameSpace b
forall {k} elt1 elt2 (key :: k).
(elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapMaybeUFM a -> Maybe b
f UniqFM NameSpace a
as of
          UniqFM NameSpace b
m' | UniqFM NameSpace b -> Bool
forall {k} (key :: k) elt. UniqFM key elt -> Bool
isNullUFM UniqFM NameSpace b
m' -> Maybe (UniqFM NameSpace b)
forall a. Maybe a
Nothing
             | Bool
otherwise    -> UniqFM NameSpace b -> Maybe (UniqFM NameSpace b)
forall a. a -> Maybe a
Just UniqFM NameSpace b
m'

-- | Add a single element to an 'OccEnv', using a different function whether
-- the 'OccName' already exists or not.
extendOccEnv_Acc :: forall a b
                 .  (a->b->b)    -- ^ add to existing
                 -> (a->b)       -- ^ new element
                 -> OccEnv b     -- ^ old
                 -> OccName -> a -- ^ new
                 -> OccEnv b
extendOccEnv_Acc :: forall a b.
(a -> b -> b) -> (a -> b) -> OccEnv b -> OccName -> a -> OccEnv b
extendOccEnv_Acc a -> b -> b
f a -> b
g (MkOccEnv FastStringEnv (UniqFM NameSpace b)
env) (OccName NameSpace
ns FastString
s) =
  FastStringEnv (UniqFM NameSpace b) -> OccEnv b
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace b) -> OccEnv b)
-> (a -> FastStringEnv (UniqFM NameSpace b)) -> a -> OccEnv b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> UniqFM NameSpace b -> UniqFM NameSpace b)
-> (a -> UniqFM NameSpace b)
-> FastStringEnv (UniqFM NameSpace b)
-> FastString
-> a
-> FastStringEnv (UniqFM NameSpace b)
forall a b.
(a -> b -> b)
-> (a -> b)
-> FastStringEnv b
-> FastString
-> a
-> FastStringEnv b
extendFsEnv_Acc a -> UniqFM NameSpace b -> UniqFM NameSpace b
f' a -> UniqFM NameSpace b
g' FastStringEnv (UniqFM NameSpace b)
env FastString
s
    where
     f' :: a -> UniqFM NameSpace b -> UniqFM NameSpace b
     f' :: a -> UniqFM NameSpace b -> UniqFM NameSpace b
f' a
a UniqFM NameSpace b
bs = (Maybe b -> Maybe b)
-> UniqFM NameSpace b -> NameSpace -> UniqFM NameSpace b
forall key elt.
Uniquable key =>
(Maybe elt -> Maybe elt) -> UniqFM key elt -> key -> UniqFM key elt
alterUFM (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (Maybe b -> b) -> Maybe b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \ case { Maybe b
Nothing -> a -> b
g a
a ; Just b
b -> a -> b -> b
f a
a b
b }) UniqFM NameSpace b
bs NameSpace
ns
     g' :: a -> UniqFM NameSpace b
g' a
a = NameSpace -> b -> UniqFM NameSpace b
forall key elt. Uniquable key => key -> elt -> UniqFM key elt
unitUFM NameSpace
ns (a -> b
g a
a)

-- | Delete one element from an 'OccEnv'.
delFromOccEnv :: forall a. OccEnv a -> OccName -> OccEnv a
delFromOccEnv :: forall a. OccEnv a -> OccName -> OccEnv a
delFromOccEnv (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env1) (OccName NameSpace
ns FastString
s) =
  FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a))
-> FastStringEnv (UniqFM NameSpace a)
-> FastString
-> FastStringEnv (UniqFM NameSpace a)
forall a.
(Maybe a -> Maybe a)
-> FastStringEnv a -> FastString -> FastStringEnv a
alterFsEnv Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a)
f FastStringEnv (UniqFM NameSpace a)
env1 FastString
s
    where
      f :: Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a)
      f :: Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a)
f Maybe (UniqFM NameSpace a)
Nothing = Maybe (UniqFM NameSpace a)
forall a. Maybe a
Nothing
      f (Just UniqFM NameSpace a
m) =
        case UniqFM NameSpace a -> NameSpace -> UniqFM NameSpace a
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> UniqFM key elt
delFromUFM UniqFM NameSpace a
m NameSpace
ns of
          UniqFM NameSpace a
m' | UniqFM NameSpace a -> Bool
forall {k} (key :: k) elt. UniqFM key elt -> Bool
isNullUFM UniqFM NameSpace a
m' -> Maybe (UniqFM NameSpace a)
forall a. Maybe a
Nothing
             | Bool
otherwise    -> UniqFM NameSpace a -> Maybe (UniqFM NameSpace a)
forall a. a -> Maybe a
Just UniqFM NameSpace a
m'

-- | Delete multiple elements from an 'OccEnv'.
delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a
delListFromOccEnv :: forall a. OccEnv a -> [OccName] -> OccEnv a
delListFromOccEnv = (OccEnv a -> OccName -> OccEnv a)
-> OccEnv a -> [OccName] -> OccEnv a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv a -> OccName -> OccEnv a
forall a. OccEnv a -> OccName -> OccEnv a
delFromOccEnv

-- | Filter out all elements in an 'OccEnv' using a predicate.
filterOccEnv :: forall a. (a -> Bool) -> OccEnv a -> OccEnv a
filterOccEnv :: forall a. (a -> Bool) -> OccEnv a -> OccEnv a
filterOccEnv a -> Bool
f (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env) =
  FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a -> Maybe (UniqFM NameSpace a))
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace a)
forall elt1 elt2.
(elt1 -> Maybe elt2) -> FastStringEnv elt1 -> FastStringEnv elt2
mapMaybeFsEnv UniqFM NameSpace a -> Maybe (UniqFM NameSpace a)
g FastStringEnv (UniqFM NameSpace a)
env
    where
      g :: UniqFM NameSpace a -> Maybe (UniqFM NameSpace a)
      g :: UniqFM NameSpace a -> Maybe (UniqFM NameSpace a)
g UniqFM NameSpace a
ms =
        case (a -> Bool) -> UniqFM NameSpace a -> UniqFM NameSpace a
forall {k} elt (key :: k).
(elt -> Bool) -> UniqFM key elt -> UniqFM key elt
filterUFM a -> Bool
f UniqFM NameSpace a
ms of
          UniqFM NameSpace a
m' | UniqFM NameSpace a -> Bool
forall {k} (key :: k) elt. UniqFM key elt -> Bool
isNullUFM UniqFM NameSpace a
m' -> Maybe (UniqFM NameSpace a)
forall a. Maybe a
Nothing
             | Bool
otherwise    -> UniqFM NameSpace a -> Maybe (UniqFM NameSpace a)
forall a. a -> Maybe a
Just UniqFM NameSpace a
m'

-- | Alter an 'OccEnv', adding or removing an element at the given key.
alterOccEnv :: forall a. (Maybe a -> Maybe a) -> OccEnv a -> OccName -> OccEnv a
alterOccEnv :: forall a. (Maybe a -> Maybe a) -> OccEnv a -> OccName -> OccEnv a
alterOccEnv Maybe a -> Maybe a
f (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env) (OccName NameSpace
ns FastString
s) =
  FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a))
-> FastStringEnv (UniqFM NameSpace a)
-> FastString
-> FastStringEnv (UniqFM NameSpace a)
forall a.
(Maybe a -> Maybe a)
-> FastStringEnv a -> FastString -> FastStringEnv a
alterFsEnv Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a)
g FastStringEnv (UniqFM NameSpace a)
env FastString
s
    where
      g :: Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a)
      g :: Maybe (UniqFM NameSpace a) -> Maybe (UniqFM NameSpace a)
g Maybe (UniqFM NameSpace a)
Nothing  = (a -> UniqFM NameSpace a) -> Maybe a -> Maybe (UniqFM NameSpace a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameSpace -> a -> UniqFM NameSpace a
forall key elt. Uniquable key => key -> elt -> UniqFM key elt
unitUFM NameSpace
ns) (Maybe a -> Maybe a
f Maybe a
forall a. Maybe a
Nothing)
      g (Just UniqFM NameSpace a
m) =
        case (Maybe a -> Maybe a)
-> UniqFM NameSpace a -> NameSpace -> UniqFM NameSpace a
forall key elt.
Uniquable key =>
(Maybe elt -> Maybe elt) -> UniqFM key elt -> key -> UniqFM key elt
alterUFM Maybe a -> Maybe a
f UniqFM NameSpace a
m NameSpace
ns of
          UniqFM NameSpace a
m' | UniqFM NameSpace a -> Bool
forall {k} (key :: k) elt. UniqFM key elt -> Bool
isNullUFM UniqFM NameSpace a
m' -> Maybe (UniqFM NameSpace a)
forall a. Maybe a
Nothing
             | Bool
otherwise    -> UniqFM NameSpace a -> Maybe (UniqFM NameSpace a)
forall a. a -> Maybe a
Just UniqFM NameSpace a
m'

intersectOccEnv_C :: (a -> b -> c) -> OccEnv a -> OccEnv b -> OccEnv c
intersectOccEnv_C :: forall a b c. (a -> b -> c) -> OccEnv a -> OccEnv b -> OccEnv c
intersectOccEnv_C a -> b -> c
f (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) (MkOccEnv FastStringEnv (UniqFM NameSpace b)
bs)
  = FastStringEnv (UniqFM NameSpace c) -> OccEnv c
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace c) -> OccEnv c)
-> FastStringEnv (UniqFM NameSpace c) -> OccEnv c
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace c)
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace b)
-> FastStringEnv (UniqFM NameSpace c)
forall {k} elt1 elt2 elt3 (key :: k).
(elt1 -> elt2 -> elt3)
-> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt3
intersectUFM_C ((a -> b -> c)
-> UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace c
forall {k} elt1 elt2 elt3 (key :: k).
(elt1 -> elt2 -> elt3)
-> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt3
intersectUFM_C a -> b -> c
f) FastStringEnv (UniqFM NameSpace a)
as FastStringEnv (UniqFM NameSpace b)
bs

-- | Remove elements of the first 'OccEnv' that appear in the second 'OccEnv'.
minusOccEnv :: OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv :: forall a b. OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv = (UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a)
-> OccEnv a -> OccEnv b -> OccEnv a
forall a b.
(UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a)
-> OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv_C_Ns UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a
forall {k} (key :: k) elt1 elt2.
UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
minusUFM

-- | Alters (replaces or removes) those elements of the first 'OccEnv' that are
-- mentioned in the second 'OccEnv'.
--
-- Same idea as 'Data.Map.differenceWith'.
minusOccEnv_C :: (a -> b -> Maybe a)
              -> OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv_C :: forall a b. (a -> b -> Maybe a) -> OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv_C a -> b -> Maybe a
f = (UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a)
-> OccEnv a -> OccEnv b -> OccEnv a
forall a b.
(UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a)
-> OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv_C_Ns ((a -> b -> Maybe a)
-> UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a
forall {k} elt1 elt2 (key :: k).
(elt1 -> elt2 -> Maybe elt1)
-> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
minusUFM_C a -> b -> Maybe a
f)

minusOccEnv_C_Ns :: forall a b
                 .  (UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a)
                 -> OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv_C_Ns :: forall a b.
(UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a)
-> OccEnv a -> OccEnv b -> OccEnv a
minusOccEnv_C_Ns UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a
f (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) (MkOccEnv FastStringEnv (UniqFM NameSpace b)
bs) =
  FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace a) -> OccEnv a)
-> FastStringEnv (UniqFM NameSpace a) -> OccEnv a
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a
 -> UniqFM NameSpace b -> Maybe (UniqFM NameSpace a))
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace b)
-> FastStringEnv (UniqFM NameSpace a)
forall {k} elt1 elt2 (key :: k).
(elt1 -> elt2 -> Maybe elt1)
-> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
minusUFM_C UniqFM NameSpace a
-> UniqFM NameSpace b -> Maybe (UniqFM NameSpace a)
g FastStringEnv (UniqFM NameSpace a)
as FastStringEnv (UniqFM NameSpace b)
bs
    where
      g :: UniqFM NameSpace a -> UniqFM NameSpace b -> Maybe (UniqFM NameSpace a)
      g :: UniqFM NameSpace a
-> UniqFM NameSpace b -> Maybe (UniqFM NameSpace a)
g UniqFM NameSpace a
as UniqFM NameSpace b
bs =
        let m :: UniqFM NameSpace a
m = UniqFM NameSpace a -> UniqFM NameSpace b -> UniqFM NameSpace a
f UniqFM NameSpace a
as UniqFM NameSpace b
bs
        in if UniqFM NameSpace a -> Bool
forall {k} (key :: k) elt. UniqFM key elt -> Bool
isNullUFM UniqFM NameSpace a
m
           then Maybe (UniqFM NameSpace a)
forall a. Maybe a
Nothing
           else UniqFM NameSpace a -> Maybe (UniqFM NameSpace a)
forall a. a -> Maybe a
Just UniqFM NameSpace a
m

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 :: forall a. (a -> SDoc) -> OccEnv a -> SDoc
pprOccEnv a -> SDoc
ppr_elt (MkOccEnv FastStringEnv (UniqFM NameSpace a)
env)
    = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
    [ Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
uq SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
":->" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
ppr_elt a
elt
    | (Unique
uq, UniqFM NameSpace a
elts) <- FastStringEnv (UniqFM NameSpace a)
-> [(Unique, UniqFM NameSpace a)]
forall {k} (key :: k) elt. UniqFM key elt -> [(Unique, elt)]
nonDetUFMToList FastStringEnv (UniqFM NameSpace a)
env
    , a
elt <- UniqFM NameSpace a -> [a]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM NameSpace a
elts ]

instance NFData a => NFData (OccEnv a) where
  rnf :: OccEnv a -> ()
rnf = (a -> ()) -> OccEnv a -> ()
forall a. (a -> ()) -> OccEnv a -> ()
forceOccEnv a -> ()
forall a. NFData a => a -> ()
rnf

-- | Map over an 'OccEnv' strictly.
strictMapOccEnv :: (a -> b) -> OccEnv a -> OccEnv b
strictMapOccEnv :: forall a b. (a -> b) -> OccEnv a -> OccEnv b
strictMapOccEnv a -> b
f (MkOccEnv FastStringEnv (UniqFM NameSpace a)
as) =
  FastStringEnv (UniqFM NameSpace b) -> OccEnv b
forall a. FastStringEnv (UniqFM NameSpace a) -> OccEnv a
MkOccEnv (FastStringEnv (UniqFM NameSpace b) -> OccEnv b)
-> FastStringEnv (UniqFM NameSpace b) -> OccEnv b
forall a b. (a -> b) -> a -> b
$ (UniqFM NameSpace a -> UniqFM NameSpace b)
-> FastStringEnv (UniqFM NameSpace a)
-> FastStringEnv (UniqFM NameSpace b)
forall a b. (a -> b) -> FastStringEnv a -> FastStringEnv b
strictMapFsEnv ((a -> b) -> UniqFM NameSpace a -> UniqFM NameSpace b
forall {k1} a b (k2 :: k1). (a -> b) -> UniqFM k2 a -> UniqFM k2 b
strictMapUFM a -> b
f) FastStringEnv (UniqFM NameSpace a)
as

-- | Force an 'OccEnv' with the provided function.
forceOccEnv :: (a -> ()) -> OccEnv a -> ()
forceOccEnv :: forall a. (a -> ()) -> OccEnv a -> ()
forceOccEnv a -> ()
nf (MkOccEnv FastStringEnv (UniqFM NameSpace a)
fs) = (UniqFM NameSpace a -> ())
-> FastStringEnv (UniqFM NameSpace a) -> ()
forall {k} elt (key :: k). (elt -> ()) -> UniqFM key elt -> ()
seqEltsUFM ((a -> ()) -> UniqFM NameSpace a -> ()
forall {k} elt (key :: k). (elt -> ()) -> UniqFM key elt -> ()
seqEltsUFM a -> ()
nf) FastStringEnv (UniqFM NameSpace a)
fs

--------------------------------------------------------------------------------

newtype OccSet = OccSet (FastStringEnv (UniqSet NameSpace))

emptyOccSet       :: OccSet
unitOccSet        :: OccName -> OccSet
mkOccSet          :: [OccName] -> OccSet
extendOccSet      :: OccSet -> OccName -> OccSet
extendOccSetList  :: OccSet -> [OccName] -> OccSet
unionOccSets      :: OccSet -> OccSet -> OccSet
unionManyOccSets  :: [OccSet] -> OccSet
elemOccSet        :: OccName -> OccSet -> Bool
isEmptyOccSet     :: OccSet -> Bool

emptyOccSet :: OccSet
emptyOccSet       = FastStringEnv (UniqSet NameSpace) -> OccSet
OccSet FastStringEnv (UniqSet NameSpace)
forall a. FastStringEnv a
emptyFsEnv
unitOccSet :: OccName -> OccSet
unitOccSet (OccName NameSpace
ns FastString
s) = FastStringEnv (UniqSet NameSpace) -> OccSet
OccSet (FastStringEnv (UniqSet NameSpace) -> OccSet)
-> FastStringEnv (UniqSet NameSpace) -> OccSet
forall a b. (a -> b) -> a -> b
$ FastString
-> UniqSet NameSpace -> FastStringEnv (UniqSet NameSpace)
forall a. FastString -> a -> FastStringEnv a
unitFsEnv FastString
s (NameSpace -> UniqSet NameSpace
forall a. Uniquable a => a -> UniqSet a
unitUniqSet NameSpace
ns)
mkOccSet :: [OccName] -> OccSet
mkOccSet          = OccSet -> [OccName] -> OccSet
extendOccSetList OccSet
emptyOccSet
extendOccSet :: OccSet -> OccName -> OccSet
extendOccSet      (OccSet FastStringEnv (UniqSet NameSpace)
occs) (OccName NameSpace
ns FastString
s) = FastStringEnv (UniqSet NameSpace) -> OccSet
OccSet (FastStringEnv (UniqSet NameSpace) -> OccSet)
-> FastStringEnv (UniqSet NameSpace) -> OccSet
forall a b. (a -> b) -> a -> b
$ FastStringEnv (UniqSet NameSpace)
-> FastString
-> UniqSet NameSpace
-> FastStringEnv (UniqSet NameSpace)
forall a. FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv FastStringEnv (UniqSet NameSpace)
occs FastString
s (NameSpace -> UniqSet NameSpace
forall a. Uniquable a => a -> UniqSet a
unitUniqSet NameSpace
ns)
extendOccSetList :: OccSet -> [OccName] -> OccSet
extendOccSetList  = (OccSet -> OccName -> OccSet) -> OccSet -> [OccName] -> OccSet
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccSet -> OccName -> OccSet
extendOccSet
unionOccSets :: OccSet -> OccSet -> OccSet
unionOccSets      (OccSet FastStringEnv (UniqSet NameSpace)
xs) (OccSet FastStringEnv (UniqSet NameSpace)
ys) = FastStringEnv (UniqSet NameSpace) -> OccSet
OccSet (FastStringEnv (UniqSet NameSpace) -> OccSet)
-> FastStringEnv (UniqSet NameSpace) -> OccSet
forall a b. (a -> b) -> a -> b
$ (UniqSet NameSpace -> UniqSet NameSpace -> UniqSet NameSpace)
-> FastStringEnv (UniqSet NameSpace)
-> FastStringEnv (UniqSet NameSpace)
-> FastStringEnv (UniqSet NameSpace)
forall a.
(a -> a -> a)
-> FastStringEnv a -> FastStringEnv a -> FastStringEnv a
plusFsEnv_C UniqSet NameSpace -> UniqSet NameSpace -> UniqSet NameSpace
forall a. UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets FastStringEnv (UniqSet NameSpace)
xs FastStringEnv (UniqSet NameSpace)
ys
unionManyOccSets :: [OccSet] -> OccSet
unionManyOccSets  = (OccSet -> OccSet -> OccSet) -> OccSet -> [OccSet] -> OccSet
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccSet -> OccSet -> OccSet
unionOccSets OccSet
emptyOccSet
elemOccSet :: OccName -> OccSet -> Bool
elemOccSet (OccName NameSpace
ns FastString
s) (OccSet FastStringEnv (UniqSet NameSpace)
occs) = Bool
-> (UniqSet NameSpace -> Bool) -> Maybe (UniqSet NameSpace) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (NameSpace -> UniqSet NameSpace -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
elementOfUniqSet NameSpace
ns) (Maybe (UniqSet NameSpace) -> Bool)
-> Maybe (UniqSet NameSpace) -> Bool
forall a b. (a -> b) -> a -> b
$ FastStringEnv (UniqSet NameSpace)
-> FastString -> Maybe (UniqSet NameSpace)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv (UniqSet NameSpace)
occs FastString
s
isEmptyOccSet :: OccSet -> Bool
isEmptyOccSet     (OccSet FastStringEnv (UniqSet NameSpace)
occs) = FastStringEnv (UniqSet NameSpace) -> Bool
forall {k} (key :: k) elt. UniqFM key elt -> Bool
isNullUFM FastStringEnv (UniqSet NameSpace)
occs

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

occNameString :: OccName -> String
occNameString :: OccName -> [Char]
occNameString (OccName NameSpace
_ FastString
s) = FastString -> [Char]
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, isFieldOcc :: 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

isFieldOcc :: OccName -> Bool
isFieldOcc (OccName (FldName {}) FastString
_) = Bool
True
isFieldOcc OccName
_                        = Bool
False

fieldOcc_maybe :: OccName -> Maybe FastString
fieldOcc_maybe :: OccName -> Maybe FastString
fieldOcc_maybe (OccName (FldName FastString
con) FastString
_) = FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
con
fieldOcc_maybe OccName
_                         = Maybe FastString
forall a. Maybe a
Nothing

-- | /Value/ 'OccNames's are those that are either in
-- the variable, field name 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 (FldName {}) 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
ns FastString
s) = case NameSpace
ns of
  NameSpace
DataName   -> FastString -> Bool
isLexConSym FastString
s
  NameSpace
TcClsName  -> FastString -> Bool
isLexSym FastString
s
  NameSpace
VarName    -> FastString -> Bool
isLexSym FastString
s
  NameSpace
TvName     -> FastString -> Bool
isLexSym FastString
s
  FldName {} -> 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
forall doc. IsLine doc => doc -> doc
parens SDoc
doc
                    | Bool
otherwise    = SDoc
doc

startsWithUnderscore :: OccName -> Bool
-- ^ Haskell 98 encourages compilers to suppress warnings about unused
-- names in a pattern if they start with @_@: this implements that test
startsWithUnderscore :: OccName -> Bool
startsWithUnderscore OccName
occ = case FastString -> [Char]
unpackFS (OccName -> FastString
occNameFS OccName
occ) of
  Char
'_':[Char]
_ -> Bool
True
  [Char]
_     -> Bool
False

isUnderscore :: OccName -> Bool
isUnderscore :: OccName -> Bool
isUnderscore OccName
occ = OccName -> FastString
occNameFS OccName
occ FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> FastString
fsLit [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 predicate
-- is used to suppress printing of internal definitions in some debug prints
isDerivedOccName :: OccName -> Bool
isDerivedOccName OccName
occ =
   case OccName -> [Char]
occNameString OccName
occ of
     Char
'$':Char
c:[Char]
_ | Char -> Bool
isAlphaNum Char
c -> Bool
True   -- E.g.  $wfoo
     Char
c:Char
':':[Char]
_ | Char -> Bool
isAlphaNum Char
c -> Bool
True   -- E.g.  N:blah   newtype coercions
     [Char]
_other                 -> Bool
False

isDefaultMethodOcc :: OccName -> Bool
isDefaultMethodOcc :: OccName -> Bool
isDefaultMethodOcc OccName
occ =
   case OccName -> [Char]
occNameString OccName
occ of
     Char
'$':Char
'd':Char
'm':[Char]
_ -> Bool
True
     [Char]
_ -> 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 "GHC.Tc.Instance.Typeable".
isTypeableBindOcc :: OccName -> Bool
isTypeableBindOcc :: OccName -> Bool
isTypeableBindOcc OccName
occ =
   case OccName -> [Char]
occNameString OccName
occ of
     Char
'$':Char
't':Char
'c':[Char]
_ -> Bool
True  -- mkTyConRepOcc
     Char
'$':Char
't':Char
'r':[Char]
_ -> Bool
True  -- Module binding
     [Char]
_ -> Bool
False

mkDataConWrapperOcc, mkWorkerOcc,
        mkMatcherOcc, mkBuilderOcc,
        mkDefaultMethodOcc,
        mkClassDataConOcc, mkDictOcc,
        mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
        mkGenR, mkGen1R,
        mkDataConWorkerOcc, mkNewTyCoOcc,
        mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkDataTOcc, mkDataCOcc,
        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 for the names of auxiliary bindings.
-- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
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_"
mkDataTOcc :: OccName -> OccName
mkDataTOcc          = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$t"
mkDataCOcc :: OccName -> OccName
mkDataCOcc          = NameSpace -> FastString -> OccName -> OccName
mk_simple_deriv NameSpace
varName  FastString
"$c"

-- TyConRepName stuff; see Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable
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_"

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" [[Char] -> FastString
fsLit ([Char] -> FastString) -> [Char] -> FastString
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
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" [[Char] -> FastString
fsLit ([Char] -> FastString) -> [Char] -> FastString
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
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" [[Char] -> FastString
fsLit ([Char] -> FastString) -> [Char] -> FastString
forall a b. (a -> b) -> a -> b
$ Unique -> [Char]
forall a. Show a => a -> [Char]
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 :: [Char] -> OccSet -> OccName
mkInstTyTcOcc [Char]
str = NameSpace -> [Char] -> OccSet -> OccName
chooseUniqueOcc NameSpace
tcName (Char
'R' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
':' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
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 :: [Char] -> Bool -> OccSet -> OccName
mkDFunOcc [Char]
info_str Bool
is_boot OccSet
set
  = NameSpace -> [Char] -> OccSet -> OccName
chooseUniqueOcc NameSpace
VarName ([Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
info_str) OccSet
set
  where
    prefix :: [Char]
prefix | Bool
is_boot   = [Char]
"$fx"
           | Bool
otherwise = [Char]
"$f"

{-
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 -> [Char] -> OccSet -> OccName
chooseUniqueOcc NameSpace
ns [Char]
str OccSet
set = OccName -> Int -> OccName
loop (NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns [Char]
str) (Int
0::Int)
  where
  loop :: OccName -> Int -> OccName
loop OccName
occ Int
n
   | OccName
occ OccName -> OccSet -> Bool
`elemOccSet` OccSet
set = OccName -> Int -> OccName
loop (NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns ([Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 GHC.Tc.TyCl.Class.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 FastString 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 two 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.  Thus

   avoidNameClashesOccEnv ["a" :-> 7] ["b", "a", "c", "b", "a"]
     = ["a" :-> 7, "b" :-> 1]

Here
* "a" is already the TidyOccEnv, and so is unaffected
* "b" occurs twice, so is blocked by adding "b" :-> 1
* "c" occurs only once, and so is not affected.

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

This is #12382.

-}

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

emptyTidyOccEnv :: TidyOccEnv
emptyTidyOccEnv :: TidyOccEnv
emptyTidyOccEnv = TidyOccEnv
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM

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

delTidyOccEnvList :: TidyOccEnv -> [OccName] -> TidyOccEnv
delTidyOccEnvList :: TidyOccEnv -> [OccName] -> TidyOccEnv
delTidyOccEnvList TidyOccEnv
env [OccName]
occs = TidyOccEnv
env TidyOccEnv -> [FastString] -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM key elt -> [key] -> UniqFM key elt
`delListFromUFM` (OccName -> FastString) -> [OccName] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> FastString
occNameFS [OccName]
occs

-- see Note [Tidying multiple names at once]
avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
avoidClashesOccEnv TidyOccEnv
env [OccName]
occs = TidyOccEnv -> UniqFM FastString () -> [OccName] -> TidyOccEnv
forall {elt}.
Num elt =>
UniqFM FastString elt
-> UniqFM FastString () -> [OccName] -> UniqFM FastString elt
go TidyOccEnv
env UniqFM FastString ()
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM [OccName]
occs
  where
    go :: UniqFM FastString elt
-> UniqFM FastString () -> [OccName] -> UniqFM FastString elt
go UniqFM FastString elt
env UniqFM FastString ()
_        [] = UniqFM FastString elt
env
    go UniqFM FastString elt
env UniqFM FastString ()
seenOnce ((OccName NameSpace
_ FastString
fs):[OccName]
occs)
      | FastString
fs FastString -> UniqFM FastString elt -> Bool
forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
`elemUFM` UniqFM FastString elt
env      = UniqFM FastString elt
-> UniqFM FastString () -> [OccName] -> UniqFM FastString elt
go UniqFM FastString elt
env UniqFM FastString ()
seenOnce                  [OccName]
occs
      | FastString
fs FastString -> UniqFM FastString () -> Bool
forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
`elemUFM` UniqFM FastString ()
seenOnce = UniqFM FastString elt
-> UniqFM FastString () -> [OccName] -> UniqFM FastString elt
go (UniqFM FastString elt -> FastString -> elt -> UniqFM FastString elt
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM FastString elt
env FastString
fs elt
1) UniqFM FastString ()
seenOnce  [OccName]
occs
      | Bool
otherwise             = UniqFM FastString elt
-> UniqFM FastString () -> [OccName] -> UniqFM FastString elt
go UniqFM FastString elt
env (UniqFM FastString () -> FastString -> () -> UniqFM FastString ()
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM FastString ()
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 key 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 key elt -> key -> elt -> UniqFM key elt
addToUFM TidyOccEnv
env FastString
fs Int
1, OccName
occ)

  | Bool
otherwise
  = case TidyOccEnv -> FastString -> Maybe Int
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM TidyOccEnv
env FastString
base1 of
       Maybe Int
Nothing -> (TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key 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 :: [Char]
base  = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isDigit (FastString -> [Char]
unpackFS FastString
fs)
    base1 :: FastString
base1 = [Char] -> FastString
mkFastString ([Char]
base [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"1")

    find :: Int -> Int -> (TidyOccEnv, OccName)
find !Int
k !Int
n
      = case FastString -> TidyOccEnv -> Bool
forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
elemUFM FastString
new_fs TidyOccEnv
env of
          Bool
True -> 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

          Bool
False -> (TidyOccEnv
new_env, NameSpace -> FastString -> OccName
OccName NameSpace
occ_sp FastString
new_fs)
       where
         new_fs :: FastString
new_fs = [Char] -> FastString
mkFastString ([Char]
base [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
         new_env :: TidyOccEnv
new_env = TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM (TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key 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]

trimTidyOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
-- Restrict the env to just the [OccName]
trimTidyOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
trimTidyOccEnv TidyOccEnv
env [OccName]
vs
  = (TidyOccEnv -> OccName -> TidyOccEnv)
-> TidyOccEnv -> [OccName] -> TidyOccEnv
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TidyOccEnv -> OccName -> TidyOccEnv
add TidyOccEnv
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM [OccName]
vs
  where
    add :: TidyOccEnv -> OccName -> TidyOccEnv
    add :: TidyOccEnv -> OccName -> TidyOccEnv
add TidyOccEnv
so_far (OccName NameSpace
_ FastString
fs)
      = case TidyOccEnv -> FastString -> Maybe Int
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM TidyOccEnv
env FastString
fs of
          Just Int
n  -> TidyOccEnv -> FastString -> Int -> TidyOccEnv
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM TidyOccEnv
so_far FastString
fs Int
n
          Maybe Int
Nothing -> TidyOccEnv
so_far

{-
************************************************************************
*                                                                      *
                            Utilies for "main"
*                                                                      *
************************************************************************
-}

mainOcc :: OccName
mainOcc :: OccName
mainOcc = FastString -> OccName
mkVarOccFS ([Char] -> FastString
fsLit [Char]
"main")

ppMainFn :: OccName -> SDoc
ppMainFn :: OccName -> SDoc
ppMainFn OccName
main_occ
  | OccName
main_occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
mainOcc
  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"IO action" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
main_occ)
  | Bool
otherwise
  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"main IO action" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
main_occ)

{-
************************************************************************
*                                                                      *
                Binary instance
    Here rather than in GHC.Iface.Binary because OccName is abstract
*                                                                      *
************************************************************************
-}

instance Binary NameSpace where
    put_ :: WriteBinHandle -> NameSpace -> IO ()
put_ WriteBinHandle
bh NameSpace
VarName =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh NameSpace
DataName =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    put_ WriteBinHandle
bh NameSpace
TvName =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    put_ WriteBinHandle
bh NameSpace
TcClsName =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
    put_ WriteBinHandle
bh (FldName FastString
parent) = do
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4
            WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
parent
    get :: ReadBinHandle -> IO NameSpace
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
VarName
              Word8
1 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
DataName
              Word8
2 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
TvName
              Word8
3 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
TcClsName
              Word8
_ -> do
                parent <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                return $ FldName { fldParent = parent }

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