[commit: ghc] wip/ghc-8.8-merges: Uphold AvailTC Invariant for associated data fams (a0cd486)
git at git.haskell.org
git at git.haskell.org
Thu Feb 21 15:08:07 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/ghc-8.8-merges
Link : http://ghc.haskell.org/trac/ghc/changeset/a0cd486ebb1ba14392c0ab60b0ef377ec767703c/ghc
>---------------------------------------------------------------
commit a0cd486ebb1ba14392c0ab60b0ef377ec767703c
Author: Alec Theriault <alec.theriault at gmail.com>
Date: Fri Feb 1 16:26:43 2019 -0800
Uphold AvailTC Invariant for associated data fams
The AvailTC was not be upheld for explicit export module
export lists when the module contains associated data families.
module A (module A) where
class C a where { data T a }
instance C () where { data T () = D }
Used to (incorrectly) report avails as `[C{C, T;}, T{D;}]`. Note that
although `T` is exported, the avail where it is the parent does _not_
list it as its first element. This avail is now correctly listed as
`[C{C, T;}, T{T, D;}]`.
This was induces a [crash in Haddock][0].
See #16077.
[0]: https://github.com/haskell/haddock/issues/979
>---------------------------------------------------------------
a0cd486ebb1ba14392c0ab60b0ef377ec767703c
compiler/basicTypes/Avail.hs | 42 +++++++++++++++----------------
compiler/typecheck/TcRnExports.hs | 52 +++++++++++++++++++++++++++++++++++----
2 files changed, 68 insertions(+), 26 deletions(-)
diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs
index cefa934..291c95a 100644
--- a/compiler/basicTypes/Avail.hs
+++ b/compiler/basicTypes/Avail.hs
@@ -47,27 +47,27 @@ 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]
- [FieldLabel]
- -- ^ A type or class in scope. Parameters:
- --
- -- 1) The name of the 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
- -- to be in scope, it must be
- -- *first* in this list. Thus,
- -- typically: @AvailTC Eq [Eq, ==, \/=]@
- deriving( Eq, Data )
- -- Equality used when deciding if the
- -- interface has changed
+-- | Records what things are \"available\", i.e. in scope
+data AvailInfo
+
+ -- | An ordinary identifier in scope
+ = Avail Name
+
+ -- | A type or class in scope
+ --
+ -- The __AvailTC Invariant__: If the type or class is itself to be in scope,
+ -- it must be /first/ in this list. Thus, typically:
+ --
+ -- > AvailTC Eq [Eq, ==, \/=] []
+ | AvailTC
+ Name -- ^ The name of the type or class
+ [Name] -- ^ The available pieces of type or class,
+ -- excluding field selectors.
+ [FieldLabel] -- ^ The record fields of the type
+ -- (see Note [Representing fields in AvailInfo]).
+
+ deriving ( Eq -- ^ Used when deciding if the interface has changed
+ , Data )
-- | A collection of 'AvailInfo' - several things that are \"available\"
type Avails = [AvailInfo]
diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs
index 28c1773..b3baf6c 100644
--- a/compiler/typecheck/TcRnExports.hs
+++ b/compiler/typecheck/TcRnExports.hs
@@ -89,6 +89,41 @@ At one point I implemented a compromise:
But the compromise seemed too much of a hack, so we backed it out.
You just have to use an explicit export list:
module M( F(..) ) where ...
+
+Note [Avails of associated data families]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose you have (Trac #16077)
+
+ {-# LANGUAGE TypeFamilies #-}
+ module A (module A) where
+
+ class C a where { data T a }
+ instance C () where { data T () = D }
+
+Because @A@ is exported explicitly, GHC tries to produce an export list
+from the @GlobalRdrEnv at . In this case, it pulls out the following:
+
+ [ C defined at A.hs:4:1
+ , T parent:C defined at A.hs:4:23
+ , D parent:T defined at A.hs:5:35 ]
+
+If map these directly into avails, (via 'availFromGRE'), we get
+@[C{C;}, C{T;}, T{D;}]@, which eventually gets merged into @[C{C, T;}, T{D;}]@.
+That's not right, because @T{D;}@ violates the AvailTC invariant: @T@ is
+exported, but it isn't the first entry in the avail!
+
+We work around this issue by expanding GREs where the parent and child
+are both type constructors into two GRES.
+
+ T parent:C defined at A.hs:4:23
+
+ =>
+
+ [ T parent:C defined at A.hs:4:23
+ , T defined at A.hs:4:23 ]
+
+Then, we get @[C{C;}, C{T;}, T{T;}, T{D;}]@, which eventually gets merged
+into @[C{C, T;}, T{T, D;}]@ (which satsifies the AvailTC invariant).
-}
data ExportAccum -- The type of the accumulating parameter of
@@ -175,12 +210,12 @@ tcRnExports explicit_mod exports
; return new_tcg_env }
exports_from_avail :: Maybe (Located [LIE GhcPs])
- -- Nothing => no explicit export list
+ -- ^ 'Nothing' means no explicit export list
-> GlobalRdrEnv
-> ImportAvails
- -- Imported modules; this is used to test if a
- -- 'module Foo' export is valid (it's not valid
- -- if we didn't import Foo!)
+ -- ^ Imported modules; this is used to test if a
+ -- @module Foo@ export is valid (it's not valid
+ -- if we didn't import @Foo@!)
-> Module
-> RnM (Maybe [(LIE GhcRn, Avails)], Avails)
-- (Nothing, _) <=> no explicit export list
@@ -230,6 +265,11 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod
kids_env :: NameEnv [GlobalRdrElt]
kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
+ -- See Note [Avails of associated data families]
+ expand_tyty_gre :: GlobalRdrElt -> [GlobalRdrElt]
+ expand_tyty_gre (gre @ GRE { gre_name = me, gre_par = ParentIs p })
+ | isTyConName p, isTyConName me = [gre, gre{ gre_par = NoParent }]
+ expand_tyty_gre gre = [gre]
imported_modules = [ imv_name imv
| xs <- moduleEnvElts $ imp_mods imports
@@ -248,7 +288,9 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod
= do { let { exportValid = (mod `elem` imported_modules)
|| (moduleName this_mod == mod)
; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
- ; new_exports = map (availFromGRE . fst) gre_prs
+ ; new_exports = [ availFromGRE gre'
+ | (gre, _) <- gre_prs
+ , gre' <- expand_tyty_gre gre ]
; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
; mods = addOneToUniqSet earlier_mods mod
}
More information about the ghc-commits
mailing list