fix haddock submodule pointer

[ghc-hetmet.git] / compiler / typecheck / TcHsType.lhs

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 62c5eaa..4fe6b60 100644 (file)
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -16,7 +16,7 @@ module TcHsType (
        
                -- Typechecking kinded types
        tcHsKindedContext, tcHsKindedType, tcHsBangType,
        
                -- Typechecking kinded types
        tcHsKindedContext, tcHsKindedType, tcHsBangType,

-       tcTyVarBndrs, dsHsType, 
+       tcTyVarBndrs, dsHsType, kcHsLPred, dsHsLPred,

        tcDataKindSig, ExpKind(..), EkCtxt(..),
 
                -- Pattern type signatures
        tcDataKindSig, ExpKind(..), EkCtxt(..),
 
                -- Pattern type signatures

@@ -37,15 +37,14 @@ import TcMType
 import TcUnify
 import TcIface
 import TcType
 import TcUnify
 import TcIface
 import TcType

+import TysPrim ( ecKind )

 import {- Kind parts of -} Type
 import Var
 import VarSet
 import {- Kind parts of -} Type
 import Var
 import VarSet

-import Coercion

 import TyCon
 import Class
 import Name
 import NameSet
 import TyCon
 import Class
 import Name
 import NameSet

-import PrelNames

 import TysWiredIn
 import BasicTypes
 import SrcLoc
 import TysWiredIn
 import BasicTypes
 import SrcLoc

@@ -156,29 +155,36 @@ tcHsSigTypeNC ctxt hs_ty
        ; checkValidType ctxt ty        
        ; return ty }
 
        ; checkValidType ctxt ty        
        ; return ty }
 

-tcHsInstHead :: LHsType Name -> TcM ([TyVar], ThetaType, Type)
+tcHsInstHead :: LHsType Name -> TcM ([TyVar], ThetaType, Class, [Type])

 -- Typecheck an instance head.  We can't use 
 -- tcHsSigType, because it's not a valid user type.
 -- Typecheck an instance head.  We can't use 
 -- tcHsSigType, because it's not a valid user type.

-tcHsInstHead (L loc ty)
+tcHsInstHead (L loc hs_ty)

   = setSrcSpan loc   $ -- No need for an "In the type..." context
   = setSrcSpan loc   $ -- No need for an "In the type..." context

-    tc_inst_head ty     -- because that comes from the caller
+                        -- because that comes from the caller
+    do { kinded_ty <- kc_inst_head hs_ty
+       ; ds_inst_head kinded_ty }

   where
   where

-    -- tc_inst_head expects HsPredTy, which isn't usually even allowed
-    tc_inst_head (HsPredTy pred)
-      = do { pred'  <- kcHsPred pred
-          ; pred'' <- dsHsPred pred'
-           ; return ([], [], mkPredTy pred'') }
-
-    tc_inst_head (HsForAllTy _ tvs ctxt (L _ (HsPredTy pred)))
-      = kcHsTyVars tvs    $ \ tvs' ->
-       do { ctxt' <- kcHsContext ctxt
-          ; pred' <- kcHsPred    pred
-          ; tcTyVarBndrs tvs'  $ \ tvs'' ->
-       do { ctxt'' <- mapM dsHsLPred (unLoc ctxt')
-          ; pred'' <- dsHsPred pred'
-          ; return (tvs'', ctxt'', mkPredTy pred'') } }
-
-    tc_inst_head _ = failWithTc (ptext (sLit "Malformed instance type"))
+    kc_inst_head ty@(HsPredTy pred@(HsClassP {}))
+      = do { (pred', kind) <- kc_pred pred
+           ; checkExpectedKind ty kind ekLifted
+           ; return (HsPredTy pred') }
+    kc_inst_head (HsForAllTy exp tv_names context (L loc ty))
+      = kcHsTyVars tv_names         $ \ tv_names' ->
+        do { ctxt' <- kcHsContext context
+           ; ty'   <- kc_inst_head ty
+           ; return (HsForAllTy exp tv_names' ctxt' (L loc ty')) }
+    kc_inst_head _ = failWithTc (ptext (sLit "Malformed instance type"))
+
+    ds_inst_head (HsPredTy (HsClassP cls_name tys))
+      = do { clas <- tcLookupClass cls_name
+           ; arg_tys <- dsHsTypes tys
+           ; return ([], [], clas, arg_tys) }
+    ds_inst_head (HsForAllTy _ tvs ctxt (L _ tau))
+      = tcTyVarBndrs tvs  $ \ tvs' ->
+        do { ctxt' <- mapM dsHsLPred (unLoc ctxt)
+           ; (tvs_r, ctxt_r, cls, tys) <- ds_inst_head tau
+           ; return (tvs' ++ tvs_r, ctxt' ++ ctxt_r , cls, tys) }
+    ds_inst_head _ = panic "ds_inst_head"

 
 tcHsQuantifiedType :: [LHsTyVarBndr Name] -> LHsType Name -> TcM ([TyVar], Type)
 -- Behave very like type-checking (HsForAllTy sig_tvs hs_ty),
 
 tcHsQuantifiedType :: [LHsTyVarBndr Name] -> LHsType Name -> TcM ([TyVar], Type)
 -- Behave very like type-checking (HsForAllTy sig_tvs hs_ty),

@@ -294,7 +300,7 @@ kc_check_hs_type (HsParTy ty) exp_kind
   = do { ty' <- kc_check_lhs_type ty exp_kind; return (HsParTy ty') }
 
 kc_check_hs_type ty@(HsAppTy ty1 ty2) exp_kind
   = do { ty' <- kc_check_lhs_type ty exp_kind; return (HsParTy ty') }
 
 kc_check_hs_type ty@(HsAppTy ty1 ty2) exp_kind

-  = do { let (fun_ty, arg_tys) = splitHsAppTys ty1 ty2
+  = do { let (fun_ty, arg_tys) = splitHsAppTys ty1 [ty2]

        ; (fun_ty', fun_kind) <- kc_lhs_type fun_ty
        ; arg_tys' <- kcCheckApps fun_ty fun_kind arg_tys ty exp_kind
        ; return (mkHsAppTys fun_ty' arg_tys') }
        ; (fun_ty', fun_kind) <- kc_lhs_type fun_ty
        ; arg_tys' <- kcCheckApps fun_ty fun_kind arg_tys ty exp_kind
        ; return (mkHsAppTys fun_ty' arg_tys') }

@@ -359,8 +365,15 @@ kc_hs_type (HsPArrTy ty) = do
     ty' <- kcLiftedType ty
     return (HsPArrTy ty', liftedTypeKind)
 
     ty' <- kcLiftedType ty
     return (HsPArrTy ty', liftedTypeKind)
 

-kc_hs_type (HsNumTy n)
-   = return (HsNumTy n, liftedTypeKind)
+kc_hs_type (HsModalBoxType ecn ty) = do
+    kc_check_hs_type (HsTyVar ecn) (EK ecKind EkUnk)
+    ty' <- kcLiftedType ty
+    return (HsModalBoxType ecn ty', liftedTypeKind)
+
+kc_hs_type (HsKappaTy ty1 ty2) = do
+    ty1' <- kc_check_lhs_type ty1 (EK argTypeKind EkUnk)
+    ty2' <- kcTypeType ty2
+    return (HsKappaTy ty1' ty2', liftedTypeKind)

 
 kc_hs_type (HsKindSig ty k) = do
     ty' <- kc_check_lhs_type ty (EK k EkKindSig)
 
 kc_hs_type (HsKindSig ty k) = do
     ty' <- kc_check_lhs_type ty (EK k EkKindSig)

@@ -385,15 +398,17 @@ kc_hs_type (HsOpTy ty1 op ty2) = do
     return (HsOpTy ty1' op ty2', res_kind)
 
 kc_hs_type (HsAppTy ty1 ty2) = do
     return (HsOpTy ty1' op ty2', res_kind)
 
 kc_hs_type (HsAppTy ty1 ty2) = do

+    let (fun_ty, arg_tys) = splitHsAppTys ty1 [ty2]

     (fun_ty', fun_kind) <- kc_lhs_type fun_ty
     (arg_tys', res_kind) <- kcApps fun_ty fun_kind arg_tys
     return (mkHsAppTys fun_ty' arg_tys', res_kind)
     (fun_ty', fun_kind) <- kc_lhs_type fun_ty
     (arg_tys', res_kind) <- kcApps fun_ty fun_kind arg_tys
     return (mkHsAppTys fun_ty' arg_tys', res_kind)

-  where
-    (fun_ty, arg_tys) = splitHsAppTys ty1 ty2

 
 kc_hs_type (HsPredTy pred)
   = wrongPredErr pred
 
 
 kc_hs_type (HsPredTy pred)
   = wrongPredErr pred
 

+kc_hs_type (HsCoreTy ty)
+  = return (HsCoreTy ty, typeKind ty)
+

 kc_hs_type (HsForAllTy exp tv_names context ty)
   = kcHsTyVars tv_names         $ \ tv_names' ->
     do { ctxt' <- kcHsContext context
 kc_hs_type (HsForAllTy exp tv_names context ty)
   = kcHsTyVars tv_names         $ \ tv_names' ->
     do { ctxt' <- kcHsContext context

@@ -453,26 +468,12 @@ kcCheckApps the_fun fun_kind args ty exp_kind
             -- This improves error message; Trac #2994
        ; kc_check_lhs_types args_w_kinds }
 
             -- This improves error message; Trac #2994
        ; kc_check_lhs_types args_w_kinds }
 

-splitHsAppTys :: LHsType Name -> LHsType Name -> (LHsType Name, [LHsType Name])
-splitHsAppTys fun_ty arg_ty = split fun_ty [arg_ty]
-  where
-    split (L _ (HsAppTy f a)) as = split f (a:as)
-    split f                  as = (f,as)
-
-mkHsAppTys :: LHsType Name -> [LHsType Name] -> HsType Name
-mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
-mkHsAppTys fun_ty (arg_ty:arg_tys)
-  = foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
-  where
-    mk_app fun arg = HsAppTy (noLoc fun) arg   -- Add noLocs for inner nodes of
-                                               -- the application; they are
-                                               -- never used 

 
 ---------------------------
 splitFunKind :: SDoc -> Int -> TcKind -> [b] -> TcM ([(b,ExpKind)], TcKind)
 splitFunKind _       _      fk [] = return ([], fk)
 splitFunKind the_fun arg_no fk (arg:args)
 
 ---------------------------
 splitFunKind :: SDoc -> Int -> TcKind -> [b] -> TcM ([(b,ExpKind)], TcKind)
 splitFunKind _       _      fk [] = return ([], fk)
 splitFunKind the_fun arg_no fk (arg:args)

-  = do { mb_fk <- unifyFunKind fk
+  = do { mb_fk <- matchExpectedFunKind fk

        ; case mb_fk of
             Nothing       -> failWithTc too_many_args 
             Just (ak,fk') -> do { (aks, rk) <- splitFunKind the_fun (arg_no+1) fk' args
        ; case mb_fk of
             Nothing       -> failWithTc too_many_args 
             Just (ak,fk') -> do { (aks, rk) <- splitFunKind the_fun (arg_no+1) fk' args

@@ -489,9 +490,9 @@ kcHsLPred :: LHsPred Name -> TcM (LHsPred Name)
 kcHsLPred = wrapLocM kcHsPred
 
 kcHsPred :: HsPred Name -> TcM (HsPred Name)
 kcHsLPred = wrapLocM kcHsPred
 
 kcHsPred :: HsPred Name -> TcM (HsPred Name)

-kcHsPred pred = do     -- Checks that the result is of kind liftedType
+kcHsPred pred = do      -- Checks that the result is a type kind

     (pred', kind) <- kc_pred pred
     (pred', kind) <- kc_pred pred

-    checkExpectedKind pred kind ekLifted
+    checkExpectedKind pred kind ekOpen

     return pred'
     
 ---------------------------
     return pred'
     
 ---------------------------

@@ -500,28 +501,23 @@ kc_pred :: HsPred Name -> TcM (HsPred Name, TcKind)
        -- application (reason: used from TcDeriv)
 kc_pred (HsIParam name ty)
   = do { (ty', kind) <- kc_lhs_type ty
        -- application (reason: used from TcDeriv)
 kc_pred (HsIParam name ty)
   = do { (ty', kind) <- kc_lhs_type ty

-       ; return (HsIParam name ty', kind)
-       }
+       ; return (HsIParam name ty', kind) }

 kc_pred (HsClassP cls tys)
   = do { kind <- kcClass cls
        ; (tys', res_kind) <- kcApps cls kind tys
 kc_pred (HsClassP cls tys)
   = do { kind <- kcClass cls
        ; (tys', res_kind) <- kcApps cls kind tys

-       ; return (HsClassP cls tys', res_kind)
-       }
+       ; return (HsClassP cls tys', res_kind) }

 kc_pred (HsEqualP ty1 ty2)
   = do { (ty1', kind1) <- kc_lhs_type ty1
 kc_pred (HsEqualP ty1 ty2)
   = do { (ty1', kind1) <- kc_lhs_type ty1

---       ; checkExpectedKind ty1 kind1 liftedTypeKind

        ; (ty2', kind2) <- kc_lhs_type ty2
        ; (ty2', kind2) <- kc_lhs_type ty2

---       ; checkExpectedKind ty2 kind2 liftedTypeKind

        ; checkExpectedKind ty2 kind2 (EK kind1 EkEqPred)
        ; checkExpectedKind ty2 kind2 (EK kind1 EkEqPred)

-       ; return (HsEqualP ty1' ty2', liftedTypeKind)
-       }
+       ; return (HsEqualP ty1' ty2', unliftedTypeKind) }

 
 ---------------------------
 kcTyVar :: Name -> TcM TcKind
 kcTyVar name = do      -- Could be a tyvar or a tycon
 
 ---------------------------
 kcTyVar :: Name -> TcM TcKind
 kcTyVar name = do      -- Could be a tyvar or a tycon

-    traceTc (text "lk1" <+> ppr name)
+    traceTc "lk1" (ppr name)

     thing <- tcLookup name
     thing <- tcLookup name

-    traceTc (text "lk2" <+> ppr name <+> ppr thing)
+    traceTc "lk2" (ppr name <+> ppr thing)

     case thing of 
         ATyVar _ ty             -> return (typeKind ty)
         AThing kind             -> return kind
     case thing of 
         ATyVar _ ty             -> return (typeKind ty)
         AThing kind             -> return kind

@@ -585,6 +581,16 @@ ds_type (HsPArrTy ty) = do
     checkWiredInTyCon parrTyCon
     return (mkPArrTy tau_ty)
 
     checkWiredInTyCon parrTyCon
     return (mkPArrTy tau_ty)
 

+ds_type (HsModalBoxType ecn ty) = do
+    tau_ty <- dsHsType ty
+    checkWiredInTyCon hetMetCodeTypeTyCon
+    return (mkHetMetCodeTypeTy (mkTyVar ecn ecKind) tau_ty)
+
+ds_type (HsKappaTy ty1 ty2) = do
+    tau_ty1 <- dsHsType ty1
+    tau_ty2 <- dsHsType ty2
+    return (mkHetMetKappaTy tau_ty1 tau_ty2)
+

 ds_type (HsTupleTy boxity tys) = do
     tau_tys <- dsHsTypes tys
     checkWiredInTyCon tycon
 ds_type (HsTupleTy boxity tys) = do
     tau_tys <- dsHsTypes tys
     checkWiredInTyCon tycon

@@ -602,11 +608,6 @@ ds_type (HsOpTy ty1 (L span op) ty2) = do
     tau_ty2 <- dsHsType ty2
     setSrcSpan span (ds_var_app op [tau_ty1,tau_ty2])
 
     tau_ty2 <- dsHsType ty2
     setSrcSpan span (ds_var_app op [tau_ty1,tau_ty2])
 

-ds_type (HsNumTy n)
-  = ASSERT(n==1) do
-    tc <- tcLookupTyCon genUnitTyConName
-    return (mkTyConApp tc [])
-

 ds_type ty@(HsAppTy _ _)
   = ds_app ty []
 
 ds_type ty@(HsAppTy _ _)
   = ds_app ty []
 

@@ -628,6 +629,7 @@ ds_type (HsSpliceTy _ _ kind)
        ; newFlexiTyVarTy kind' }
 
 ds_type (HsQuasiQuoteTy {}) = panic "ds_type"  -- Eliminated by renamer
        ; newFlexiTyVarTy kind' }
 
 ds_type (HsQuasiQuoteTy {}) = panic "ds_type"  -- Eliminated by renamer

+ds_type (HsCoreTy ty)       = return ty

 
 dsHsTypes :: [LHsType Name] -> TcM [Type]
 dsHsTypes arg_tys = mapM dsHsType arg_tys
 
 dsHsTypes :: [LHsType Name] -> TcM [Type]
 dsHsTypes arg_tys = mapM dsHsType arg_tys

@@ -847,21 +849,24 @@ tcHsPatSigType ctxt hs_ty
 
 tcPatSig :: UserTypeCtxt
         -> LHsType Name
 
 tcPatSig :: UserTypeCtxt
         -> LHsType Name

-        -> BoxySigmaType
+        -> TcSigmaType

         -> TcM (TcType,           -- The type to use for "inside" the signature
                 [(Name, TcType)], -- The new bit of type environment, binding
                                   -- the scoped type variables
         -> TcM (TcType,           -- The type to use for "inside" the signature
                 [(Name, TcType)], -- The new bit of type environment, binding
                                   -- the scoped type variables

-                 CoercionI)        -- Coercion due to unification with actual ty
+                 HsWrapper)        -- Coercion due to unification with actual ty
+                                   -- Of shape:  res_ty ~ sig_ty

 tcPatSig ctxt sig res_ty
   = do { (sig_tvs, sig_ty) <- tcHsPatSigType ctxt sig
 tcPatSig ctxt sig res_ty
   = do { (sig_tvs, sig_ty) <- tcHsPatSigType ctxt sig

+       -- sig_tvs are the type variables free in 'sig', 
+       -- and not already in scope. These are the ones
+       -- that should be brought into scope

 
        ; if null sig_tvs then do {
                -- The type signature binds no type variables, 
                -- and hence is rigid, so use it to zap the res_ty
 
        ; if null sig_tvs then do {
                -- The type signature binds no type variables, 
                -- and hence is rigid, so use it to zap the res_ty

-                 coi <- boxyUnify sig_ty res_ty
-               ; return (sig_ty, [], coi)
-
-       } else do {
+                  wrap <- tcSubType PatSigOrigin ctxt res_ty sig_ty
+               ; return (sig_ty, [], wrap)
+        } else do {

                -- Type signature binds at least one scoped type variable
        
                -- A pattern binding cannot bind scoped type variables
                -- Type signature binds at least one scoped type variable
        
                -- A pattern binding cannot bind scoped type variables

@@ -873,9 +878,6 @@ tcPatSig ctxt sig res_ty
                                _              -> False
        ; ASSERT( not in_pat_bind || null sig_tvs ) return ()
 
                                _              -> False
        ; ASSERT( not in_pat_bind || null sig_tvs ) return ()
 

-               -- Check that pat_ty is rigid
-       ; checkTc (isRigidTy res_ty) (wobblyPatSig sig_tvs)
-

                -- Check that all newly-in-scope tyvars are in fact
                -- constrained by the pattern.  This catches tiresome
                -- cases like   
                -- Check that all newly-in-scope tyvars are in fact
                -- constrained by the pattern.  This catches tiresome
                -- cases like   

@@ -886,41 +888,32 @@ tcPatSig ctxt sig res_ty
        ; let bad_tvs = filterOut (`elemVarSet` exactTyVarsOfType sig_ty) sig_tvs
        ; checkTc (null bad_tvs) (badPatSigTvs sig_ty bad_tvs)
 
        ; let bad_tvs = filterOut (`elemVarSet` exactTyVarsOfType sig_ty) sig_tvs
        ; checkTc (null bad_tvs) (badPatSigTvs sig_ty bad_tvs)
 

-               -- Now match the pattern signature against res_ty
-               -- For convenience, and uniform-looking error messages
-               -- we do the matching by allocating meta type variables, 
-               -- unifying, and reading out the results.
-               -- This is a strictly local operation.
-       ; box_tvs <- mapM tcInstBoxyTyVar sig_tvs
-       ; coi <- boxyUnify (substTyWith sig_tvs (mkTyVarTys box_tvs) sig_ty) 
-                           res_ty
-       ; sig_tv_tys <- mapM readFilledBox box_tvs
-
-               -- Check that each is bound to a distinct type variable,
-               -- and one that is not already in scope
-       ; let tv_binds = map tyVarName sig_tvs `zip` sig_tv_tys
-       ; binds_in_scope <- getScopedTyVarBinds
+       -- Now do a subsumption check of the pattern signature against res_ty
+        ; sig_tvs' <- tcInstSigTyVars sig_tvs
+        ; let sig_ty' = substTyWith sig_tvs sig_tv_tys' sig_ty
+              sig_tv_tys' = mkTyVarTys sig_tvs'
+       ; wrap <- tcSubType PatSigOrigin ctxt res_ty sig_ty'
+
+       -- Check that each is bound to a distinct type variable,
+       -- and one that is not already in scope
+        ; binds_in_scope <- getScopedTyVarBinds
+       ; let tv_binds = map tyVarName sig_tvs `zip` sig_tv_tys'

        ; check binds_in_scope tv_binds
        
        ; check binds_in_scope tv_binds
        

-               -- Phew!
-       ; return (res_ty, tv_binds, coi)
-       } }
+       -- Phew!
+        ; return (sig_ty', tv_binds, wrap)
+        } }

   where
     check _ [] = return ()
     check in_scope ((n,ty):rest) = do { check_one in_scope n ty
                                      ; check ((n,ty):in_scope) rest }
 
     check_one in_scope n ty
   where
     check _ [] = return ()
     check in_scope ((n,ty):rest) = do { check_one in_scope n ty
                                      ; check ((n,ty):in_scope) rest }
 
     check_one in_scope n ty

-       = do { checkTc (tcIsTyVarTy ty) (scopedNonVar n ty)
-               -- Must bind to a type variable
-
-            ; checkTc (null dups) (dupInScope n (head dups) ty)
+       = checkTc (null dups) (dupInScope n (head dups) ty)

                -- Must not bind to the same type variable
                -- as some other in-scope type variable
                -- Must not bind to the same type variable
                -- as some other in-scope type variable

-
-            ; return () }

        where
        where

-         dups = [n' | (n',ty') <- in_scope, tcEqType ty' ty]
+         dups = [n' | (n',ty') <- in_scope, eqType ty' ty]

 \end{code}
 
 
 \end{code}
 
 

@@ -1030,12 +1023,6 @@ pprHsSigCtxt ctxt hs_ty = sep [ ptext (sLit "In") <+> pprUserTypeCtxt ctxt <> co
 
     pp_n_colon n = ppr n <+> dcolon <+> ppr (unLoc hs_ty)
 
 
     pp_n_colon n = ppr n <+> dcolon <+> ppr (unLoc hs_ty)
 

-wobblyPatSig :: [Var] -> SDoc
-wobblyPatSig sig_tvs
-  = hang (ptext (sLit "A pattern type signature cannot bind scoped type variables") 
-               <+> pprQuotedList sig_tvs)
-       2 (ptext (sLit "unless the pattern has a rigid type context"))
-               

 badPatSigTvs :: TcType -> [TyVar] -> SDoc
 badPatSigTvs sig_ty bad_tvs
   = vcat [ fsep [ptext (sLit "The type variable") <> plural bad_tvs, 
 badPatSigTvs :: TcType -> [TyVar] -> SDoc
 badPatSigTvs sig_ty bad_tvs
   = vcat [ fsep [ptext (sLit "The type variable") <> plural bad_tvs, 

@@ -1045,12 +1032,6 @@ badPatSigTvs sig_ty bad_tvs
          , ptext (sLit "To fix this, expand the type synonym") 
          , ptext (sLit "[Note: I hope to lift this restriction in due course]") ]
 
          , ptext (sLit "To fix this, expand the type synonym") 
          , ptext (sLit "[Note: I hope to lift this restriction in due course]") ]
 

-scopedNonVar :: Name -> Type -> SDoc
-scopedNonVar n ty
-  = vcat [sep [ptext (sLit "The scoped type variable") <+> quotes (ppr n),
-              nest 2 (ptext (sLit "is bound to the type") <+> quotes (ppr ty))],
-         nest 2 (ptext (sLit "You can only bind scoped type variables to type variables"))]
-

 dupInScope :: Name -> Name -> Type -> SDoc
 dupInScope n n' _
   = hang (ptext (sLit "The scoped type variables") <+> quotes (ppr n) <+> ptext (sLit "and") <+> quotes (ppr n'))
 dupInScope :: Name -> Name -> Type -> SDoc
 dupInScope n n' _
   = hang (ptext (sLit "The scoped type variables") <+> quotes (ppr n) <+> ptext (sLit "and") <+> quotes (ppr n'))