Fix do-notation so that it works with -DDEBUG

diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 37d5d81..67dc39c 100644 (file)
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -805,10 +805,10 @@ specDefn subst calls (fn, rhs)
               rhs_uds `plusUDs` plusUDList spec_uds)
 
   | otherwise  -- No calls or RHS doesn't fit our preconceptions
-  = WARN( notNull calls_for_me, ptext SLIT("Missed specialisation opportunity for") <+> ppr fn ) do
+  = WARN( notNull calls_for_me, ptext SLIT("Missed specialisation opportunity for") <+> ppr fn )
          -- Note [Specialisation shape]
-    (rhs', rhs_uds) <- specExpr subst rhs
-    return ((fn, rhs'), [], rhs_uds)
+    (do  { (rhs', rhs_uds) <- specExpr subst rhs
+       ; return ((fn, rhs'), [], rhs_uds) })
   
   where
     fn_type           = idType fn

diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index a6f9bed..8bd89c0 100644 (file)
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -267,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
@@ -291,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