[commit: ghc] : Eliminate strings from assertions, since they pretty print like lists (6d92f39)

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

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/6d92f39fbfd2bb744160a82750433485290bad19

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

commit 6d92f39fbfd2bb744160a82750433485290bad19
Author: Max Bolingbroke <[email protected]>
Date:   Fri Jul 1 13:33:13 2011 +0100

    Eliminate strings from assertions, since they pretty print like lists

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

 .../supercompile/Supercompile/Drive/Process.hs     |    4 ++--
 compiler/supercompile/Supercompile/Drive/Split.hs  |   12 ++++++------
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/Process.hs b/compiler/supercompile/Supercompile/Drive/Process.hs
index 2ea0870..64e6764 100644
--- a/compiler/supercompile/Supercompile/Drive/Process.hs
+++ b/compiler/supercompile/Supercompile/Drive/Process.hs
@@ -140,7 +140,7 @@ supercompile unfoldings e = pprTraceSC "unfoldings" (ppr (M.keys unfoldings)) $
 --
 -- TODO: have the garbage collector collapse (let x = True in x) to (True) -- but note that this requires onceness analysis
 gc :: State -> (PureHeap, State)
-gc _state@(deeds0, Heap h ids, k, in_e) = ASSERT2(isEmptyVarSet (stateUncoveredVars gced_state), ppr ("gc", stateUncoveredVars gced_state, PrettyDoc (pPrintFullState _state), PrettyDoc (pPrintFullState gced_state)))
+gc _state@(deeds0, Heap h ids, k, in_e) = ASSERT2(isEmptyVarSet (stateUncoveredVars gced_state), ppr (stateUncoveredVars gced_state, PrettyDoc (pPrintFullState _state), PrettyDoc (pPrintFullState gced_state)))
                                           (h_dead, gced_state)
   where
     gced_state = (deeds2, Heap h' ids, k', in_e)
@@ -443,7 +443,7 @@ promise p x' opt = ScpM $ \e s k -> {- traceRender ("promise", fun p, abstracted
                         in k () (s { fulfilments = fs' })
       
       fmap (((abstracted_set `unionVarSet` stateLetBounders (unI (meaning p))) `unionVarSet`) . mkVarSet) getPromiseNames >>=
-        \fvs -> ASSERT2(optimised_fvs `subVarSet` fvs, ppr ("sc: FVs", fun p, optimised_fvs `minusVarSet` fvs, fvs, optimised_e)) return ()
+        \fvs -> ASSERT2(optimised_fvs `subVarSet` fvs, ppr (fun p, optimised_fvs `minusVarSet` fvs, fvs, optimised_e)) return ()
       
       return (a, var (fun p) `tyVarIdApps` abstracted p)
 
diff --git a/compiler/supercompile/Supercompile/Drive/Split.hs b/compiler/supercompile/Supercompile/Drive/Split.hs
index ea0d788..f29aacc 100644
--- a/compiler/supercompile/Supercompile/Drive/Split.hs
+++ b/compiler/supercompile/Supercompile/Drive/Split.hs
@@ -171,11 +171,11 @@ generalise gen (deeds, Heap h ids, k, qa) = do
         NoGeneralisation -> Nothing
         AllEligible -> guard (not (IS.null gen_kfs) || not (isEmptyVarSet gen_xs'')) >> return (gen_kfs, gen_xs'')
           where gen_kfs = IS.fromList [i   | (i, kf) <- named_k, generaliseStackFrame gen kf]
-                gen_xs'' = mkVarSet [x'' | (x'', hb) <- M.toList h, generaliseHeapBinding gen x'' hb, ASSERT2(not (howBound hb == LambdaBound && isNothing (heapBindingTerm hb)), ppr ("Bad generalisation", x'', hb, heapBindingTag hb)) True]
+                gen_xs'' = mkVarSet [x'' | (x'', hb) <- M.toList h, generaliseHeapBinding gen x'' hb, ASSERT2(not (howBound hb == LambdaBound && isNothing (heapBindingTerm hb)), ppr (x'', hb, heapBindingTag hb)) True]
         StackFirst -> (guard (not (IS.null gen_kfs)) >> return (gen_kfs, emptyVarSet)) `mplus`
                       (guard (not (isEmptyVarSet gen_xs''))  >> return (IS.empty, gen_xs''))
           where gen_kfs = IS.fromList [i   | (i, kf) <- named_k, generaliseStackFrame gen kf]
-                gen_xs'' = mkVarSet [x'' | (x'', hb) <- M.toList h, generaliseHeapBinding gen x'' hb, ASSERT2(not (howBound hb == LambdaBound && isNothing (heapBindingTerm hb)), ppr ("Bad generalisation", x'', hb, heapBindingTag hb)) True]
+                gen_xs'' = mkVarSet [x'' | (x'', hb) <- M.toList h, generaliseHeapBinding gen x'' hb, ASSERT2(not (howBound hb == LambdaBound && isNothing (heapBindingTerm hb)), ppr (x'', hb, heapBindingTag hb)) True]
         DependencyOrder want_first -> listToMaybe ((if want_first then id else reverse) possibilities)
           where -- We consider possibilities starting from the root of the term -- i.e. the bottom of the stack.
                 -- This is motivated by how the interaction with subgraph generalisation for TreeFlip/TreeSum.
@@ -195,14 +195,14 @@ generalise gen (deeds, Heap h ids, k, qa) = do
                     (pending_hbs, unreached_hbs') = M.partitionWithKey (\x' _hb -> x' `elemVarSet` (pending_xs' `unionVarSet` extra_pending_xs')) unreached_hbs
                     
                     gen_kf_is = IS.fromList [i  | (i, kf) <- pending_kfs, generaliseStackFrame gen kf]
-                    gen_xs'' = mkVarSet [x'' | (x'', hb) <- M.toList pending_hbs, generaliseHeapBinding gen x'' hb, ASSERT2(not (howBound hb == LambdaBound && isNothing (heapBindingTerm hb)), ppr ("Bad generalisation", x'', hb, heapBindingTag hb)) True]
+                    gen_xs'' = mkVarSet [x'' | (x'', hb) <- M.toList pending_hbs, generaliseHeapBinding gen x'' hb, ASSERT2(not (howBound hb == LambdaBound && isNothing (heapBindingTerm hb)), ppr (x'', hb, heapBindingTag hb)) True]
                     
                     reached_xs' = M.foldrWithKey (\_x' hb fvs -> heapBindingFreeVars hb `unionVarSet` fvs)
                                                  (unionVarSets (map (stackFrameFreeVars . tagee . snd) pending_kfs))
                                                  pending_hbs
     
     -- If we can find some fraction of the stack or heap to drop that looks like it will be admissable, just residualise those parts and continue
-    pprTrace "generalise" (ppr ("gen_kfs", gen_kfs, "gen_xs'", gen_xs')) $ return ()
+    pprTrace "generalise: (gen_kfs, gen_xs')" (ppr (gen_kfs, gen_xs')) $ return ()
     
     let (ctxt_id, ctxt_ids) = takeUniqFromSupply splitterUniqSupply
     return $ \opt -> generaliseSplit opt ctxt_ids (gen_kfs, gen_xs') deeds (Heap h ids, named_k, \ids -> (qaScruts qa, oneBracketed (Once ctxt_id, denormalise (0, Heap M.empty ids, [], qa))))
@@ -458,7 +458,7 @@ optimiseSplit opt deeds bracketeds_heap bracketed_focus = do
     
     MASSERT2(noChange (sumMap (releaseBracketedDeeds releaseStateDeed) bracketeds_heap        + releaseBracketedDeeds releaseStateDeed bracketed_focus        + deeds)
                       (sumMap (releaseBracketedDeeds releaseStateDeed) bracketeds_deeded_heap + releaseBracketedDeeds releaseStateDeed bracketed_deeded_focus + deeds_initial),
-             ppr ("optimiseSplit: deeds lost or gained!", deeds, (deeds_initial, deeds_focus, deedss_heap)))
+             ppr (deeds, (deeds_initial, deeds_focus, deedss_heap)))
     
     -- 1) Recursively drive the focus itself
     let extra_statics = dataSetToVarSet (M.keysSet bracketeds_heap)
@@ -775,7 +775,7 @@ transitiveInline :: PureHeap          -- ^ What to inline. We have not claimed d
 transitiveInline init_h_inlineable _state@(deeds, Heap h ids, k, in_e)
     = -- (if not (S.null not_inlined_vs') then traceRender ("transitiveInline: generalise", not_inlined_vs') else id) $
       -- traceRender ("transitiveInline", "had bindings for", pureHeapBoundVars init_h_inlineable, "FVs were", state_fvs, "so inlining", pureHeapBoundVars h') $
-      ASSERT2(isEmptyVarSet (unnormalisedStateUncoveredVars final_state), ppr ("transitiveInline", M.keysSet h_inlineable, PrettyDoc $ pPrintFullUnnormalisedState _state, PrettyDoc $ pPrintFullUnnormalisedState final_state, unnormalisedStateUncoveredVars final_state, M.keysSet h', live'))
+      ASSERT2(isEmptyVarSet (unnormalisedStateUncoveredVars final_state), ppr (M.keysSet h_inlineable, PrettyDoc $ pPrintFullUnnormalisedState _state, PrettyDoc $ pPrintFullUnnormalisedState final_state, unnormalisedStateUncoveredVars final_state, M.keysSet h', live'))
       final_state
   where
     final_state = (deeds', Heap h' ids, k, in_e)