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

Fix Trac #2587: take account of type lets

GHC allows a non-recursive let for type varaibles
	let a = TYPE ty in ...
But the free-variable finder had not caught up with this
fact. This patch catches up.
parent 442e45db
...@@ -194,7 +194,7 @@ expr_fvs (Let (Rec pairs) body) ...@@ -194,7 +194,7 @@ expr_fvs (Let (Rec pairs) body)
--------- ---------
rhs_fvs :: (Id,CoreExpr) -> FV 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 -- Treat any RULES as extra RHSs of the binding
--------- ---------
...@@ -373,6 +373,10 @@ varTypeTyVars var ...@@ -373,6 +373,10 @@ varTypeTyVars var
idFreeVars :: Id -> VarSet idFreeVars :: Id -> VarSet
idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` varTypeTyVars id 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 -> VarSet
idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id) idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
\end{code} \end{code}
...@@ -425,7 +429,7 @@ freeVars (Case scrut bndr ty alts) ...@@ -425,7 +429,7 @@ freeVars (Case scrut bndr ty alts)
rhs2 = freeVars rhs rhs2 = freeVars rhs
freeVars (Let (NonRec binder rhs) body) 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 -- Remember any rules; cf rhs_fvs above
AnnLet (AnnNonRec binder rhs2) body2) AnnLet (AnnNonRec binder rhs2) body2)
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