[commit: ghc] master: Exposing a useful assertion which was hidden inside a lazyness cloud. (bd13338)

dimitris at microsoft.com dimitris at microsoft.com
Thu Dec 15 17:57:04 CET 2011


Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/bd13338da1649600b6a63ae7cbf60a35575940dc

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

commit bd13338da1649600b6a63ae7cbf60a35575940dc
Author: Dimitrios Vytiniotis <dimitris at microsoft.com>
Date:   Thu Dec 15 14:18:31 2011 +0000

    Exposing a useful assertion which was hidden inside a lazyness cloud.

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

 compiler/typecheck/TcInteract.lhs |   15 +++++++++------
 1 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index 93f499a..45e89a8 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -746,9 +746,9 @@ doInteractWithInert
               -- situation for these and even if we did we'd have to be very careful to only
               -- create Derived's and not Wanteds. 
 
-              else let fd_eqns = improveFromAnother inert_pred_loc work_item_pred_loc
-                       wloc    = get_workitem_wloc fl2 
-                   in rewriteWithFunDeps fd_eqns tys2 wloc
+              else do { let fd_eqns = improveFromAnother inert_pred_loc work_item_pred_loc
+                      ; wloc  <- get_workitem_wloc fl2 
+                      ; rewriteWithFunDeps fd_eqns tys2 wloc }
                       -- See Note [Efficient Orientation], [When improvement happens]
 
        ; case any_fundeps of
@@ -764,9 +764,12 @@ doInteractWithInert
                -> do { emitFDWorkAsDerived fd_work (cc_depth workItem)
                      ; irKeepGoing "Cls/Cls (new fundeps)" } -- Just keep going without droping the inert 
        }
-  where get_workitem_wloc (Wanted wl)  = wl 
-        get_workitem_wloc (Derived wl) = wl 
-        get_workitem_wloc (Given {})   = panic "Unexpected given!"
+  where get_workitem_wloc (Wanted wl)  = return wl 
+        get_workitem_wloc (Derived wl) = return wl 
+        get_workitem_wloc (Given {})   = pprPanic "Unexpected given workitem!" $
+                                         vcat [ text "Work item =" <+> ppr workItem
+                                              , text "Inert item=" <+> ppr inertItem
+                                              ]
 
 
 -- Two pieces of irreducible evidence: if their types are *exactly identical* we can





More information about the Cvs-ghc mailing list