Commit 99119519 authored by Simon Marlow's avatar Simon Marlow

zap arity and strictness info when we wrap a bind with mkTick

Fixes some core-lint errors when compiling with profiling
parent 9df7f9b4
......@@ -37,7 +37,7 @@ module SimplEnv (
-- Floats
Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
doFloatFromRhs, getFloatBinds, getFloats, mapFloatRhss
doFloatFromRhs, getFloatBinds, getFloats, mapFloats
) where
#include "HsVersions.h"
......@@ -63,7 +63,6 @@ import BasicTypes
import MonadUtils
import Outputable
import FastString
import Util
import Data.List
\end{code}
......@@ -428,12 +427,12 @@ addNonRec env id rhs
env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
seInScope = extendInScopeSet (seInScope env) id }
mapFloatRhss :: SimplEnv -> (CoreExpr -> CoreExpr) -> SimplEnv
mapFloatRhss env@SimplEnv { seFloats = Floats fs ff } fun
mapFloats :: SimplEnv -> ((Id,CoreExpr) -> (Id,CoreExpr)) -> SimplEnv
mapFloats env@SimplEnv { seFloats = Floats fs ff } fun
= env { seFloats = Floats (mapOL app fs) ff }
where
app (NonRec b e) = NonRec b (fun e)
app (Rec bs) = Rec (mapSnd fun bs)
app (NonRec b e) = case fun (b,e) of (b',e') -> NonRec b' e'
app (Rec bs) = Rec (map fun bs)
extendFloats :: SimplEnv -> OutBind -> SimplEnv
-- Add these bindings to the floats, and extend the in-scope env too
......
......@@ -1062,7 +1062,11 @@ simplTick env tickish expr cont
= do { let (inc,outc) = splitCont cont
; (env', expr') <- simplExprF (zapFloats env) expr inc
; let tickish' = simplTickish env tickish
; let env'' = addFloats env (mapFloatRhss env' (mkTick (mkNoTick tickish')))
; let wrap_float (b,rhs) = (zapIdStrictness (setIdArity b 0),
mkTick (mkNoTick tickish') rhs)
-- when wrapping a float with mkTick, we better zap the Id's
-- strictness info and arity, because it might be wrong now.
; let env'' = addFloats env (mapFloats env' wrap_float)
; rebuild env'' expr' (TickIt tickish' outc)
}
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