projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Adjust code from manual merges
[ghc-hetmet.git]
/
compiler
/
coreSyn
/
CoreFVs.lhs
diff --git
a/compiler/coreSyn/CoreFVs.lhs
b/compiler/coreSyn/CoreFVs.lhs
index
fb6017e
..
22f7dc8
100644
(file)
--- a/
compiler/coreSyn/CoreFVs.lhs
+++ b/
compiler/coreSyn/CoreFVs.lhs
@@
-5,8
+5,9
@@
Taken quite directly from the Peyton Jones/Lester paper.
\begin{code}
module CoreFVs (
\begin{code}
module CoreFVs (
- exprFreeVars, -- CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
+ exprFreeVars, -- CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
exprsFreeVars, -- [CoreExpr] -> VarSet
exprsFreeVars, -- [CoreExpr] -> VarSet
+ bindFreeVars, -- CoreBind -> VarSet
exprSomeFreeVars, exprsSomeFreeVars,
exprFreeNames, exprsFreeNames,
exprSomeFreeVars, exprsSomeFreeVars,
exprFreeNames, exprsFreeNames,
@@
-59,6
+60,12
@@
exprFreeVars = exprSomeFreeVars isLocalVar
exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
+bindFreeVars :: CoreBind -> VarSet
+bindFreeVars (NonRec b r) = exprFreeVars r
+bindFreeVars (Rec prs) = addBndrs (map fst prs)
+ (foldr (union . rhs_fvs) noVars prs)
+ isLocalVar emptyVarSet
+
exprSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
-> CoreExpr
-> VarSet
exprSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
-> CoreExpr
-> VarSet
@@
-150,6
+157,7
@@
expr_fvs (Lit lit) = noVars
expr_fvs (Note _ expr) = expr_fvs expr
expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
expr_fvs (Note _ expr) = expr_fvs expr
expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
+expr_fvs (Cast expr co) = expr_fvs expr `union` someVars (tyVarsOfType co)
expr_fvs (Case scrut bndr ty alts)
= expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
expr_fvs (Case scrut bndr ty alts)
= expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
@@
-210,7
+218,8
@@
exprFreeNames e
go (Type ty) = tyClsNamesOfType ty -- Don't need free tyvars
go (App e1 e2) = go e1 `unionNameSets` go e2
go (Lam v e) = go e `delFromNameSet` varName v
go (Type ty) = tyClsNamesOfType ty -- Don't need free tyvars
go (App e1 e2) = go e1 `unionNameSets` go e2
go (Lam v e) = go e `delFromNameSet` varName v
- go (Note n e) = go e
+ go (Note n e) = go e
+ go (Cast e co) = go e `unionNameSets` tyClsNamesOfType co
go (Let (NonRec b r) e) = go e `unionNameSets` go r
go (Let (Rec prs) e) = exprsFreeNames (map snd prs) `unionNameSets` go e
go (Case e b ty as) = go e `unionNameSets` tyClsNamesOfType ty
go (Let (NonRec b r) e) = go e `unionNameSets` go r
go (Let (Rec prs) e) = exprsFreeNames (map snd prs) `unionNameSets` go e
go (Case e b ty as) = go e `unionNameSets` tyClsNamesOfType ty
@@
-397,13
+406,12
@@
freeVars (Let (Rec binds) body)
body2 = freeVars body
body_fvs = freeVarsOf body2
body2 = freeVars body
body_fvs = freeVarsOf body2
-freeVars (Note (Coerce to_ty from_ty) expr)
- = (freeVarsOf expr2 `unionFVs` tfvs1 `unionFVs` tfvs2,
- AnnNote (Coerce to_ty from_ty) expr2)
+
+freeVars (Cast expr co)
+ = (freeVarsOf expr2 `unionFVs` cfvs, AnnCast expr2 co)
where
where
- expr2 = freeVars expr
- tfvs1 = tyVarsOfType from_ty
- tfvs2 = tyVarsOfType to_ty
+ expr2 = freeVars expr
+ cfvs = tyVarsOfType co
freeVars (Note other_note expr)
= (freeVarsOf expr2, AnnNote other_note expr2)
freeVars (Note other_note expr)
= (freeVarsOf expr2, AnnNote other_note expr2)