Completely new treatment of INLINE pragmas (big patch)

[ghc-hetmet.git] / compiler / coreSyn / CoreFVs.lhs

diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs
index dedc4c0..a15362a 100644 (file)
--- a/compiler/coreSyn/CoreFVs.lhs
+++ b/compiler/coreSyn/CoreFVs.lhs
@@ -16,6 +16,7 @@ Taken quite directly from the Peyton Jones/Lester paper.
 module CoreFVs (
         -- * Free variables of expressions and binding groups
        exprFreeVars,   -- CoreExpr   -> VarSet -- Find all locally-defined free Ids or tyvars
+       exprFreeIds,    -- CoreExpr   -> IdSet  -- Find all locally-defined free Ids
        exprsFreeVars,  -- [CoreExpr] -> VarSet
        bindFreeVars,   -- CoreBind   -> VarSet
 
@@ -25,7 +26,8 @@ module CoreFVs (
        exprFreeNames, exprsFreeNames,
 
         -- * Free variables of Rules, Vars and Ids
-       idRuleVars, idFreeVars, varTypeTyVars, 
+       idRuleVars, idRuleRhsVars, idFreeVars, idInlineFreeVars,
+       varTypeTyVars, 
        ruleRhsFreeVars, rulesFreeVars,
        ruleLhsFreeNames, ruleLhsFreeIds, 
 
@@ -71,6 +73,10 @@ but not those that are free in the type of variable occurrence.
 exprFreeVars :: CoreExpr -> VarSet
 exprFreeVars = exprSomeFreeVars isLocalVar
 
+-- | Find all locally-defined free Ids in an expression
+exprFreeIds :: CoreExpr -> IdSet       -- Find all locally-defined free Ids
+exprFreeIds = exprSomeFreeVars isLocalId
+
 -- | Find all locally-defined free Ids or type variables in several expressions
 exprsFreeVars :: [CoreExpr] -> VarSet
 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
@@ -194,7 +200,7 @@ expr_fvs (Let (Rec pairs) body)
 
 ---------
 rhs_fvs :: (Id,CoreExpr) -> FV
-rhs_fvs (bndr, rhs) = expr_fvs rhs `union` someVars (idRuleVars bndr)
+rhs_fvs (bndr, rhs) = expr_fvs rhs `union` someVars (bndrRuleVars bndr)
        -- Treat any RULES as extra RHSs of the binding
 
 ---------
@@ -373,8 +379,29 @@ varTypeTyVars var
 idFreeVars :: Id -> VarSet
 idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` varTypeTyVars id
 
+bndrRuleVars ::Var -> VarSet
+bndrRuleVars v | isTyVar v = emptyVarSet
+              | otherwise = idRuleVars v
+
 idRuleVars ::Id -> VarSet
-idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
+idRuleVars id = ASSERT( isId id) 
+               specInfoFreeVars (idSpecialisation id) `unionVarSet` 
+               idInlineFreeVars id     -- And the variables in an INLINE rule
+
+idRuleRhsVars :: Id -> VarSet
+-- Just the variables free on the *rhs* of a rule
+-- See Note [Choosing loop breakers] in Simplify.lhs
+idRuleRhsVars id = foldr (unionVarSet . ruleRhsFreeVars) 
+                        (idInlineFreeVars id)
+                        (idCoreRules id)
+
+idInlineFreeVars :: Id -> VarSet
+-- Produce free vars for an InlineRule, BUT NOT for an ordinary unfolding
+-- An InlineRule behaves *very like* a RULE, and that is what we are after here
+idInlineFreeVars id
+  = case idUnfolding id of
+       InlineRule { uf_tmpl = tmpl } -> exprFreeVars tmpl
+       _                                  -> emptyVarSet
 \end{code}
 
 
@@ -425,7 +452,7 @@ freeVars (Case scrut bndr ty alts)
                             rhs2 = freeVars rhs
 
 freeVars (Let (NonRec binder rhs) body)
-  = (freeVarsOf rhs2 `unionFVs` body_fvs `unionFVs` idRuleVars binder,
+  = (freeVarsOf rhs2 `unionFVs` body_fvs `unionFVs` bndrRuleVars binder,
                -- Remember any rules; cf rhs_fvs above
      AnnLet (AnnNonRec binder rhs2) body2)
   where