Fix do-notation so that it works with -DDEBUG

[ghc-hetmet.git] / compiler / stranal / WorkWrap.lhs

diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 3af7e2d..8bd89c0 100644 (file)
--- 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