Commit b1884b0e authored by Adam Gundry's avatar Adam Gundry

Implement DuplicateRecordFields

This implements DuplicateRecordFields, the first part of the
OverloadedRecordFields extension, as described at
https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields

This includes fairly wide-ranging changes in order to allow multiple
records within the same module to use the same field names.  Note that
it does *not* allow record selector functions to be used if they are
ambiguous, and it does not have any form of type-based disambiguation
for selectors (but it does for updates). Subsequent parts will make
overloading selectors possible using orthogonal extensions, as
described on the wiki pages.  This part touches quite a lot of the
codebase, and requires changes to several GHC API datatypes in order
to distinguish between field labels (which may be overloaded) and
selector function names (which are always unique).

The Haddock submodule has been adapted to compile with the GHC API
changes, but it will need further work to properly support modules
that use the DuplicateRecordFields extension.

Test Plan: New tests added in testsuite/tests/overloadedrecflds; these
will be extended once the other parts are implemented.

Reviewers: goldfire, bgamari, simonpj, austin

Subscribers: sjcjoosten, haggholm, mpickering, bgamari, tibbe, thomie,
goldfire

Differential Revision: https://phabricator.haskell.org/D761
parent 808bbdf0
......@@ -2,12 +2,17 @@
-- (c) The University of Glasgow
--
{-# LANGUAGE DeriveDataTypeable #-}
module Avail (
Avails,
AvailInfo(..),
availsToNameSet,
availsToNameSetWithSelectors,
availsToNameEnv,
availName, availNames,
availName, availNames, availNonFldNames,
availNamesWithSelectors,
availFlds,
stableAvailCmp
) where
......@@ -15,20 +20,28 @@ import Name
import NameEnv
import NameSet
import FieldLabel
import Binary
import Outputable
import Util
import Data.Function
-- -----------------------------------------------------------------------------
-- The AvailInfo type
-- | Records what things are "available", i.e. in scope
data AvailInfo = Avail Name -- ^ An ordinary identifier in scope
| AvailTC Name
[Name] -- ^ A type or class in scope. Parameters:
[Name]
[FieldLabel]
-- ^ A type or class in scope. Parameters:
--
-- 1) The name of the type or class
-- 2) The available pieces of type or class.
-- 2) The available pieces of type or class,
-- excluding field selectors.
-- 3) The record fields of the type
-- (see Note [Representing fields in AvailInfo]).
--
-- The AvailTC Invariant:
-- * If the type or class is itself
......@@ -42,14 +55,63 @@ data AvailInfo = Avail Name -- ^ An ordinary identifier in scope
-- | A collection of 'AvailInfo' - several things that are \"available\"
type Avails = [AvailInfo]
{-
Note [Representing fields in AvailInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When -XDuplicateRecordFields is disabled (the normal case), a
datatype like
data T = MkT { foo :: Int }
gives rise to the AvailInfo
AvailTC T [T, MkT] [FieldLabel "foo" False foo],
whereas if -XDuplicateRecordFields is enabled it gives
AvailTC T [T, MkT] [FieldLabel "foo" True $sel:foo:MkT]
since the label does not match the selector name.
The labels in a field list are not necessarily unique:
data families allow the same parent (the family tycon) to have
multiple distinct fields with the same label. For example,
data family F a
data instance F Int = MkFInt { foo :: Int }
data instance F Bool = MkFBool { foo :: Bool}
gives rise to
AvailTC F [F, MkFInt, MkFBool]
[FieldLabel "foo" True $sel:foo:MkFInt, FieldLabel "foo" True $sel:foo:MkFBool].
Moreover, note that the flIsOverloaded flag need not be the same for
all the elements of the list. In the example above, this occurs if
the two data instances are defined in different modules, one with
`-XDuplicateRecordFields` enabled and one with it disabled. Thus it
is possible to have
AvailTC F [F, MkFInt, MkFBool]
[FieldLabel "foo" True $sel:foo:MkFInt, FieldLabel "foo" False foo].
If the two data instances are defined in different modules, both
without `-XDuplicateRecordFields`, it will be impossible to export
them from the same module (even with `-XDuplicateRecordfields`
enabled), because they would be represented identically. The
workaround here is to enable `-XDuplicateRecordFields` on the defining
modules.
-}
-- | Compare lexicographically
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2
stableAvailCmp (Avail {}) (AvailTC {}) = LT
stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
(cmpList stableNameCmp ns ms)
stableAvailCmp (AvailTC {}) (Avail {}) = GT
stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2
stableAvailCmp (Avail {}) (AvailTC {}) = LT
stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) =
(n `stableNameCmp` m) `thenCmp`
(cmpList stableNameCmp ns ms) `thenCmp`
(cmpList (stableNameCmp `on` flSelector) nfs mfs)
stableAvailCmp (AvailTC {}) (Avail {}) = GT
-- -----------------------------------------------------------------------------
-- Operations on AvailInfo
......@@ -58,6 +120,10 @@ availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet avails = foldr add emptyNameSet avails
where add avail set = extendNameSetList set (availNames avail)
availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors avails = foldr add emptyNameSet avails
where add avail set = extendNameSetList set (availNamesWithSelectors avail)
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv avails = foldr add emptyNameEnv avails
where add avail env = extendNameEnvList env
......@@ -66,13 +132,29 @@ availsToNameEnv avails = foldr add emptyNameEnv avails
-- | Just the main name made available, i.e. not the available pieces
-- of type or class brought into scope by the 'GenAvailInfo'
availName :: AvailInfo -> Name
availName (Avail n) = n
availName (AvailTC n _) = n
availName (Avail n) = n
availName (AvailTC n _ _) = n
-- | All names made available by the availability information
-- | All names made available by the availability information (excluding overloaded selectors)
availNames :: AvailInfo -> [Name]
availNames (Avail n) = [n]
availNames (AvailTC _ ns) = ns
availNames (Avail n) = [n]
availNames (AvailTC _ ns fs) = ns ++ [ flSelector f | f <- fs, not (flIsOverloaded f) ]
-- | All names made available by the availability information (including overloaded selectors)
availNamesWithSelectors :: AvailInfo -> [Name]
availNamesWithSelectors (Avail n) = [n]
availNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs
-- | Names for non-fields made available by the availability information
availNonFldNames :: AvailInfo -> [Name]
availNonFldNames (Avail n) = [n]
availNonFldNames (AvailTC _ ns _) = ns
-- | Fields made available by the availability information
availFlds :: AvailInfo -> [FieldLabel]
availFlds (AvailTC _ _ fs) = fs
availFlds _ = []
-- -----------------------------------------------------------------------------
-- Printing
......@@ -81,17 +163,18 @@ instance Outputable AvailInfo where
ppr = pprAvail
pprAvail :: AvailInfo -> SDoc
pprAvail (Avail n) = ppr n
pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
pprAvail (Avail n) = ppr n
pprAvail (AvailTC n ns fs) = ppr n <> braces (hsep (punctuate comma (map ppr ns ++ map (ppr . flLabel) fs)))
instance Binary AvailInfo where
put_ bh (Avail aa) = do
putByte bh 0
put_ bh aa
put_ bh (AvailTC ab ac) = do
put_ bh (AvailTC ab ac ad) = do
putByte bh 1
put_ bh ab
put_ bh ac
put_ bh ad
get bh = do
h <- getByte bh
case h of
......@@ -99,5 +182,5 @@ instance Binary AvailInfo where
return (Avail aa)
_ -> do ab <- get bh
ac <- get bh
return (AvailTC ab ac)
ad <- get bh
return (AvailTC ab ac ad)
......@@ -25,7 +25,7 @@ import Outputable
import Unique
import Util
import Name
import TyCon
import FieldLabel
import BasicTypes
import {-# SOURCE #-} TypeRep (Type, ThetaType)
import Var
......
......@@ -15,6 +15,9 @@ module DataCon (
StrictnessMark(..),
ConTag,
-- ** Field labels
FieldLbl(..), FieldLabel, FieldLabelString,
-- ** Type construction
mkDataCon, fIRST_TAG,
buildAlgTyCon,
......@@ -57,6 +60,7 @@ import Coercion
import Kind
import Unify
import TyCon
import FieldLabel
import Class
import Name
import Var
......@@ -75,7 +79,7 @@ import qualified Data.Typeable
import Data.Maybe
import Data.Char
import Data.Word
import Data.List( mapAccumL )
import Data.List( mapAccumL, find )
{-
Data constructor representation
......@@ -831,10 +835,10 @@ dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields
-- | Extract the type for any given labelled field of the 'DataCon'
dataConFieldType :: DataCon -> FieldLabel -> Type
dataConFieldType :: DataCon -> FieldLabelString -> Type
dataConFieldType con label
= case lookup label (dcFields con `zip` dcOrigArgTys con) of
Just ty -> ty
= case find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con) of
Just (_, ty) -> ty
Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
-- | Strictness/unpack annotations, from user; or, for imported
......
module DataCon where
import Var( TyVar )
import Name( Name, NamedThing )
import {-# SOURCE #-} TyCon( TyCon, FieldLabel )
import {-# SOURCE #-} TyCon( TyCon )
import FieldLabel ( FieldLabel )
import Unique ( Uniquable )
import Outputable ( Outputable, OutputableBndr )
import BasicTypes (Arity)
......
{-
%
% (c) Adam Gundry 2013-2015
%
This module defines the representation of FieldLabels as stored in
TyCons. As well as a selector name, these have some extra structure
to support the DuplicateRecordFields extension.
In the normal case (with NoDuplicateRecordFields), a datatype like
data T = MkT { foo :: Int }
has
FieldLabel { flLabel = "foo"
, flIsOverloaded = False
, flSelector = foo }.
In particular, the Name of the selector has the same string
representation as the label. If DuplicateRecordFields
is enabled, however, the same declaration instead gives
FieldLabel { flLabel = "foo"
, flIsOverloaded = True
, flSelector = $sel:foo:MkT }.
Now the name of the selector ($sel:foo:MkT) does not match the label of
the field (foo). We must be careful not to show the selector name to
the user! The point of mangling the selector name is to allow a
module to define the same field label in different datatypes:
data T = MkT { foo :: Int }
data U = MkU { foo :: Bool }
Now there will be two FieldLabel values for 'foo', one in T and one in
U. They share the same label (FieldLabelString), but the selector
functions differ.
See also Note [Representing fields in AvailInfo] in Avail.
Note [Why selector names include data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As explained above, a selector name includes the name of the first
data constructor in the type, so that the same label can appear
multiple times in the same module. (This is irrespective of whether
the first constructor has that field, for simplicity.)
We use a data constructor name, rather than the type constructor name,
because data family instances do not have a representation type
constructor name generated until relatively late in the typechecking
process.
Of course, datatypes with no constructors cannot have any fields.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE StandaloneDeriving #-}
module FieldLabel ( FieldLabelString
, FieldLabelEnv
, FieldLbl(..)
, FieldLabel
, mkFieldLabelOccs
) where
import OccName
import Name
import FastString
import Outputable
import Binary
import Data.Data
#if __GLASGOW_HASKELL__ < 709
import Data.Foldable ( Foldable )
import Data.Traversable ( Traversable )
#endif
-- | Field labels are just represented as strings;
-- they are not necessarily unique (even within a module)
type FieldLabelString = FastString
-- | A map from labels to all the auxiliary information
type FieldLabelEnv = FastStringEnv FieldLabel
type FieldLabel = FieldLbl Name
-- | Fields in an algebraic record type
data FieldLbl a = FieldLabel {
flLabel :: FieldLabelString, -- ^ User-visible label of the field
flIsOverloaded :: Bool, -- ^ Was DuplicateRecordFields on
-- in the defining module for this datatype?
flSelector :: a -- ^ Record selector function
}
deriving (Eq, Functor, Foldable, Traversable, Typeable)
deriving instance Data a => Data (FieldLbl a)
instance Outputable a => Outputable (FieldLbl a) where
ppr fl = ppr (flLabel fl) <> braces (ppr (flSelector fl))
instance Binary a => Binary (FieldLbl a) where
put_ bh (FieldLabel aa ab ac) = do
put_ bh aa
put_ bh ab
put_ bh ac
get bh = do
ab <- get bh
ac <- get bh
ad <- get bh
return (FieldLabel ab ac ad)
-- | Record selector OccNames are built from the underlying field name
-- and the name of the first data constructor of the type, to support
-- duplicate record field names.
-- See Note [Why selector names include data constructors].
mkFieldLabelOccs :: FieldLabelString -> OccName -> Bool -> FieldLbl OccName
mkFieldLabelOccs lbl dc is_overloaded
= FieldLabel lbl is_overloaded sel_occ
where
str = ":" ++ unpackFS lbl ++ ":" ++ occNameString dc
sel_occ | is_overloaded = mkRecFldSelOcc str
| otherwise = mkVarOccFS lbl
......@@ -38,7 +38,7 @@ module Id (
-- ** Taking an Id apart
idName, idType, idUnique, idInfo, idDetails, idRepArity,
recordSelectorFieldLabel,
recordSelectorTyCon,
-- ** Modifying an Id
setIdName, setIdUnique, Id.setIdType,
......@@ -353,12 +353,12 @@ That is what is happening in, say tidy_insts in TidyPgm.
************************************************************************
-}
-- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise
recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
recordSelectorFieldLabel id
-- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
recordSelectorTyCon :: Id -> TyCon
recordSelectorTyCon id
= case Var.idDetails id of
RecSelId { sel_tycon = tycon } -> (tycon, idName id)
_ -> panic "recordSelectorFieldLabel"
RecSelId { sel_tycon = tycon } -> tycon
_ -> panic "recordSelectorTyCon"
isRecordSelector :: Id -> Bool
isNaughtyRecordSelector :: Id -> Bool
......
......@@ -71,6 +71,7 @@ module OccName (
mkPDatasTyConOcc, mkPDatasDataConOcc,
mkPReprTyConOcc,
mkPADFunOcc,
mkRecFldSelOcc,
-- ** Deconstruction
occNameFS, occNameString, occNameSpace,
......@@ -106,6 +107,7 @@ import DynFlags
import UniqFM
import UniqSet
import FastString
import FastStringEnv
import Outputable
import Lexeme
import Binary
......@@ -113,29 +115,6 @@ import Module
import Data.Char
import Data.Data
{-
************************************************************************
* *
FastStringEnv
* *
************************************************************************
FastStringEnv can't be in FastString because the env depends on UniqFM
-}
type FastStringEnv a = UniqFM a -- Keyed by FastString
emptyFsEnv :: FastStringEnv a
lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
mkFsEnv :: [(FastString,a)] -> FastStringEnv a
emptyFsEnv = emptyUFM
lookupFsEnv = lookupUFM
extendFsEnv = addToUFM
mkFsEnv = listToUFM
{-
************************************************************************
* *
......@@ -686,6 +665,10 @@ mkPDatasTyConOcc = mk_simple_deriv_with tcName "VPs:"
mkPDataDataConOcc = mk_simple_deriv_with dataName "VPD:"
mkPDatasDataConOcc = mk_simple_deriv_with dataName "VPDs:"
-- Overloaded record field selectors
mkRecFldSelOcc :: String -> OccName
mkRecFldSelOcc = mk_deriv varName "$sel"
mk_simple_deriv :: NameSpace -> String -> OccName -> OccName
mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
......
......@@ -44,9 +44,9 @@ module RdrName (
-- * Global mapping of 'RdrName' to 'GlobalRdrElt's
GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
lookupGlobalRdrEnv, extendGlobalRdrEnv, shadowNames,
lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames,
pprGlobalRdrEnv, globalRdrEnvElts,
lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
lookupGRE_RdrName, lookupGRE_Name, lookupGRE_Field_Name, getGRE_NameQualifier_maybes,
transformGREs, pickGREs,
-- * GlobalRdrElts
......@@ -54,7 +54,8 @@ module RdrName (
greUsedRdrName, greRdrNames, greSrcSpan, greQualModName,
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
GlobalRdrElt(..), isLocalGRE, isRecFldGRE, greLabel,
unQualOK, qualSpecOK, unQualSpecOK,
pprNameProvenance,
Parent(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
......@@ -70,6 +71,7 @@ import NameSet
import Maybes
import SrcLoc
import FastString
import FieldLabel
import Outputable
import Unique
import Util
......@@ -421,25 +423,34 @@ data GlobalRdrElt
-- | The children of a Name are the things that are abbreviated by the ".."
-- notation in export lists. See Note [Parents]
data Parent = NoParent | ParentIs Name
deriving (Eq)
data Parent = NoParent
| ParentIs { par_is :: Name }
| FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString }
-- ^ See Note [Parents for record fields]
deriving (Eq)
instance Outputable Parent where
ppr NoParent = empty
ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
ppr NoParent = empty
ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
ppr (FldParent n f) = ptext (sLit "fldparent:")
<> ppr n <> colon <> ppr f
plusParent :: Parent -> Parent -> Parent
-- See Note [Combining parents]
plusParent (ParentIs n) p2 = hasParent n p2
plusParent p1 (ParentIs n) = hasParent n p1
plusParent _ _ = NoParent
plusParent p1@(ParentIs _) p2 = hasParent p1 p2
plusParent p1@(FldParent _ _) p2 = hasParent p1 p2
plusParent p1 p2@(ParentIs _) = hasParent p2 p1
plusParent p1 p2@(FldParent _ _) = hasParent p2 p1
plusParent NoParent NoParent = NoParent
hasParent :: Name -> Parent -> Parent
hasParent :: Parent -> Parent -> Parent
#ifdef DEBUG
hasParent n (ParentIs n')
| n /= n' = pprPanic "hasParent" (ppr n <+> ppr n') -- Parents should agree
hasParent p NoParent = p
hasParent p p'
| p /= p' = pprPanic "hasParent" (ppr p <+> ppr p') -- Parents should agree
#endif
hasParent n _ = ParentIs n
hasParent p _ = p
{- Note [GlobalRdrElt provenance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -480,6 +491,34 @@ Note [Parents]
class C Class operations
Associated type constructors
Note [Parents for record fields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For record fields, in addition to the Name of the type constructor
(stored in par_is), we use FldParent to store the field label. This
extra information is used for identifying overloaded record fields
during renaming.
In a definition arising from a normal module (without
-XDuplicateRecordFields), par_lbl will be Nothing, meaning that the
field's label is the same as the OccName of the selector's Name. The
GlobalRdrEnv will contain an entry like this:
"x" |-> GRE x (FldParent T Nothing) LocalDef
When -XDuplicateRecordFields is enabled for the module that contains
T, the selector's Name will be mangled (see comments in FieldLabel).
Thus we store the actual field label in par_lbl, and the GlobalRdrEnv
entry looks like this:
"x" |-> GRE $sel:x:MkT (FldParent T (Just "x")) LocalDef
Note that the OccName used when adding a GRE to the environment
(greOccName) now depends on the parent field: for FldParent it is the
field label, if present, rather than the selector name.
Note [Combining parents]
~~~~~~~~~~~~~~~~~~~~~~~~
With an associated type we might have
......@@ -522,7 +561,7 @@ localGREsFromAvail = gresFromAvail (const Nothing)
gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= map mk_gre (availNames avail)
= map mk_gre (availNonFldNames avail) ++ map mk_fld_gre (availFlds avail)
where
mk_gre n
= case prov_fn n of -- Nothing => bound locally
......@@ -532,6 +571,18 @@ gresFromAvail prov_fn avail
Just is -> GRE { gre_name = n, gre_par = mkParent n avail
, gre_lcl = False, gre_imp = [is] }
mk_fld_gre (FieldLabel lbl is_overloaded n)
= case prov_fn n of -- Nothing => bound locally
-- Just is => imported from 'is'
Nothing -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl
, gre_lcl = True, gre_imp = [] }
Just is -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl
, gre_lcl = False, gre_imp = [is] }
where
mb_lbl | is_overloaded = Just lbl
| otherwise = Nothing
greQualModName :: GlobalRdrElt -> ModuleName
-- Get a suitable module qualifier for the GRE
-- (used in mkPrintUnqualified)
......@@ -546,13 +597,13 @@ greUsedRdrName :: GlobalRdrElt -> RdrName
-- used-RdrName set, which is used to generate
-- unused-import-decl warnings
-- Return an Unqual if possible, otherwise any Qual
greUsedRdrName GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss }
greUsedRdrName gre@GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss }
| lcl = Unqual occ
| not (all (is_qual . is_decl) iss) = Unqual occ
| (is:_) <- iss = Qual (is_as (is_decl is)) occ
| otherwise = pprPanic "greRdrName" (ppr name)
where
occ = nameOccName name
occ = greOccName gre
greRdrNames :: GlobalRdrElt -> [RdrName]
greRdrNames GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss }
......@@ -577,16 +628,18 @@ greSrcSpan gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss } )
| otherwise = pprPanic "greSrcSpan" (ppr gre)
mkParent :: Name -> AvailInfo -> Parent
mkParent _ (Avail _) = NoParent
mkParent n (AvailTC m _) | n == m = NoParent
| otherwise = ParentIs m
mkParent _ (Avail _) = NoParent
mkParent n (AvailTC m _ _) | n == m = NoParent
| otherwise = ParentIs m
availFromGRE :: GlobalRdrElt -> AvailInfo
availFromGRE gre
= case gre_par gre of
ParentIs p -> AvailTC p [me]
NoParent | isTyConName me -> AvailTC me [me]
ParentIs p -> AvailTC p [me] []
NoParent | isTyConName me -> AvailTC me [me] []
| otherwise -> Avail me
FldParent p Nothing -> AvailTC p [] [FieldLabel (occNameFS $ nameOccName me) False me]
FldParent p (Just lbl) -> AvailTC p [] [FieldLabel lbl True me]
where
me = gre_name gre
......@@ -621,6 +674,11 @@ lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
Nothing -> []
Just gres -> gres
greOccName :: GlobalRdrElt -> OccName
greOccName (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = mkVarOccFS lbl
greOccName gre = nameOccName (gre_name gre)
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
= case lookupOccEnv env (rdrNameOcc rdr_name) of
......@@ -632,6 +690,14 @@ lookupGRE_Name env name
= [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
gre_name gre == name ]
lookupGRE_Field_Name :: GlobalRdrEnv -> Name -> FastString -> [GlobalRdrElt]
-- Used when looking up record fields, where the selector name and
-- field label are different: the GlobalRdrEnv is keyed on the label
lookupGRE_Field_Name env sel_name lbl
= [ gre | gre <- lookupGlobalRdrEnv env (mkVarOccFS lbl),
gre_name gre == sel_name ]
getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
-- Returns all the qualifiers by which 'x' is in scope
-- Nothing means "the unqualified version is in scope"
......@@ -646,6 +712,16 @@ getGRE_NameQualifier_maybes env
isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE (GRE {gre_lcl = lcl }) = lcl
isRecFldGRE :: GlobalRdrElt -> Bool
isRecFldGRE (GRE {gre_par = FldParent{}}) = True
isRecFldGRE _ = False
-- Returns the field label of this GRE, if it has one
greLabel :: GlobalRdrElt -> Maybe FieldLabelString
greLabel (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = Just lbl
greLabel (GRE{gre_name = n, gre_par = FldParent{}}) = Just (occNameFS (nameOccName n))