[commit: ghc] master: Tiny refactor (fea9a75)

git at git.haskell.org git at git.haskell.org
Tue May 16 14:47:12 UTC 2017


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

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

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

commit fea9a7570dd6fd8d2b690bc378af01db3662dbdb
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue May 16 15:42:34 2017 +0100

    Tiny refactor


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

fea9a7570dd6fd8d2b690bc378af01db3662dbdb
 compiler/typecheck/TcInteract.hs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 5792dfb..4368fcb 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -1739,17 +1739,21 @@ improve_top_fun_eqs fam_envs fam_tc args rhs_ty
   -- see Note [Type inference for type families with injectivity]
   | isOpenTypeFamilyTyCon fam_tc
   , Injective injective_args <- familyTyConInjectivityInfo fam_tc
+  , let fam_insts = lookupFamInstEnvByTyCon fam_envs fam_tc
   = -- it is possible to have several compatible equations in an open type
     -- family but we only want to derive equalities from one such equation.
-    concatMapM (injImproveEqns injective_args) (take 1 $
-      buildImprovementData (lookupFamInstEnvByTyCon fam_envs fam_tc)
-                           fi_tvs fi_tys fi_rhs (const Nothing))
+    do { let improvs = buildImprovementData fam_insts
+                           fi_tvs fi_tys fi_rhs (const Nothing)
+
+       ; traceTcS "improve_top_fun_eqs2" (ppr improvs)
+       ; concatMapM (injImproveEqns injective_args) $
+         take 1 improvs }
 
   | Just ax <- isClosedSynFamilyTyConWithAxiom_maybe fam_tc
   , Injective injective_args <- familyTyConInjectivityInfo fam_tc
   = concatMapM (injImproveEqns injective_args) $
-      buildImprovementData (fromBranches (co_ax_branches ax))
-                           cab_tvs cab_lhs cab_rhs Just
+    buildImprovementData (fromBranches (co_ax_branches ax))
+                         cab_tvs cab_lhs cab_rhs Just
 
   | otherwise
   = return []



More information about the ghc-commits mailing list