Commit 39a262e5 authored by Austin Seipp's avatar Austin Seipp

Revert "reify associated types when reifying typeclasses"

This caused the build to fail, due to some type checking errors. Whoops.

This reverts commit 5c115236.
parent 5c115236
......@@ -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.
......
{-# 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''
[| () |])
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
......@@ -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
......
......@@ -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'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment