[commit: ghc] master: Revert "reify associated types when reifying typeclasses" (39a262e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/39a262e53bab3b7cf827fa9f22226da5fca055be/ghc

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

commit 39a262e53bab3b7cf827fa9f22226da5fca055be
Author: Austin Seipp <austin at well-typed.com>
Date:   Wed Sep 23 18:12:14 2015 -0500

    Revert "reify associated types when reifying typeclasses"
    
    This caused the build to fail, due to some type checking errors. Whoops.
    
    This reverts commit 5c115236fe795aa01f0c10106f1b1c959486a739.


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

39a262e53bab3b7cf827fa9f22226da5fca055be
 compiler/typecheck/TcSplice.hs          | 28 ++---------------------
 testsuite/tests/th/T10891.hs            | 39 ---------------------------------
 testsuite/tests/th/T10891.stderr        | 12 ----------
 testsuite/tests/th/TH_reifyDecl1.stderr |  2 --
 testsuite/tests/th/all.T                |  1 -
 5 files changed, 2 insertions(+), 80 deletions(-)

diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index a07d80b..2a21705 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1202,13 +1202,12 @@ reifyClass cls
   = do  { cxt <- reifyCxt theta
         ; inst_envs <- tcGetInstEnvs
         ; insts <- reifyClassInstances cls (InstEnv.classInstances inst_envs cls)
-        ; assocTys <- concatMapM reifyAT ats
         ; ops <- concatMapM reify_op op_stuff
         ; tvs' <- reifyTyVars tvs
-        ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' (assocTys ++ ops)
+        ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' ops
         ; return (TH.ClassI dec insts) }
   where
-    (tvs, fds, theta, _, ats, op_stuff) = classExtraBigSig cls
+    (tvs, fds, theta, _, _, op_stuff) = classExtraBigSig cls
     fds' = map reifyFunDep fds
     reify_op (op, def_meth)
       = do { ty <- reifyType (idType op)
@@ -1220,29 +1219,6 @@ reifyClass cls
                      ; return [TH.SigD nm' ty, TH.DefaultSigD nm' gdm_ty] }
                 _ -> return [TH.SigD nm' ty] }
 
-    reifyAT :: ClassATItem -> TcM [TH.Dec]
-    reifyAT (ATI tycon def) = do
-      tycon' <- reifyTyCon tycon
-      case tycon' of
-        TH.FamilyI dec _ -> do
-          let (tyName, tyArgs) = tfNames dec
-          (dec :) <$> maybe (return [])
-                            (fmap (:[]) . reifyDefImpl tyName tyArgs)
-                            def
-        _ -> pprPanic "reifyAT" (text (show tycon'))
-
-    reifyDefImpl :: TH.Name -> [TH.Name] -> Type -> TcM TH.Dec
-    reifyDefImpl n args ty =
-      TH.TySynInstD n . TH.TySynEqn (map TH.VarT args) <$> reifyType ty
-
-    tfNames :: TH.Dec -> (TH.Name, [TH.Name])
-    tfNames (TH.OpenTypeFamilyD   n args _ _)   = (n, map bndrName args)
-    tfNames d = pprPanic "tfNames" (text (show d))
-
-    bndrName :: TH.TyVarBndr -> TH.Name
-    bndrName (TH.PlainTV n)    = n
-    bndrName (TH.KindedTV n _) = n
-
 ------------------------------
 -- | Annotate (with TH.SigT) a type if the first parameter is True
 -- and if the type contains a free variable.
diff --git a/testsuite/tests/th/T10891.hs b/testsuite/tests/th/T10891.hs
deleted file mode 100644
index d91caf9..0000000
--- a/testsuite/tests/th/T10891.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-
-module T10891 where
-
-import Language.Haskell.TH
-import System.IO
-
-class C a where
-  f :: a -> Int
-
-class C' a where
-  type F a :: *
-  type F a = a
-  f' :: a -> Int
-
-class C'' a where
-  data Fd a :: *
-
-instance C' Int where
-  type F Int = Bool
-  f' = id
-
-instance C'' Int where
-  data Fd Int = B Bool | C Char
-
-$(return [])
-
-test :: ()
-test =
-  $(let
-      display :: Name -> Q ()
-      display q = do
-        i <- reify q
-        runIO (hPutStrLn stderr (pprint i) >> hFlush stderr)
-    in do
-      display ''C
-      display ''C'
-      display ''C''
-      [| () |])
diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr
deleted file mode 100644
index 874f4f0..0000000
--- a/testsuite/tests/th/T10891.stderr
+++ /dev/null
@@ -1,12 +0,0 @@
-class T10891.C (a_0 :: *)
-    where T10891.f :: forall (a_0 :: *) . T10891.C a_0 =>
-                                          a_0 -> GHC.Types.Int
-class T10891.C' (a_0 :: *)
-    where type T10891.F (a_0 :: *) :: *
-          type T10891.F a_0 = a_0
-          T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 =>
-                                           a_0 -> GHC.Types.Int
-instance T10891.C' GHC.Types.Int
-class T10891.C'' (a_0 :: *)
-    where data T10891.Fd (a_0 :: *) :: *
-instance T10891.C'' GHC.Types.Int
diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr
index e655587..503f533 100644
--- a/testsuite/tests/th/TH_reifyDecl1.stderr
+++ b/testsuite/tests/th/TH_reifyDecl1.stderr
@@ -20,8 +20,6 @@ class TH_reifyDecl1.C2 (a_0 :: *)
                                                   a_0 -> GHC.Types.Int
 instance TH_reifyDecl1.C2 GHC.Types.Int
 class TH_reifyDecl1.C3 (a_0 :: *)
-    where type TH_reifyDecl1.AT1 (a_0 :: *) :: *
-          data TH_reifyDecl1.AT2 (a_0 :: *) :: *
 instance TH_reifyDecl1.C3 GHC.Types.Int
 type family TH_reifyDecl1.AT1 (a_0 :: *) :: *
 type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 9d4736c..f72cc30 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -359,4 +359,3 @@ test('T6018th', normal, compile_fail, ['-v0'])
 test('TH_namePackage', normal, compile_and_run, ['-v0'])
 test('T10811', normal, compile, ['-v0'])
 test('T10810', normal, compile, ['-v0'])
-test('T10891', normal, compile, ['-v0'])