[commit: ghc] wip/ext-solver: Bugfix: Pop model assumptions AFTER we're done with improvements. (bad08fd)

git at git.haskell.org git at git.haskell.org
Sun May 11 02:36:46 UTC 2014


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

On branch  : wip/ext-solver
Link       : http://ghc.haskell.org/trac/ghc/changeset/bad08fd9dffea4deb1f82b48857291f204939077/ghc

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

commit bad08fd9dffea4deb1f82b48857291f204939077
Author: Iavor S. Diatchki <iavor.diatchki at gmail.com>
Date:   Sat May 10 19:34:57 2014 -0700

    Bugfix: Pop model assumptions AFTER we're done with improvements.


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

bad08fd9dffea4deb1f82b48857291f204939077
 compiler/typecheck/TcTypeNats.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs
index 9d498ba..043cb11 100644
--- a/compiler/typecheck/TcTypeNats.hs
+++ b/compiler/typecheck/TcTypeNats.hs
@@ -969,14 +969,14 @@ solverImprove proc viRef withEv cts =
          do push
             mapM_ (assume . snd) ours
             status <- check
-            pop
 
             res <-
               case status of
 
                 -- Inconsistent: find a smaller example, then stop.
                 Unsat  ->
-                  do mbRes <- solverFindConstraidction proc viRef others ours
+                  do pop
+                     mbRes <- solverFindConstraidction proc viRef others ours
                      case mbRes of
                        Nothing ->
                          fail "Bug: Failed to reporoduce contradiciton."
@@ -984,12 +984,16 @@ solverImprove proc viRef withEv cts =
                          return $ ExtSolContradiction core rest
 
                 -- We don't know: treat as consistent.
-                Unknown -> return (ExtSolOk [])
+                Unknown -> do pop
+                              return (ExtSolOk [])
 
                 -- Consistent: try to compute derived work.
                 Sat ->
                   do m    <- solverGetModel proc =<< readIORef viRef
+
                      imps <- solverImproveModel proc viRef m
+                     pop
+
                      vi   <- readIORef viRef
 
                      let loc    = ctLoc oneOfOurs -- XXX: Better location?



More information about the ghc-commits mailing list