X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSetLevels.lhs;h=f4bdc82638a2ece4b441e55857689e1f0af9b884;hb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;hp=7427ad4c2ca390c8d1625744de13bd0c39e6f6fe;hpb=f01a8e8c9c53bfb5ab3393ed3457ebf25390efa1;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs
index 7427ad4..f4bdc82 100644
--- a/ghc/compiler/simplCore/SetLevels.lhs
+++ b/ghc/compiler/simplCore/SetLevels.lhs
@@ -21,7 +21,7 @@ module SetLevels (
 -- not exported: , incMajorLvl, isTopMajLvl, unTopify
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import AnnCoreSyn
 import CoreSyn
@@ -47,7 +47,7 @@ import UniqSupply	( thenUs, returnUs, mapUs, mapAndUnzipUs,
 			  mapAndUnzip3Us, getUnique, UniqSM(..)
 			)
 import Usage		( UVar(..) )
-import Util		( mapAccumL, zipWithEqual, panic, assertPanic )
+import Util		( mapAccumL, zipWithEqual, zipEqual, panic, assertPanic )
 
 isLeakFreeType x y = False -- safe option; ToDo
 \end{code}
@@ -214,7 +214,7 @@ lvlBind ctxt_lvl envs@(venv, tenv) (AnnRec pairs)
 	binders_w_lvls = binders `zip` repeat final_lvl
 	new_envs       = (growIdEnvList venv binders_w_lvls, tenv)
     in
-    returnLvl (extra_binds ++ [Rec (binders_w_lvls `zip` rhss')], new_envs)
+    returnLvl (extra_binds ++ [Rec (zipEqual "lvlBind" binders_w_lvls rhss')], new_envs)
   where
     (binders,rhss) = unzip pairs
 \end{code}
@@ -568,11 +568,11 @@ type lambdas.
 \begin{code}
 decideRecFloatLevel ctxt_lvl envs@(venv, tenv) ids rhss
   | isTopMajLvl ids_only_lvl   &&		-- Destination = top
-    not (all canFloatToTop (tys `zip` rhss))	-- Some can't float to top
+    not (all canFloatToTop (zipEqual "decideRec" tys rhss)) -- Some can't float to top
   = 	-- Pin it here
     let
 	ids_w_lvls = ids `zip` repeat ctxt_lvl
-	new_envs       = (growIdEnvList venv ids_w_lvls, tenv)
+	new_envs   = (growIdEnvList venv ids_w_lvls, tenv)
     in
     mapLvl (lvlExpr ctxt_lvl new_envs) rhss	`thenLvl` \ rhss' ->
     returnLvl (ctxt_lvl, [], rhss')
@@ -605,20 +605,20 @@ decideRecFloatLevel ctxt_lvl envs@(venv, tenv) ids rhss
     mapLvl (lvlExpr incd_lvl new_envs) rhss	`thenLvl` \ rhss' ->
     mapLvl newLvlVar poly_tys			`thenLvl` \ poly_vars ->
     let
-	ids_w_poly_vars = ids `zip` poly_vars
+	ids_w_poly_vars = zipEqual "decideRec2" ids poly_vars
 
 		-- The "d_rhss" are the right-hand sides of "D" and "D'"
 		-- in the documentation above
 	d_rhss = [ mkTyApp (Var poly_var) offending_tyvar_tys | poly_var <- poly_vars]
 
 		-- "local_binds" are "D'" in the documentation above
-	local_binds = zipWithEqual NonRec ids_w_incd_lvl d_rhss
+	local_binds = zipWithEqual "SetLevels" NonRec ids_w_incd_lvl d_rhss
 
 	poly_var_rhss = [ mkTyLam offending_tyvars (foldr Let rhs' local_binds)
 			| rhs' <- rhss'	-- mkCoLet* requires Core...
 			]
 
-	poly_binds  = [(poly_var, ids_only_lvl) | poly_var <- poly_vars] `zip` poly_var_rhss
+	poly_binds  = zipEqual "poly_binds" [(poly_var, ids_only_lvl) | poly_var <- poly_vars] poly_var_rhss
 
     in
     returnLvl (ctxt_lvl, [Rec poly_binds], d_rhss)