Properly represent abstract classes in Class and IfaceDecl

Summary:
Previously, abstract classes looked very much like normal
classes, except that they happened to have no methods,
superclasses or ATs, and they came from boot files.  This
patch gives abstract classes a proper representation in
Class and IfaceDecl, by moving the things which are never
defined for abstract classes into ClassBody/IfaceClassBody.

Because Class is abstract, this change had ~no disruption
to any of the code in GHC; if you ask about the methods of
an abstract class, we'll just give you an empty list.

This also fixes a bug where abstract type classes were incorrectly
treated as representationally injective (they're not!)

Fixes #13347, and a TODO in the code.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, bgamari, austin

Subscribers: goldfire, thomie

Differential Revision: https://phabricator.haskell.org/D3236

14 files changed, 315 insertions, 129 deletions

diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index 7696d5f075..2e738c1ec6 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -451,15 +451,11 @@ rnIfaceDecl d@IfaceFamily{} = do
                      }
 rnIfaceDecl d@IfaceClass{} = do
             name <- rnIfaceGlobal (ifName d)
-            ctxt <- mapM rnIfaceType (ifCtxt d)
             binders <- mapM rnIfaceTyConBinder (ifBinders d)
-            ats <- mapM rnIfaceAT (ifATs d)
-            sigs <- mapM rnIfaceClassOp (ifSigs d)
-            return d { ifName = name
-                     , ifCtxt = ctxt
+            body <- rnIfaceClassBody (ifBody d)
+            return d { ifName    = name
                      , ifBinders = binders
-                     , ifATs = ats
-                     , ifSigs = sigs
+                     , ifBody    = body
                      }
 rnIfaceDecl d@IfaceAxiom{} = do
             name <- rnIfaceNeverExported (ifName d)
@@ -491,6 +487,14 @@ rnIfaceDecl d@IfacePatSyn{} =  do
                      , ifPatTy = pat_ty
                      }
 
+rnIfaceClassBody :: Rename IfaceClassBody
+rnIfaceClassBody IfAbstractClass = return IfAbstractClass
+rnIfaceClassBody d@IfConcreteClass{} = do
+    ctxt <- mapM rnIfaceType (ifClassCtxt d)
+    ats <- mapM rnIfaceAT (ifATs d)
+    sigs <- mapM rnIfaceClassOp (ifSigs d)
+    return d { ifClassCtxt = ctxt, ifATs = ats, ifSigs = sigs }
+
 rnIfaceFamTyConFlav :: Rename IfaceFamTyConFlav
 rnIfaceFamTyConFlav (IfaceClosedSynFamilyTyCon (Just (n, axs)))
     = IfaceClosedSynFamilyTyCon . Just <$> ((,) <$> rnIfaceNeverExported n
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index b291bc53fd..76b7793859 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -298,15 +298,28 @@ type TcMethInfo     -- A temporary intermediate, to communicate
 
 buildClass :: Name  -- Name of the class/tycon (they have the same Name)
            -> [TyConBinder]                -- Of the tycon
-           -> [Role] -> ThetaType
+           -> [Role]
            -> [FunDep TyVar]               -- Functional dependencies
-           -> [ClassATItem]                -- Associated types
-           -> [TcMethInfo]                 -- Method info
-           -> ClassMinimalDef              -- Minimal complete definition
+           -- Super classes, associated types, method info, minimal complete def.
+           -- This is Nothing if the class is abstract.
+           -> Maybe (ThetaType, [ClassATItem], [TcMethInfo], ClassMinimalDef)
            -> TcRnIf m n Class
 
-buildClass tycon_name binders roles sc_theta
-           fds at_items sig_stuff mindef
+buildClass tycon_name binders roles fds Nothing
+  = fixM  $ \ rec_clas ->       -- Only name generation inside loop
+    do  { traceIf (text "buildClass")
+
+        ; tc_rep_name  <- newTyConRepName tycon_name
+        ; let univ_bndrs = mkDataConUnivTyVarBinders binders
+              univ_tvs   = binderVars univ_bndrs
+              tycon = mkClassTyCon tycon_name binders roles
+                                   AbstractTyCon rec_clas tc_rep_name
+              result = mkAbstractClass tycon_name univ_tvs fds tycon
+        ; traceIf (text "buildClass" <+> ppr tycon)
+        ; return result }
+
+buildClass tycon_name binders roles fds
+           (Just (sc_theta, at_items, sig_stuff, mindef))
   = fixM  $ \ rec_clas ->       -- Only name generation inside loop
     do  { traceIf (text "buildClass")
 
@@ -365,12 +378,14 @@ buildClass tycon_name binders roles sc_theta
                                    (mkTyConApp rec_tycon (mkTyVarTys univ_tvs))
                                    rec_tycon
 
-        ; rhs <- if use_newtype
-                 then mkNewTyConRhs tycon_name rec_tycon dict_con
-                 else if isCTupleTyConName tycon_name
-                 then return (TupleTyCon { data_con = dict_con
-                                         , tup_sort = ConstraintTuple })
-                 else return (mkDataTyConRhs [dict_con])
+        ; rhs <- case () of
+                  _ | use_newtype
+                    -> mkNewTyConRhs tycon_name rec_tycon dict_con
+                    | isCTupleTyConName tycon_name
+                    -> return (TupleTyCon { data_con = dict_con
+                                          , tup_sort = ConstraintTuple })
+                    | otherwise
+                    -> return (mkDataTyConRhs [dict_con])
 
         ; let { tycon = mkClassTyCon tycon_name binders roles
                                      rhs rec_clas tc_rep_name
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 5d9688e9a6..d73a738786 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -15,6 +15,7 @@ module IfaceSyn (
         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
         IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
+        IfaceClassBody(..),
         IfaceBang(..),
         IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
         IfaceAxBranch(..),
@@ -138,14 +139,11 @@ data IfaceDecl
                    ifFamFlav :: IfaceFamTyConFlav,
                    ifFamInj  :: Injectivity }      -- injectivity information
 
-  | IfaceClass { ifCtxt    :: IfaceContext,             -- Superclasses
-                 ifName    :: IfaceTopBndr,             -- Name of the class TyCon
+  | IfaceClass { ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                  ifRoles   :: [Role],                   -- Roles
                  ifBinders :: [IfaceTyConBinder],
-                 ifFDs     :: [FunDep IfLclName],      -- Functional dependencies
-                 ifATs     :: [IfaceAT],                -- Associated type families
-                 ifSigs    :: [IfaceClassOp],           -- Method signatures
-                 ifMinDef  :: BooleanFormula IfLclName  -- Minimal complete definition
+                 ifFDs     :: [FunDep IfLclName],       -- Functional dependencies
+                 ifBody    :: IfaceClassBody            -- Methods, superclasses, ATs
     }
 
   | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
@@ -168,6 +166,17 @@ data IfaceDecl
                   ifPatTy         :: IfaceType,
                   ifFieldLabels   :: [FieldLabel] }
 
+-- See also 'ClassBody'
+data IfaceClassBody
+  -- Abstract classes don't specify their body; they only occur in @hs-boot@ and
+  -- @hsig@ files.
+  = IfAbstractClass
+  | IfConcreteClass {
+     ifClassCtxt :: IfaceContext,             -- Super classes
+     ifATs       :: [IfaceAT],                -- Associated type families
+     ifSigs      :: [IfaceClassOp],           -- Method signatures
+     ifMinDef    :: BooleanFormula IfLclName  -- Minimal complete definition
+    }
 
 data IfaceTyConParent
   = IfNoParent
@@ -389,10 +398,15 @@ ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
       IfNewTyCon  cd  -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd
       IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds
 
-ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt
-                                   , ifName = cls_tc_name
-                                   , ifSigs = sigs
-                                   , ifATs = ats })
+ifaceDeclImplicitBndrs (IfaceClass { ifBody = IfAbstractClass })
+  = []
+
+ifaceDeclImplicitBndrs (IfaceClass { ifName = cls_tc_name
+                                   , ifBody = IfConcreteClass {
+                                        ifClassCtxt = sc_ctxt,
+                                        ifSigs      = sigs,
+                                        ifATs       = ats
+                                     }})
   = --   (possibly) newtype coercion
     co_occs ++
     --    data constructor (DataCon namespace)
@@ -413,7 +427,7 @@ ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt
             | otherwise  = []
     dcww_occ = mkDataConWorkerOcc dc_occ
     dc_occ = mkClassDataConOcc cls_tc_occ
-    is_newtype = n_sigs + n_ctxt == 1 -- Sigh
+    is_newtype = n_sigs + n_ctxt == 1 -- Sigh (keep this synced with buildClass)
 
 ifaceDeclImplicitBndrs _ = []
 
@@ -663,6 +677,13 @@ isIfaceDataInstance :: IfaceTyConParent -> Bool
 isIfaceDataInstance IfNoParent = False
 isIfaceDataInstance _          = True
 
+pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
+pprClassRoles ss clas binders roles =
+    pprRoles (== Nominal)
+             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
+             binders
+             roles
+
 pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
 -- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
 --     See Note [Pretty-printing TyThings] in PprTyThing
@@ -718,17 +739,26 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
 
     pp_extra = vcat [pprCType ctype]
 
-
-pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs
-                            , ifCtxt   = context, ifName  = clas
+pprIfaceDecl ss (IfaceClass { ifName  = clas
                             , ifRoles = roles
-                            , ifFDs    = fds, ifMinDef = minDef
-                            , ifBinders = binders })
-  = vcat [ pprRoles
-             (== Nominal)
-             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
-             binders
-             roles
+                            , ifFDs    = fds
+                            , ifBinders = binders
+                            , ifBody = IfAbstractClass })
+  = vcat [ pprClassRoles ss clas binders roles
+         , text "class" <+> pprIfaceDeclHead [] ss clas binders Nothing
+                                <+> pprFundeps fds ]
+
+pprIfaceDecl ss (IfaceClass { ifName  = clas
+                            , ifRoles = roles
+                            , ifFDs    = fds
+                            , ifBinders = binders
+                            , ifBody = IfConcreteClass {
+                                ifATs = ats,
+                                ifSigs = sigs,
+                                ifClassCtxt = context,
+                                ifMinDef = minDef
+                              }})
+  = vcat [ pprClassRoles ss clas binders roles
          , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
                                 <+> pprFundeps fds <+> pp_where
          , nest 2 (vcat [ vcat asocs, vcat dsigs
@@ -1246,11 +1276,13 @@ freeNamesIfDecl d@IfaceFamily{} =
   freeNamesIfFamFlav (ifFamFlav d) &&&
   freeNamesIfTyVarBndrs (ifBinders d) &&&
   freeNamesIfKind (ifResKind d)
-freeNamesIfDecl d@IfaceClass{} =
-  freeNamesIfContext (ifCtxt d) &&&
+freeNamesIfDecl d@IfaceClass{ ifBody = IfAbstractClass } =
+  freeNamesIfTyVarBndrs (ifBinders d)
+freeNamesIfDecl d@IfaceClass{ ifBody = d'@IfConcreteClass{} } =
   freeNamesIfTyVarBndrs (ifBinders d) &&&
-  fnList freeNamesIfAT     (ifATs d) &&&
-  fnList freeNamesIfClsSig (ifSigs d)
+  freeNamesIfContext (ifClassCtxt d') &&&
+  fnList freeNamesIfAT     (ifATs d') &&&
+  fnList freeNamesIfClsSig (ifSigs d')
 freeNamesIfDecl d@IfaceAxiom{} =
   freeNamesIfTc (ifTyCon d) &&&
   fnList freeNamesIfAxBranch (ifAxBranches d)
@@ -1566,7 +1598,18 @@ instance Binary IfaceDecl where
         put_ bh a5
         put_ bh a6
 
-    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8) = do
+    -- NB: Written in a funny way to avoid an interface change
+    put_ bh (IfaceClass {
+                ifName    = a2,
+                ifRoles   = a3,
+                ifBinders = a4,
+                ifFDs     = a5,
+                ifBody = IfConcreteClass {
+                    ifClassCtxt = a1,
+                    ifATs  = a6,
+                    ifSigs = a7,
+                    ifMinDef  = a8
+                }}) = do
         putByte bh 5
         put_ bh a1
         putIfaceTopBndr bh a2
@@ -1598,6 +1641,18 @@ instance Binary IfaceDecl where
         put_ bh a10
         put_ bh a11
 
+    put_ bh (IfaceClass {
+                ifName    = a1,
+                ifRoles   = a2,
+                ifBinders = a3,
+                ifFDs     = a4,
+                ifBody = IfAbstractClass }) = do
+        putByte bh 8
+        putIfaceTopBndr bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+
     get bh = do
         h <- getByte bh
         case h of
@@ -1638,7 +1693,17 @@ instance Binary IfaceDecl where
                     a6 <- get bh
                     a7 <- get bh
                     a8 <- get bh
-                    return (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8)
+                    return (IfaceClass {
+                        ifName    = a2,
+                        ifRoles   = a3,
+                        ifBinders = a4,
+                        ifFDs     = a5,
+                        ifBody = IfConcreteClass {
+                            ifClassCtxt = a1,
+                            ifATs  = a6,
+                            ifSigs = a7,
+                            ifMinDef  = a8
+                        }})
             6 -> do a1 <- getIfaceTopBndr bh
                     a2 <- get bh
                     a3 <- get bh
@@ -1656,6 +1721,16 @@ instance Binary IfaceDecl where
                     a10 <- get bh
                     a11 <- get bh
                     return (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
+            8 -> do a1 <- getIfaceTopBndr bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    return (IfaceClass {
+                        ifName    = a1,
+                        ifRoles   = a2,
+                        ifBinders = a3,
+                        ifFDs     = a4,
+                        ifBody = IfAbstractClass })
             _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
 
 instance Binary IfaceFamTyConFlav where
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 7b1e3e21b4..7974c983d1 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -931,7 +931,7 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env decl
                          map ifDFun         (lookupOccEnvL inst_env n))
                         (ann_fn n)
                         (map (id_extras . occName . ifConName) (visibleIfConDecls cons))
-      IfaceClass{ifSigs=sigs, ifATs=ats} ->
+      IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} ->
                      IfaceClassExtras (fix_fn n)
                         (map ifDFun $ (concatMap at_extras ats)
                                     ++ lookupOccEnvL inst_env n)
@@ -1668,19 +1668,25 @@ tyConToIfaceDecl env tycon
 classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
 classToIfaceDecl env clas
   = ( env1
-    , IfaceClass { ifCtxt   = tidyToIfaceContext env1 sc_theta,
-                   ifName   = getName tycon,
+    , IfaceClass { ifName   = getName tycon,
                    ifRoles  = tyConRoles (classTyCon clas),
                    ifBinders = toIfaceTyVarBinders tc_binders,
-                   ifFDs    = map toIfaceFD clas_fds,
-                   ifATs    = map toIfaceAT clas_ats,
-                   ifSigs   = map toIfaceClassOp op_stuff,
-                   ifMinDef = fmap getOccFS (classMinimalDef clas) })
+                   ifBody   = body,
+                   ifFDs    = map toIfaceFD clas_fds })
   where
     (_, clas_fds, sc_theta, _, clas_ats, op_stuff)
       = classExtraBigSig clas
     tycon = classTyCon clas
 
+    body | isAbstractTyCon tycon = IfAbstractClass
+         | otherwise
+         = IfConcreteClass {
+                ifClassCtxt   = tidyToIfaceContext env1 sc_theta,
+                ifATs    = map toIfaceAT clas_ats,
+                ifSigs   = map toIfaceClassOp op_stuff,
+                ifMinDef = fmap getOccFS (classMinimalDef clas)
+            }
+
     (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
 
     toIfaceAT :: ClassATItem -> IfaceAT
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index b6b898f230..0363c9e581 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -208,7 +208,7 @@ typecheckIface iface
 -- | Returns true if an 'IfaceDecl' is for @data T@ (an abstract data type)
 isAbstractIfaceDecl :: IfaceDecl -> Bool
 isAbstractIfaceDecl IfaceData{ ifCons = IfAbstractTyCon } = True
-isAbstractIfaceDecl IfaceClass{ ifCtxt = [], ifSigs = [], ifATs = [] } = True
+isAbstractIfaceDecl IfaceClass{ ifBody = IfAbstractClass } = True
 isAbstractIfaceDecl IfaceFamily{ ifFamFlav = IfaceAbstractClosedSynFamilyTyCon } = True
 isAbstractIfaceDecl _ = False
 
@@ -223,21 +223,22 @@ ifMaybeRoles _ = Nothing
 -- later.)
 mergeIfaceDecl :: IfaceDecl -> IfaceDecl -> IfaceDecl
 mergeIfaceDecl d1 d2
-    -- TODO: need to merge roles
     | isAbstractIfaceDecl d1 = d2 `withRolesFrom` d1
     | isAbstractIfaceDecl d2 = d1 `withRolesFrom` d2
-    | IfaceClass{ ifSigs = ops1, ifMinDef = bf1 } <- d1
-    , IfaceClass{ ifSigs = ops2, ifMinDef = bf2 } <- d2
+    | IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops1, ifMinDef = bf1 } } <- d1
+    , IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops2, ifMinDef = bf2 } } <- d2
     = let ops = nameEnvElts $
                   plusNameEnv_C mergeIfaceClassOp
                     (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
                     (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
-      in d1 { ifSigs   = ops
-            , ifMinDef = BF.mkOr [noLoc bf1, noLoc bf2]
-            } `withRolesFrom` d2
+      in d1 { ifBody = (ifBody d1) {
+                ifSigs  = ops,
+                ifMinDef = BF.mkOr [noLoc bf1, noLoc bf2]
+                }
+            }
     -- It doesn't matter; we'll check for consistency later when
     -- we merge, see 'mergeSignatures'
-    | otherwise              = d1 `withRolesFrom` d2
+    | otherwise              = d1
 
 withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
 d1 `withRolesFrom` d2
@@ -677,15 +678,27 @@ tc_iface_decl parent _ (IfaceFamily {ifName = tc_name,
          = pprPanic "tc_iface_decl"
                     (text "IfaceBuiltInSynFamTyCon in interface file")
 
+tc_iface_decl _parent _ignore_prags
+            (IfaceClass {ifName = tc_name,
+                         ifRoles = roles,
+                         ifBinders = binders,
+                         ifFDs = rdr_fds,
+                         ifBody = IfAbstractClass})
+  = bindIfaceTyConBinders binders $ \ binders' -> do
+    { fds  <- mapM tc_fd rdr_fds
+    ; cls  <- buildClass tc_name binders' roles fds Nothing
+    ; return (ATyCon (classTyCon cls)) }
+
 tc_iface_decl _parent ignore_prags
-            (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_name,
+            (IfaceClass {ifName = tc_name,
                          ifRoles = roles,
                          ifBinders = binders,
                          ifFDs = rdr_fds,
-                         ifATs = rdr_ats, ifSigs = rdr_sigs,
-                         ifMinDef = mindef_occ })
--- ToDo: in hs-boot files we should really treat abstract classes specially,
---       as we do abstract tycons
+                         ifBody = IfConcreteClass {
+                             ifClassCtxt = rdr_ctxt,
+                             ifATs = rdr_ats, ifSigs = rdr_sigs,
+                             ifMinDef = mindef_occ
+                         }})
   = bindIfaceTyConBinders binders $ \ binders' -> do
     { traceIf (text "tc-iface-class1" <+> ppr tc_name)
     ; ctxt <- mapM tc_sc rdr_ctxt
@@ -697,7 +710,7 @@ tc_iface_decl _parent ignore_prags
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats
               ; traceIf (text "tc-iface-class4" <+> ppr tc_name)
-              ; buildClass tc_name binders' roles ctxt fds ats sigs mindef }
+              ; buildClass tc_name binders' roles fds (Just (ctxt, ats, sigs, mindef)) }
     ; return (ATyCon (classTyCon cls)) }
   where
    tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
@@ -746,10 +759,6 @@ tc_iface_decl _parent ignore_prags
    mk_at_doc tc = text "Associated type" <+> ppr tc
    mk_op_doc op_name op_ty = text "Class op" <+> sep [ppr op_name, ppr op_ty]
 
-   tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
-                           ; tvs2' <- mapM tcIfaceTyVar tvs2
-                           ; return (tvs1', tvs2') }
-
 tc_iface_decl _ _ (IfaceAxiom { ifName = tc_name, ifTyCon = tc
                               , ifAxBranches = branches, ifRole = role })
   = do { tc_tycon    <- tcIfaceTyCon tc
@@ -794,6 +803,11 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = name
      tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm)
                         ; return (id, b) }
 
+tc_fd :: FunDep IfLclName -> IfL (FunDep TyVar)
+tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
+                        ; tvs2' <- mapM tcIfaceTyVar tvs2
+                        ; return (tvs1', tvs2') }
+
 tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
 tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
 
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index e08d2e19d4..b6af02b129 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -981,11 +981,7 @@ checkBootTyCon is_boot tc1 tc2
           -- Checks kind of class
     check (eqListBy eqFD clas_fds1 clas_fds2)
           (text "The functional dependencies do not match") `andThenCheck`
-    checkUnless (null sc_theta1 && null op_stuff1 && null ats1) $
-                     -- Above tests for an "abstract" class.
-                     -- This is duplicated in 'isAbstractIfaceDecl'
-                     -- and also below near
-                     -- Note [Constraint synonym implements abstract class]
+    checkUnless (isAbstractTyCon tc1) $
     check (eqListBy (eqTypeX env) sc_theta1 sc_theta2)
           (text "The class constraints do not match") `andThenCheck`
     checkListBy eqSig op_stuff1 op_stuff2 (text "methods") `andThenCheck`
@@ -1001,26 +997,15 @@ checkBootTyCon is_boot tc1 tc2
     check (eqTypeX env syn_rhs1 syn_rhs2) empty   -- nothing interesting to say
 
   -- This allows abstract 'data T a' to be implemented using 'type T = ...'
+  -- and abstract 'class K a' to be implement using 'type K = ...'
   -- See Note [Synonyms implement abstract data]
   | not is_boot -- don't support for hs-boot yet
   , isAbstractTyCon tc1
   , Just (tvs, ty) <- synTyConDefn_maybe tc2
   , Just (tc2', args) <- tcSplitTyConApp_maybe ty
   = checkSynAbsData tvs ty tc2' args
-
-  -- This allows abstract 'class C a' to be implemented using 'type C = ...'
-  -- This was originally requested in #12679.
-  -- See Note [Synonyms implement abstract data]
-  | not is_boot -- don't support for hs-boot yet
-  , Just c1 <- tyConClass_maybe tc1
-  , let (_, _clas_fds1, sc_theta1, _, ats1, op_stuff1)
-          = classExtraBigSig c1
-  -- Is it abstract?
-  , null sc_theta1 && null op_stuff1 && null ats1
-  , Just (tvs, ty) <- synTyConDefn_maybe tc2
-  , Just (tc2', args) <- tcSplitTyConApp_maybe ty
-  = checkSynAbsData tvs ty tc2' args
-    -- TODO: We really should check if the fundeps are satisfied, but
+    -- TODO: When it's a synonym implementing a class, we really
+    -- should check if the fundeps are satisfied, but
     -- there is not an obvious way to do this for a constraint synonym.
     -- So for now, let it all through (it won't cause segfaults, anyway).
     -- Tracked at #12704.
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index b21cb911d7..6f30537701 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -763,10 +763,15 @@ tcTyClDecl1 _parent roles_info
                ; sig_stuff <- tcClassSigs class_name sigs meths
                ; at_stuff <- tcClassATs class_name clas ats at_defs
                ; mindef <- tcClassMinimalDef class_name sigs sig_stuff
-               ; clas <- buildClass
-                            class_name binders roles ctxt'
-                            fds' at_stuff
-                            sig_stuff mindef
+               -- TODO: Allow us to distinguish between abstract class,
+               -- and concrete class with no methods (maybe by
+               -- specifying a trailing where or not
+               ; is_boot <- tcIsHsBootOrSig
+               ; let body | is_boot, null ctxt', null at_stuff, null sig_stuff
+                          = Nothing
+                          | otherwise
+                          = Just (ctxt', at_stuff, sig_stuff, mindef)
+               ; clas <- buildClass class_name binders roles fds' body
                ; traceTc "tcClassDecl" (ppr fundeps $$ ppr binders $$
                                         ppr fds')
                ; return clas }
diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs
index 786ef7ee91..cd9f8dee95 100644
--- a/compiler/types/Class.hs
+++ b/compiler/types/Class.hs
@@ -14,7 +14,7 @@ module Class (
 
         FunDep, pprFundeps, pprFunDep,
 
-        mkClass, classTyVars, classArity,
+        mkClass, mkAbstractClass, classTyVars, classArity,
         classKey, className, classATs, classATItems, classTyCon, classMethods,
         classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta,
         classAllSelIds, classSCSelId, classMinimalDef, classHasFds,
@@ -34,7 +34,7 @@ import SrcLoc
 import PrelNames    ( eqTyConKey, coercibleTyConKey, typeableClassKey,
                       heqTyConKey )
 import Outputable
-import BooleanFormula (BooleanFormula)
+import BooleanFormula (BooleanFormula, mkTrue)
 
 import qualified Data.Data as Data
 
@@ -62,21 +62,8 @@ data Class
 
         classFunDeps :: [FunDep TyVar],  -- The functional dependencies
 
-        -- Superclasses: eg: (F a ~ b, F b ~ G a, Eq a, Show b)
-        -- We need value-level selectors for both the dictionary
-        -- superclasses and the equality superclasses
-        classSCTheta :: [PredType],     -- Immediate superclasses,
-        classSCSels  :: [Id],           -- Selector functions to extract the
-                                        --   superclasses from a
-                                        --   dictionary of this class
-        -- Associated types
-        classATStuff :: [ClassATItem],  -- Associated type families
-
-        -- Class operations (methods, not superclasses)
-        classOpStuff :: [ClassOpItem],  -- Ordered by tag
+        classBody :: ClassBody -- Superclasses, ATs, methods
 
-        -- Minimal complete definition
-        classMinimalDef :: ClassMinimalDef
      }
 
 --  | e.g.
@@ -110,6 +97,31 @@ data ClassATItem
 
 type ClassMinimalDef = BooleanFormula Name -- Required methods
 
+data ClassBody
+  = AbstractClass
+  | ConcreteClass {
+        -- Superclasses: eg: (F a ~ b, F b ~ G a, Eq a, Show b)
+        -- We need value-level selectors for both the dictionary
+        -- superclasses and the equality superclasses
+        classSCThetaStuff :: [PredType],     -- Immediate superclasses,
+        classSCSels  :: [Id],           -- Selector functions to extract the
+                                        --   superclasses from a
+                                        --   dictionary of this class
+        -- Associated types
+        classATStuff :: [ClassATItem],  -- Associated type families
+
+        -- Class operations (methods, not superclasses)
+        classOpStuff :: [ClassOpItem],  -- Ordered by tag
+
+        -- Minimal complete definition
+        classMinimalDefStuff :: ClassMinimalDef
+    }
+    -- TODO: maybe super classes should be allowed in abstract class definitions
+
+classMinimalDef :: Class -> ClassMinimalDef
+classMinimalDef Class{ classBody = ConcreteClass{ classMinimalDefStuff = d } } = d
+classMinimalDef _ = mkTrue -- TODO: make sure this is the right direction
+
 {-
 Note [Associated type defaults]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -164,11 +176,28 @@ mkClass cls_name tyvars fds super_classes superdict_sels at_stuff
                 -- But it takes a module loop to assert it here
             classTyVars  = tyvars,
             classFunDeps = fds,
-            classSCTheta = super_classes,
-            classSCSels  = superdict_sels,
-            classATStuff = at_stuff,
-            classOpStuff = op_stuff,
-            classMinimalDef = mindef,
+            classBody = ConcreteClass {
+                    classSCThetaStuff = super_classes,
+                    classSCSels  = superdict_sels,
+                    classATStuff = at_stuff,
+                    classOpStuff = op_stuff,
+                    classMinimalDefStuff = mindef
+                },
+            classTyCon   = tycon }
+
+mkAbstractClass :: Name -> [TyVar]
+        -> [FunDep TyVar]
+        -> TyCon
+        -> Class
+
+mkAbstractClass cls_name tyvars fds tycon
+  = Class { classKey     = nameUnique cls_name,
+            className    = cls_name,
+                -- NB:  tyConName tycon = cls_name,
+                -- But it takes a module loop to assert it here
+            classTyVars  = tyvars,
+            classFunDeps = fds,
+            classBody = AbstractClass,
             classTyCon   = tycon }
 
 {-
@@ -206,30 +235,43 @@ classArity clas = length (classTyVars clas)
 
 classAllSelIds :: Class -> [Id]
 -- Both superclass-dictionary and method selectors
-classAllSelIds c@(Class {classSCSels = sc_sels})
+classAllSelIds c@(Class { classBody = ConcreteClass { classSCSels = sc_sels }})
   = sc_sels ++ classMethods c
+classAllSelIds c = ASSERT( null (classMethods c) ) []
 
 classSCSelId :: Class -> Int -> Id
 -- Get the n'th superclass selector Id
 -- where n is 0-indexed, and counts
 --    *all* superclasses including equalities
-classSCSelId (Class { classSCSels = sc_sels }) n
+classSCSelId (Class { classBody = ConcreteClass { classSCSels = sc_sels } }) n
   = ASSERT( n >= 0 && n < length sc_sels )
     sc_sels !! n
+classSCSelId c n = pprPanic "classSCSelId" (ppr c <+> ppr n)
 
 classMethods :: Class -> [Id]
-classMethods (Class {classOpStuff = op_stuff})
+classMethods (Class { classBody = ConcreteClass { classOpStuff = op_stuff } })
   = [op_sel | (op_sel, _) <- op_stuff]
+classMethods _ = []
 
 classOpItems :: Class -> [ClassOpItem]
-classOpItems = classOpStuff
+classOpItems (Class { classBody = ConcreteClass { classOpStuff = op_stuff }})
+  = op_stuff
+classOpItems _ = []
 
 classATs :: Class -> [TyCon]
-classATs (Class { classATStuff = at_stuff })
+classATs (Class { classBody = ConcreteClass { classATStuff = at_stuff } })
   = [tc | ATI tc _ <- at_stuff]
+classATs _ = []
 
 classATItems :: Class -> [ClassATItem]
-classATItems = classATStuff
+classATItems (Class { classBody = ConcreteClass { classATStuff = at_stuff }})
+  = at_stuff
+classATItems _ = []
+
+classSCTheta :: Class -> [PredType]
+classSCTheta (Class { classBody = ConcreteClass { classSCThetaStuff = theta_stuff }})
+  = theta_stuff
+classSCTheta _ = []
 
 classTvsFds :: Class -> ([TyVar], [FunDep TyVar])
 classTvsFds c = (classTyVars c, classFunDeps c)
@@ -238,14 +280,26 @@ classHasFds :: Class -> Bool
 classHasFds (Class { classFunDeps = fds }) = not (null fds)
 
 classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem])
-classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
-                    classSCSels = sc_sels, classOpStuff = op_stuff})
+classBigSig (Class {classTyVars = tyvars,
+                    classBody = AbstractClass})
+  = (tyvars, [], [], [])
+classBigSig (Class {classTyVars = tyvars,
+                    classBody = ConcreteClass {
+                        classSCThetaStuff = sc_theta,
+                        classSCSels = sc_sels,
+                        classOpStuff = op_stuff
+                    }})
   = (tyvars, sc_theta, sc_sels, op_stuff)
 
 classExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [ClassATItem], [ClassOpItem])
 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
-                         classSCTheta = sc_theta, classSCSels = sc_sels,
-                         classATStuff = ats, classOpStuff = op_stuff})
+                         classBody = AbstractClass})
+  = (tyvars, fundeps, [], [], [], [])
+classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
+                         classBody = ConcreteClass {
+                             classSCThetaStuff = sc_theta, classSCSels = sc_sels,
+                             classATStuff = ats, classOpStuff = op_stuff
+                         }})
   = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)
 
 -- | If a class is "naturally coherent", then we needn't worry at all, in any
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index a9498a5423..684754684b 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -61,11 +61,12 @@ vectTyConDecl tycon name'
                      name'                      -- new name: "V:Class"
                      (tyConBinders tycon)       -- keep original kind
                      (map (const Nominal) (tyConRoles tycon)) -- all role are N for safety
-                     theta'                     -- superclasses
                      (snd . classTvsFds $ cls)  -- keep the original functional dependencies
-                     []                         -- no associated types (for the moment)
-                     methods'                   -- method info
-                     (classMinimalDef cls)      -- Inherit minimal complete definition from cls
+                     (Just (
+                         theta',                 -- superclasses
+                         [],                     -- no associated types (for the moment)
+                         methods',               -- method info
+                         (classMinimalDef cls))) -- Inherit minimal complete definition from cls
 
            -- the original dictionary constructor must map to the vectorised one
        ; let tycon'        = classTyCon cls'
diff --git a/testsuite/tests/typecheck/should_compile/Makefile b/testsuite/tests/typecheck/should_compile/Makefile
index 7af8ae146d..cb8269ae15 100644
--- a/testsuite/tests/typecheck/should_compile/Makefile
+++ b/testsuite/tests/typecheck/should_compile/Makefile
@@ -50,3 +50,9 @@ Tc267:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc267b.hs-boot
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc267a.hs
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc267b.hs
+
+Tc271:
+	$(RM) -f Tc271.hi-boot Tc271.o-boot Tc271a.hi Tc271a.o Tc271.hi Tc271.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc271.hs-boot
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc271a.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc271.hs
diff --git a/testsuite/tests/typecheck/should_compile/Tc271.hs b/testsuite/tests/typecheck/should_compile/Tc271.hs
new file mode 100644
index 0000000000..5f0c3f0a1a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/Tc271.hs
@@ -0,0 +1,10 @@
+module Tc271 where
+
+import Tc271a
+
+class K a where
+    f :: a -> a
+    g :: a -> a
+
+h :: K a => a -> a
+h = f . g . h2
diff --git a/testsuite/tests/typecheck/should_compile/Tc271.hs-boot b/testsuite/tests/typecheck/should_compile/Tc271.hs-boot
new file mode 100644
index 0000000000..9f15065a11
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/Tc271.hs-boot
@@ -0,0 +1,5 @@
+module Tc271 where
+
+class K a where
+
+h :: K a => a -> a
diff --git a/testsuite/tests/typecheck/should_compile/Tc271a.hs b/testsuite/tests/typecheck/should_compile/Tc271a.hs
new file mode 100644
index 0000000000..b5fd136599
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/Tc271a.hs
@@ -0,0 +1,5 @@
+module Tc271a where
+import {-# SOURCE #-} Tc271
+
+h2 :: K a => a -> a
+h2 = h
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index e9aacd8678..837a0d7995 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -343,6 +343,7 @@ test('Tc267', [extra_files(['Tc267a.hs', 'Tc267b.hs', 'Tc267a.hs-boot', 'Tc267b.
 test('tc268', normal, compile, [''])
 test('tc269', normal, compile, [''])
 test('tc270', normal, compile, [''])
+test('Tc271', [extra_files(['Tc271a.hs', 'Tc271.hs', 'Tc271.hs-boot'])], run_command, ['$MAKE -s --no-print-directory Tc271'])
 
 test('GivenOverlapping', normal, compile, [''])
 test('GivenTypeSynonym', normal, compile, [''])