Commit fb236fbb authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Fix do-notation so that it works with -DDEBUG

parent d8c0a66c
...@@ -805,10 +805,10 @@ specDefn subst calls (fn, rhs) ...@@ -805,10 +805,10 @@ specDefn subst calls (fn, rhs)
rhs_uds `plusUDs` plusUDList spec_uds) rhs_uds `plusUDs` plusUDList spec_uds)
| otherwise -- No calls or RHS doesn't fit our preconceptions | 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] -- Note [Specialisation shape]
(rhs', rhs_uds) <- specExpr subst rhs (do { (rhs', rhs_uds) <- specExpr subst rhs
return ((fn, rhs'), [], rhs_uds) ; return ((fn, rhs'), [], rhs_uds) })
where where
fn_type = idType fn fn_type = idType fn
......
...@@ -267,11 +267,12 @@ tryWW is_rec fn_id rhs ...@@ -267,11 +267,12 @@ tryWW is_rec fn_id rhs
--------------------- ---------------------
splitFun fn_id fn_info wrap_dmds res_info inline_prag 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 -- The arity should match the signature
(work_demands, wrap_fn, work_fn) <- mkWwBodies fun_ty wrap_dmds res_info one_shots (work_demands, wrap_fn, work_fn) <- mkWwBodies fun_ty wrap_dmds res_info one_shots
work_uniq <- getUniqueM ; work_uniq <- getUniqueM
let ; let
work_rhs = work_fn rhs work_rhs = work_fn rhs
work_id = mkWorkerId work_uniq fn_id (exprType work_rhs) work_id = mkWorkerId work_uniq fn_id (exprType work_rhs)
`setInlinePragma` inline_prag `setInlinePragma` inline_prag
...@@ -291,7 +292,7 @@ splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs ...@@ -291,7 +292,7 @@ splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
wrap_rhs = wrap_fn work_id wrap_rhs = wrap_fn work_id
wrap_id = fn_id `setIdWorkerInfo` HasWorker work_id arity 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 -- Worker first, because wrapper mentions it
-- mkWwBodies has already built a wrap_rhs with an INLINE pragma wrapped around it -- mkWwBodies has already built a wrap_rhs with an INLINE pragma wrapped around it
where where
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment