diff options
Diffstat (limited to 'compiler/basicTypes')
| -rw-r--r-- | compiler/basicTypes/Avail.hs | 38 | ||||
| -rw-r--r-- | compiler/basicTypes/RdrName.hs | 26 |
2 files changed, 22 insertions, 42 deletions
diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs index 9595abc3ff..6999b1d34f 100644 --- a/compiler/basicTypes/Avail.hs +++ b/compiler/basicTypes/Avail.hs @@ -5,9 +5,7 @@ module Avail ( Avails, AvailInfo(..), - IsPatSyn(..), avail, - patSynAvail, availsToNameSet, availsToNameSetWithSelectors, availsToNameEnv, @@ -32,7 +30,7 @@ import Data.Function -- The AvailInfo type -- | Records what things are "available", i.e. in scope -data AvailInfo = Avail IsPatSyn Name -- ^ An ordinary identifier in scope +data AvailInfo = Avail Name -- ^ An ordinary identifier in scope | AvailTC Name [Name] [FieldLabel] @@ -53,8 +51,6 @@ data AvailInfo = Avail IsPatSyn Name -- ^ An ordinary identifier in scope -- Equality used when deciding if the -- interface has changed -data IsPatSyn = NotPatSyn | IsPatSyn deriving Eq - -- | A collection of 'AvailInfo' - several things that are \"available\" type Avails = [AvailInfo] @@ -108,7 +104,7 @@ modules. -- | Compare lexicographically stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering -stableAvailCmp (Avail _ n1) (Avail _ n2) = n1 `stableNameCmp` n2 +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` @@ -116,11 +112,8 @@ stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) = (cmpList (stableNameCmp `on` flSelector) nfs mfs) stableAvailCmp (AvailTC {}) (Avail {}) = GT -patSynAvail :: Name -> AvailInfo -patSynAvail n = Avail IsPatSyn n - avail :: Name -> AvailInfo -avail n = Avail NotPatSyn n +avail n = Avail n -- ----------------------------------------------------------------------------- -- Operations on AvailInfo @@ -141,22 +134,22 @@ 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 (Avail n) = n availName (AvailTC n _ _) = n -- | All names made available by the availability information (excluding overloaded selectors) availNames :: AvailInfo -> [Name] -availNames (Avail _ n) = [n] +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 (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 (Avail n) = [n] availNonFldNames (AvailTC _ ns _) = ns -- | Fields made available by the availability information @@ -171,14 +164,13 @@ instance Outputable AvailInfo where ppr = pprAvail pprAvail :: AvailInfo -> SDoc -pprAvail (Avail _ n) = ppr n +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 b aa) = do + put_ bh (Avail aa) = do putByte bh 0 put_ bh aa - put_ bh b put_ bh (AvailTC ab ac ad) = do putByte bh 1 put_ bh ab @@ -188,18 +180,8 @@ instance Binary AvailInfo where h <- getByte bh case h of 0 -> do aa <- get bh - b <- get bh - return (Avail b aa) + return (Avail aa) _ -> do ab <- get bh ac <- get bh ad <- get bh return (AvailTC ab ac ad) - -instance Binary IsPatSyn where - put_ bh IsPatSyn = putByte bh 0 - put_ bh NotPatSyn = putByte bh 1 - get bh = do - h <- getByte bh - case h of - 0 -> return IsPatSyn - _ -> return NotPatSyn diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 0856597805..126c322a44 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -450,15 +450,13 @@ data Parent = NoParent | ParentIs { par_is :: Name } | FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString } -- ^ See Note [Parents for record fields] - | PatternSynonym - deriving (Eq, Data) + deriving (Eq, Data, Typeable) instance Outputable Parent where ppr NoParent = empty ppr (ParentIs n) = text "parent:" <> ppr n ppr (FldParent n f) = text "fldparent:" <> ppr n <> colon <> ppr f - ppr (PatternSynonym) = text "pattern synonym" plusParent :: Parent -> Parent -> Parent -- See Note [Combining parents] @@ -466,7 +464,6 @@ 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 PatternSynonym PatternSynonym = PatternSynonym plusParent _ _ = NoParent hasParent :: Parent -> Parent -> Parent @@ -517,19 +514,12 @@ Note [Parents] class C Class operations Associated type constructors -The `PatternSynonym` constructor is so called as pattern synonyms can be -bundled with any type constructor (during renaming). In other words, they can -have any parent. - ~~~~~~~~~~~~~~~~~~~~~~~~~ Constructor Meaning ~~~~~~~~~~~~~~~~~~~~~~~~ NoParent Can not be bundled with a type constructor. ParentIs n Can be bundled with the type constructor corresponding to n. - PatternSynonym Can be bundled with any type constructor. It is so called - because only pattern synonyms can be bundled with any type - constructor. FldParent See Note [Parents for record fields] @@ -560,6 +550,16 @@ 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. +~~ + +Record pattern synonym selectors are treated differently. Their parent +information is `NoParent` in the module in which they are defined. This is because +a pattern synonym `P` has no parent constructor either. + +However, if `f` is bundled with a type constructor `T` then whenever `f` is +imported the parent will use the `Parent` constructor so the parent of `f` is +now `T`. + Note [Combining parents] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -670,15 +670,13 @@ greSrcSpan gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss } ) | otherwise = pprPanic "greSrcSpan" (ppr gre) mkParent :: Name -> AvailInfo -> Parent -mkParent _ (Avail NotPatSyn _) = NoParent -mkParent _ (Avail IsPatSyn _) = PatternSynonym +mkParent _ (Avail _) = NoParent mkParent n (AvailTC m _ _) | n == m = NoParent | otherwise = ParentIs m availFromGRE :: GlobalRdrElt -> AvailInfo availFromGRE (GRE { gre_name = me, gre_par = parent }) = case parent of - PatternSynonym -> patSynAvail me ParentIs p -> AvailTC p [me] [] NoParent | isTyConName me -> AvailTC me [me] [] | otherwise -> avail me |