Big tidy-up of deriving code

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

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 10bfed7..fe7b1d8 100644 (file)
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -221,7 +221,7 @@ addFamInsts tycons thing_inside
     mkLocalFamInstTyThing (ATyCon tycon) = mkLocalFamInst tycon
     mkLocalFamInstTyThing tything       = pprPanic "TcInstDcls.addFamInsts"
                                                    (ppr tything)
-\end{code} 
+\end{code}
 
 \begin{code}
 tcLocalInstDecl1 :: LInstDecl Name 
@@ -240,11 +240,7 @@ tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags ats))
        ; checkTc (not is_boot || (isEmptyLHsBinds binds && null uprags))
                  badBootDeclErr
 
-       -- Typecheck the instance type itself.  We can't use 
-       -- tcHsSigType, because it's not a valid user type.
-       ; kinded_ty <- kcHsSigType poly_ty
-       ; poly_ty'  <- tcHsKindedType kinded_ty
-       ; let (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
+       ; (tyvars, theta, tau) <- tcHsInstHead poly_ty
        
        -- Next, process any associated types.
        ; idx_tycons <- mappM tcIdxTyInstDecl ats
@@ -611,7 +607,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags })
     newDictBndrs sc_loc sc_theta'                      `thenM` \ sc_dicts ->
     getInstLoc origin                                  `thenM` \ inst_loc -> 
     newDictBndrs inst_loc dfun_theta'                  `thenM` \ dfun_arg_dicts ->
-    newDictBndr inst_loc (mkClassPred clas inst_tys')  `thenM` \ this_dict ->
+    newDictBndr inst_loc (mkClassPred clas inst_tys')   `thenM` \ this_dict ->
                -- Default-method Ids may be mentioned in synthesised RHSs,
                -- but they'll already be in the environment.