Merge branch 'no-pred-ty'
[ghc.git] / compiler / typecheck / TcInstDcls.lhs
index 4eb6a2f..5026b56 100644 (file)
@@ -732,7 +732,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
                                 op_items ibinds
 
        -- Create the result bindings
-       ; self_dict <- newEvVar (ClassP clas inst_tys)
+       ; self_dict <- newDict clas inst_tys
        ; let class_tc      = classTyCon clas
              [dict_constr] = tyConDataCons class_tc
              dict_bind     = mkVarBind self_dict (L loc con_app_args)
@@ -758,7 +758,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
              mk_sc_ev_term :: EvVar -> EvTerm
              mk_sc_ev_term sc
                | null inst_tv_tys
-               , null dfun_ev_vars = evVarTerm sc
+               , null dfun_ev_vars = EvId sc
                | otherwise         = EvDFunApp sc inst_tv_tys dfun_ev_vars
 
              inst_tv_tys    = mkTyVarTys inst_tyvars
@@ -998,9 +998,9 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                  -- The 'let' is necessary only because HsSyn doesn't allow
                  -- you to apply a function to a dictionary *expression*.
 
-           ; self_dict <- newEvVar (ClassP clas inst_tys)
-           ; let self_ev_bind = EvBind self_dict $
-                                EvDFunApp dfun_id (mkTyVarTys tyvars) dfun_ev_vars
+           ; self_dict <- newDict clas inst_tys
+           ; let self_ev_bind = EvBind self_dict
+                                (EvDFunApp dfun_id (mkTyVarTys tyvars) dfun_ev_vars)
 
            ; (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars
                                                    inst_tys sel_id
@@ -1126,7 +1126,7 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
      mk_op_wrapper :: Id -> EvVar -> HsWrapper
      mk_op_wrapper sel_id rep_d
        = WpCast (liftCoSubstWith sel_tvs (map mkReflCo init_inst_tys ++ [co])
-                               local_meth_ty)
+                                 local_meth_ty)
          <.> WpEvApp (EvId rep_d)
          <.> mkWpTyApps (init_inst_tys ++ [rep_ty])
        where
@@ -1287,9 +1287,8 @@ Note carefullly:
 instDeclCtxt1 :: LHsType Name -> SDoc
 instDeclCtxt1 hs_inst_ty
   = inst_decl_ctxt (case unLoc hs_inst_ty of
-                        HsForAllTy _ _ _ (L _ (HsPredTy pred)) -> ppr pred
-                        HsPredTy pred                    -> ppr pred
-                        _                                -> ppr hs_inst_ty)     -- Don't expect this
+                        HsForAllTy _ _ _ (L _ ty') -> ppr ty'
+                        _                          -> ppr hs_inst_ty)     -- Don't expect this
 instDeclCtxt2 :: Type -> SDoc
 instDeclCtxt2 dfun_ty
   = inst_decl_ctxt (ppr (mkClassPred cls tys))