diff options
author | Austin Seipp <austin@well-typed.com> | 2015-09-23 18:12:14 -0500 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2015-09-23 18:12:55 -0500 |
commit | 39a262e53bab3b7cf827fa9f22226da5fca055be (patch) | |
tree | 8d914400c56aaed9d664877968890429f7413ba3 | |
parent | 5c115236fe795aa01f0c10106f1b1c959486a739 (diff) | |
download | haskell-39a262e53bab3b7cf827fa9f22226da5fca055be.tar.gz |
Revert "reify associated types when reifying typeclasses"
This caused the build to fail, due to some type checking errors. Whoops.
This reverts commit 5c115236fe795aa01f0c10106f1b1c959486a739.
-rw-r--r-- | compiler/typecheck/TcSplice.hs | 28 | ||||
-rw-r--r-- | testsuite/tests/th/T10891.hs | 39 | ||||
-rw-r--r-- | testsuite/tests/th/T10891.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/th/TH_reifyDecl1.stderr | 2 | ||||
-rw-r--r-- | 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 a07d80b9a3..2a21705c77 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 d91caf94f6..0000000000 --- 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 874f4f0890..0000000000 --- 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 e65558774a..503f5331f0 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 9d4736c10f..f72cc30f81 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']) |