[commit: ghc] type-nats: A function to get all constraints (unused at the moment) (240cd84)

Iavor Diatchki <[email protected]> Tue, 25 Dec 2012 21:05:39 -0800
Newsgroups gmane.comp.lang.haskell.cvs.ghc
Message-ID <[email protected]>
Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : type-nats

http://hackage.haskell.org/trac/ghc/changeset/240cd84a28e3c0b2092dd665d971777c3322fa61

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

commit 240cd84a28e3c0b2092dd665d971777c3322fa61
Author: Iavor S. Diatchki <[email protected]>
Date:   Tue Dec 25 20:59:24 2012 -0800

    A function to get all constraints (unused at the moment)

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

 compiler/typecheck/TcTypeNats.hs |    6 ++++++
 1 files changed, 6 insertions(+), 0 deletions(-)

diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs
index a1142ff..c2ac022 100644
--- a/compiler/typecheck/TcTypeNats.hs
+++ b/compiler/typecheck/TcTypeNats.hs
@@ -66,6 +66,7 @@ import TcSMonad ( TcS, emitInsoluble, setEvBind
                 , newFlexiTcSTy
                 , tyVarsOfCt
                 , newWantedEvVarNC
+                , foldFamHeadMap
                 )
 
 -- From base libraries
@@ -874,6 +875,11 @@ getEvCt =
                               $ inert_funeqs $ inert_cans is
   where hasEv c = isGivenCt c || isWantedCt c
 
+getAllCt :: TcS [Ct]
+getAllCt =
+  do is <- getTcSInerts
+     return $ foldFamHeadMap (:) [] $ inert_funeqs $ inert_cans is
+
 sameCt :: Ct -> Ct -> Bool
 sameCt c1 c2 = eqType (ctPred c1) (ctPred c2)