[commit: ghc] wip/new-flatten-skolems-Aug14: More flatten-skolem progress (9b5c9af)

git at git.haskell.org git at git.haskell.org
Fri Sep 26 15:51:36 UTC 2014


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

On branch  : wip/new-flatten-skolems-Aug14
Link       : http://ghc.haskell.org/trac/ghc/changeset/9b5c9aff4271f3f979c7c63b031e36d55d679c56/ghc

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

commit 9b5c9aff4271f3f979c7c63b031e36d55d679c56
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Sep 26 16:48:16 2014 +0100

    More flatten-skolem progress


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

9b5c9aff4271f3f979c7c63b031e36d55d679c56
 compiler/typecheck/Flattening-notes | 30 ++++++++++++++++++++++++++++++
 compiler/typecheck/Inst.lhs         |  2 +-
 compiler/typecheck/TcRnTypes.lhs    |  1 -
 compiler/typecheck/TcSMonad.lhs     |  1 -
 compiler/typecheck/TcUnify.lhs      |  2 +-
 5 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/Flattening-notes b/compiler/typecheck/Flattening-notes
index 77ab2fd..e3eecf3 100644
--- a/compiler/typecheck/Flattening-notes
+++ b/compiler/typecheck/Flattening-notes
@@ -27,6 +27,36 @@ ToDo:
 
 * Check orientation (isFlattenTyVar) in canEqTyVarTyVar
 
+----------------------
+Outer given is rewritten by an inner given, then there must have been an inner given equality, hence the “given-eq” flag will be true anyway.
+
+Inner given rewritten by outer, retains its level (ie. The inner one)
+
+--------------------
+Try: rewrite wanted with wanted only for fuvs (not all meta-tyvars)
+
+But:   fuv ~ alpha[0]
+       alpha[0] ~ fuv’
+Now we don’t see that fuv ~ fuv’, which is a problem for injectivity detection.
+
+Conclusion: rewrite watneds with wanted for all untouchables.
+
+skol ~ untch, must re-orieint to untch ~ skol, so that we can use it to rewrite.
+
+
+--------------
+f :: [a] -> [b] -> blah
+f (e1 :: F Int) (e2 :: F Int)
+
+we get
+   F Int ~ fuv
+   fuv ~ [alpha]
+   fuv ~ [beta]
+
+We want: alpha := beta (which might unlock something else).  So rewriting wanted with wanted helps here.
+
+
+
 ----------------------------------------
 typecheck/TcTypeNatSimple
 
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 242ff28..ed77706 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -504,7 +504,7 @@ addClsInstsErr herald ispecs
 tyVarsOfCt :: Ct -> TcTyVarSet
 tyVarsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })     = extendVarSet (tyVarsOfType xi) tv
 tyVarsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) = extendVarSet (tyVarsOfTypes tys) fsk
-tyVarsOfCt (CDictCan { cc_tyargs = tys }) 	         = tyVarsOfTypes tys
+tyVarsOfCt (CDictCan { cc_tyargs = tys })                = tyVarsOfTypes tys
 tyVarsOfCt (CIrredEvCan { cc_ev = ev })                  = tyVarsOfType (ctEvPred ev)
 tyVarsOfCt (CHoleCan { cc_ev = ev })                     = tyVarsOfType (ctEvPred ev)
 tyVarsOfCt (CNonCanonical { cc_ev = ev })                = tyVarsOfType (ctEvPred ev)
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 9a30468..ac87ac6 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -1888,7 +1888,6 @@ pprCtOrigin simple_origin
 
 ----------------
 pprCtO :: CtOrigin -> SDoc  -- Ones that are short one-liners
-pprCtO FlatSkolOrigin        = ptext (sLit "a given flatten-skolem")
 pprCtO (OccurrenceOf name)   = hsep [ptext (sLit "a use of"), quotes (ppr name)]
 pprCtO AppOrigin             = ptext (sLit "an application")
 pprCtO (SpecPragOrigin name) = hsep [ptext (sLit "a specialisation pragma for"), quotes (ppr name)]
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index b653d9e..9ba34e6 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -126,7 +126,6 @@ import Name
 import RdrName (RdrName, GlobalRdrEnv)
 import RnEnv (addUsedRdrNames)
 import Var
-import VarSet
 import VarEnv
 import VarSet
 import Outputable
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 389c4a3..789c6ff 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -451,7 +451,7 @@ newImplication skol_info skol_tvs given thing_inside
        ; env <- getLclEnv
        ; emitImplication $ Implic { ic_untch = untch
                                   , ic_skols = skol_tvs
-                                  , ic_fsks  = []
+                                  , ic_fsks  = emptyCts
                                   , ic_no_eqs = False
                                   , ic_given = given
                                   , ic_wanted = wanted



More information about the ghc-commits mailing list