[commit: ghc] master: Tiny refactor (79fb6e6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/79fb6e663908041eebc5a88987f67dd875326d94/ghc

>---------------------------------------------------------------

commit 79fb6e663908041eebc5a88987f67dd875326d94
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Nov 1 14:03:57 2016 +0000

    Tiny refactor
    
    Swap order of calls in genInst just to make
    the two cases the same
    
    Plus some alpha-renaming


>---------------------------------------------------------------

79fb6e663908041eebc5a88987f67dd875326d94
 compiler/typecheck/TcDeriv.hs    |  4 ++--
 compiler/typecheck/TcGenDeriv.hs | 10 +++++-----
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index af5e730..946ff2e 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -1367,9 +1367,9 @@ genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
                 , Just $ getName $ head $ tyConDataCons rep_tycon ) }
               -- See Note [Newtype deriving and unused constructors]
   | otherwise
-  = do { (meth_binds, deriv_stuff) <- genDerivStuff mechanism loc clas
+  = do { inst_spec <- newDerivClsInst theta spec
+       ; (meth_binds, deriv_stuff) <- genDerivStuff mechanism loc clas
                                         rep_tycon tys tvs
-       ; inst_spec <- newDerivClsInst theta spec
        ; doDerivInstErrorChecks2 clas inst_spec mechanism
        ; traceTc "newder" (ppr inst_spec)
        ; let inst_info
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index 6c44d0d..2408e42 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1600,7 +1600,7 @@ gen_Newtype_binds :: SrcSpan
                   -> Type    -- the representation type (already eta-reduced)
                   -> LHsBinds RdrName
 -- See Note [Newtype-deriving instances]
-gen_Newtype_binds loc cls inst_tvs cls_tys rhs_ty
+gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty
   = listToBag $ map mk_bind (classMethods cls)
   where
     coerce_RDR = getRdrName coerceId
@@ -1611,7 +1611,7 @@ gen_Newtype_binds loc cls inst_tvs cls_tys rhs_ty
                                          (FunRhs (L loc meth_RDR) Prefix)
                                          [] rhs_expr]
       where
-        Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty meth_id
+        Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty meth_id
 
         meth_RDR = getRdrName meth_id
 
@@ -1638,14 +1638,14 @@ mkCoerceClassMethEqn :: Class   -- the class being derived
 -- See Note [Newtype-deriving instances]
 -- The pair is the (from_type, to_type), where to_type is
 -- the type of the method we are tyrying to get
-mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty id
+mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id
   = Pair (substTy rhs_subst user_meth_ty)
          (substTy lhs_subst user_meth_ty)
   where
     cls_tvs = classTyVars cls
     in_scope = mkInScopeSet $ mkVarSet inst_tvs
-    lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs cls_tys)
-    rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast cls_tys rhs_ty))
+    lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs inst_tys)
+    rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast inst_tys rhs_ty))
     (_class_tvs, _class_constraint, user_meth_ty)
       = tcSplitMethodTy (varType id)