Major Overhaul of Pattern Match Checking (Fixes #595)
[ghc.git] / compiler / typecheck / TcSimplify.hs
index b8e193b..fae58ad 100644 (file)
@@ -7,6 +7,7 @@ module TcSimplify(
        simplifyDefault,
        simplifyTop, simplifyInteractive,
        solveWantedsTcM,
+       tcCheckSatisfiability,
 
        -- For Rules we need these two
        solveWanteds, runTcS
@@ -360,6 +361,19 @@ simplifyDefault theta
 
        ; return () }
 
+------------------
+tcCheckSatisfiability :: Bag EvVar -> TcM Bool
+-- Return True if satisfiable, False if definitely contradictory
+tcCheckSatisfiability givens
+  = do { lcl_env <- TcRn.getLclEnv
+       ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env
+       ; traceTc "checkSatisfiabilty {" (ppr givens)
+       ; (res, _ev_binds) <- runTcS $
+             do { cts <- solveSimpleGivens given_loc (bagToList givens)
+                ; return (not (isEmptyBag cts)) }
+       ; traceTc "checkSatisfiabilty }" (ppr res)
+       ; return (not res) }
+
 {-
 *********************************************************************************
 *                                                                                 *