[commit: ghc] ghc-8.2: Typeable: Ensure that promoted data family instance tycons get bindings (7252493)

git at git.haskell.org git at git.haskell.org
Thu Jul 20 12:33:05 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/725249344e28a58d2d827f38e630d0506f4e49cf/ghc

>---------------------------------------------------------------

commit 725249344e28a58d2d827f38e630d0506f4e49cf
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Wed Jul 19 19:33:00 2017 -0400

    Typeable: Ensure that promoted data family instance tycons get bindings
    
    This fixes #13915, where the promoted tycons belonging to data family
    instances wouldn't get Typeable bindings, resulting in missing
    declarations.
    
    Test Plan: Validate with included testcases
    
    Reviewers: austin, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: simonpj, RyanGlScott, rwbarton, thomie
    
    GHC Trac Issues: #13915
    
    Differential Revision: https://phabricator.haskell.org/D3759
    
    (cherry picked from commit cc839c57ff9c80b50d39e8e2e66a18674bab3486)


>---------------------------------------------------------------

725249344e28a58d2d827f38e630d0506f4e49cf
 compiler/typecheck/TcEnv.hs                                   | 11 +++++++----
 compiler/typecheck/TcRnTypes.hs                               |  3 ++-
 compiler/typecheck/TcTypeable.hs                              |  8 ++++----
 testsuite/tests/perf/compiler/all.T                           |  3 ++-
 testsuite/tests/typecheck/should_compile/T13915a.hs           |  7 +++++++
 .../T11164b.hs => typecheck/should_compile/T13915a_Foo.hs}    |  5 ++---
 testsuite/tests/typecheck/should_compile/T13915b.hs           | 11 +++++++++++
 testsuite/tests/typecheck/should_compile/all.T                |  2 ++
 8 files changed, 37 insertions(+), 13 deletions(-)

diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs
index b69d1a6..6f02872 100644
--- a/compiler/typecheck/TcEnv.hs
+++ b/compiler/typecheck/TcEnv.hs
@@ -625,15 +625,18 @@ Consider
   data S = MkS (Proxy 'MkT)
 
 Is it ok to use the promoted data family instance constructor 'MkT' in
-the data declaration for S?  No, we don't allow this. It *might* make
-sense, but at least it would mean that we'd have to interleave
-typechecking instances and data types, whereas at present we do data
-types *then* instances.
+the data declaration for S (where both declarations live in the same module)?
+No, we don't allow this. It *might* make sense, but at least it would mean that
+we'd have to interleave typechecking instances and data types, whereas at
+present we do data types *then* instances.
 
 So to check for this we put in the TcLclEnv a binding for all the family
 constructors, bound to AFamDataCon, so that if we trip over 'MkT' when
 type checking 'S' we'll produce a decent error message.
 
+Trac #12088 describes this limitation. Of course, when MkT and S live in
+different modules then all is well.
+
 Note [Don't promote pattern synonyms]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We never promote pattern synonyms.
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 882198f..10fd4e8 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -1047,7 +1047,8 @@ data PromotionErr
   | ClassPE          -- Ditto Class
 
   | FamDataConPE     -- Data constructor for a data family
-                     -- See Note [AFamDataCon: not promoting data family constructors] in TcRnDriver
+                     -- See Note [AFamDataCon: not promoting data family constructors]
+                     -- in TcEnv.
   | PatSynPE         -- Pattern synonyms
                      -- See Note [Don't promote pattern synonyms] in TcEnv
 
diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs
index 76d262c..ff0fb66 100644
--- a/compiler/typecheck/TcTypeable.hs
+++ b/compiler/typecheck/TcTypeable.hs
@@ -169,7 +169,7 @@ mkTypeableBinds
       | tc `elem` [runtimeRepTyCon, vecCountTyCon, vecElemTyCon]
       = False
       | otherwise =
-          (not (isFamInstTyCon tc) && isAlgTyCon tc)
+          isAlgTyCon tc
        || isDataFamilyTyCon tc
        || isClassTyCon tc
 
@@ -242,12 +242,12 @@ todoForTyCons mod mod_id tycons = do
                             }
             | tc     <- tycons
             , tc'    <- tc : tyConATs tc
-              -- If the tycon itself isn't typeable then we needn't look
-              -- at its promoted datacons as their kinds aren't Typeable
-            , Just _ <- pure $ tyConRepName_maybe tc'
               -- We need type representations for any associated types
             , let promoted = map promoteDataCon (tyConDataCons tc')
             , tc''   <- tc' : promoted
+              -- Don't make bindings for data-family instance tycons.
+              -- Do, however, make them for their promoted datacon (see #13915).
+            , not $ isFamInstTyCon tc''
             , Just rep_name <- pure $ tyConRepName_maybe tc''
             , typeIsTypeable $ dropForAlls $ tyConKind tc''
             ]
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 281615a..6fbde0d 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1043,13 +1043,14 @@ test('T12234',
 test('T13035',
      [ only_ways(['normal']),
        compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 93249744, 5),
+          [(wordsize(64), 118665640, 5),
           # 2017-01-05   90595208  initial
           # 2017-01-19   95269000  Allow top-level string literals in Core
           # 2017-02-05   88806416  Probably OccAnal fixes
           # 2017-02-17   103890200 Type-indexed Typeable
           # 2017-02-25   98390488  Early inline patch
           # 2017-03-21   93249744  It's unclear
+          # 2017-07-19   118665640 Generate Typeable bindings for data instances
           ]),
      ],
      compile,
diff --git a/testsuite/tests/typecheck/should_compile/T13915a.hs b/testsuite/tests/typecheck/should_compile/T13915a.hs
new file mode 100644
index 0000000..484c9de
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13915a.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeInType #-}
+module Bug where
+
+import T13915a_Foo
+
+data Proxy (a :: k)
+data S = MkS (Proxy 'MkT)
diff --git a/testsuite/tests/rename/should_compile/T11164b.hs b/testsuite/tests/typecheck/should_compile/T13915a_Foo.hs
similarity index 58%
copy from testsuite/tests/rename/should_compile/T11164b.hs
copy to testsuite/tests/typecheck/should_compile/T13915a_Foo.hs
index abe65c4..1b5fd81 100644
--- a/testsuite/tests/rename/should_compile/T11164b.hs
+++ b/testsuite/tests/typecheck/should_compile/T13915a_Foo.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE TypeFamilies #-}
-module T11164b where
-
-import T11164a
+module T13915a_Foo where
 
+data family T a
 data instance T Int = MkT
diff --git a/testsuite/tests/typecheck/should_compile/T13915b.hs b/testsuite/tests/typecheck/should_compile/T13915b.hs
new file mode 100644
index 0000000..dd64b13
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13915b.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+module Foo where
+
+import Data.Typeable (Proxy(..), typeRep)
+
+data family T a
+data instance T Int = MkT
+
+main :: IO ()
+main = print $ typeRep (Proxy :: Proxy MkT)
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 7f72b03..c33f66f 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -558,3 +558,5 @@ test('T13804', normal, compile, [''])
 test('T13871', normal, compile, [''])
 test('T13879', normal, compile, [''])
 test('T13881', normal, compile, [''])
+test('T13915a', normal, multimod_compile, ['T13915a', '-v0'])
+test('T13915b', normal, compile, [''])



More information about the ghc-commits mailing list