X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fstranal%2FWorkWrap.lhs;h=faa26feab807179c37f3fba5e046eeaef022fde8;hb=33770e2e376005ff14a1d16b89f32b0d474425e2;hp=3af7e2d7c543ed08ecbbbe4899e2e533621045b6;hpb=d634ffcd96c0a5e895e10cade5e32282e8de0735;p=ghc-hetmet.git

diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 3af7e2d..faa26fe 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -40,6 +40,7 @@ import DynFlags
 import WwLib
 import Util		( lengthIs, notNull )
 import Outputable
+import MonadUtils
 \end{code}
 
 We take Core bindings whose binders have:
@@ -266,11 +267,12 @@ tryWW is_rec fn_id rhs
 
 ---------------------
 splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
-  = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) do
+  = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) 
+    (do {
 	-- The arity should match the signature
-    (work_demands, wrap_fn, work_fn) <- mkWwBodies fun_ty wrap_dmds res_info one_shots
-    work_uniq <- getUniqueM
-    let
+      (work_demands, wrap_fn, work_fn) <- mkWwBodies fun_ty wrap_dmds res_info one_shots
+    ; work_uniq <- getUniqueM
+    ; let
 	work_rhs = work_fn rhs
 	work_id  = mkWorkerId work_uniq fn_id (exprType work_rhs) 
 			`setInlinePragma` inline_prag
@@ -290,7 +292,7 @@ splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
 	wrap_rhs = wrap_fn work_id
 	wrap_id  = fn_id `setIdWorkerInfo` HasWorker work_id arity
 
-    return ([(work_id, work_rhs), (wrap_id, wrap_rhs)])
+    ; return ([(work_id, work_rhs), (wrap_id, wrap_rhs)]) })
 	-- Worker first, because wrapper mentions it
 	-- mkWwBodies has already built a wrap_rhs with an INLINE pragma wrapped around it
   where
@@ -309,7 +311,7 @@ splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
 -- Otherwise we spuriously float stuff out of case-expression join points,
 -- which is very annoying.
 get_one_shots (Lam b e)
-  | isId b    = isOneShotLambda b : get_one_shots e
+  | isIdVar b = isOneShotLambda b : get_one_shots e
   | otherwise = get_one_shots e
 get_one_shots (Note _ e) = get_one_shots e
 get_one_shots other	 = noOneShotInfo