-fixLNE_srt :: SRT -> StgExpr -> StgExpr
-fixLNE_srt all_srt (StgLetNoEscape live1 live2 (StgNonRec id rhs) body)
- = StgLetNoEscape live1 live2 (StgNonRec id rhs) (fixLNE [id] all_srt body)
-
-fixLNE_srt all_srt (StgLetNoEscape live1 live2 (StgRec pairs) body)
- = StgLetNoEscape live1 live2
- (StgRec (map fixLNE_rec pairs)) (fixLNE binders all_srt body)
- where
- binders = map fst pairs
- fixLNE_rec (id,StgRhsClosure cc bi srt fvs uf args e) =
- (id, StgRhsClosure cc bi srt fvs uf args (fixLNE binders srt e))
- fixLNE_rec (id,con) = (id,con)
-
-fixLNE :: [Id] -> SRT -> StgExpr -> StgExpr
-
-fixLNE ids srt expr@(StgCase scrut live rhs_live bndr old_srt alts)
- | any (`elementOfUniqSet` rhs_live) ids
- = StgCase scrut live rhs_live bndr srt (fixLNE_alts ids srt alts)
- | otherwise = expr
- -- can't be in the scrutinee, because it's a let-no-escape!
-
-fixLNE ids srt expr@(StgLetNoEscape live rhs_live bind body)
- | any (`elementOfUniqSet` rhs_live) ids =
- StgLetNoEscape live rhs_live (fixLNE_bind ids srt bind)
- (fixLNE ids srt body)
- | any (`elementOfUniqSet` live) ids =
- StgLetNoEscape live rhs_live bind (fixLNE ids srt body)
- | otherwise = expr
-
-fixLNE ids srt (StgLet bind body) = StgLet bind (fixLNE ids srt body)
-fixLNE ids srt (StgSCC cc expr) = StgSCC cc (fixLNE ids srt expr)
-fixLNE ids srt expr = expr
-
-fixLNE_alts ids srt (StgAlgAlts t alts dflt)
- = StgAlgAlts t (map (fixLNE_algalt ids srt) alts) (fixLNE_dflt ids srt dflt)
-
-fixLNE_alts ids srt (StgPrimAlts t alts dflt)
- = StgPrimAlts t (map (fixLNE_primalt ids srt) alts) (fixLNE_dflt ids srt dflt)
-
-fixLNE_algalt ids srt (con,args,used,rhs) = (con,args,used, fixLNE ids srt rhs)
-fixLNE_primalt ids srt (lit,rhs) = (lit, fixLNE ids srt rhs)
-
-fixLNE_dflt ids srt (StgNoDefault) = StgNoDefault
-fixLNE_dflt ids srt (StgBindDefault rhs) = StgBindDefault (fixLNE ids srt rhs)
-
-fixLNE_bind ids srt (StgNonRec bndr rhs)
- = StgNonRec bndr (fixLNE_rhs ids srt rhs)
-fixLNE_bind ids srt (StgRec pairs)
- = StgRec [ (bndr, fixLNE_rhs ids srt rhs) | (bndr,rhs) <- pairs ]
-
-fixLNE_rhs ids srt rhs@(StgRhsClosure cc bi old_srt fvs uf args expr)
- | any (`elem` fvs) ids
- = StgRhsClosure cc bi srt fvs uf args (fixLNE ids srt expr)
- | otherwise = rhs
-fixLNE_rhs ids srt rhs@(StgRhsCon cc con args) = rhs
-