projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1996-07-25 20:43:49 by partain]
[ghc-hetmet.git]
/
ghc
/
compiler
/
coreSyn
/
FreeVars.lhs
diff --git
a/ghc/compiler/coreSyn/FreeVars.lhs
b/ghc/compiler/coreSyn/FreeVars.lhs
index
8879ffe
..
979fd67
100644
(file)
--- a/
ghc/compiler/coreSyn/FreeVars.lhs
+++ b/
ghc/compiler/coreSyn/FreeVars.lhs
@@
-13,32
+13,32
@@
module FreeVars (
addTopBindsFVs,
freeVarsOf, freeTyVarsOf,
addTopBindsFVs,
freeVarsOf, freeTyVarsOf,
- FVCoreExpr(..), FVCoreBinding(..),
+ SYN_IE(FVCoreExpr), SYN_IE(FVCoreBinding),
- CoreExprWithFVs(..), -- For the above functions
- AnnCoreExpr(..), -- Dito
+ SYN_IE(CoreExprWithFVs), -- For the above functions
+ SYN_IE(AnnCoreExpr), -- Dito
FVInfo(..), LeakInfo(..)
) where
FVInfo(..), LeakInfo(..)
) where
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
import AnnCoreSyn -- output
import CoreSyn
import Id ( idType, getIdArity, isBottomingId,
import AnnCoreSyn -- output
import CoreSyn
import Id ( idType, getIdArity, isBottomingId,
- emptyIdSet, singletonIdSet, mkIdSet,
+ emptyIdSet, unitIdSet, mkIdSet,
elementOfIdSet, minusIdSet, unionManyIdSets,
elementOfIdSet, minusIdSet, unionManyIdSets,
- IdSet(..)
+ SYN_IE(IdSet)
)
import IdInfo ( arityMaybe )
import PrimOp ( PrimOp(..) )
import Type ( tyVarsOfType )
)
import IdInfo ( arityMaybe )
import PrimOp ( PrimOp(..) )
import Type ( tyVarsOfType )
-import TyVar ( emptyTyVarSet, singletonTyVarSet, minusTyVarSet,
+import TyVar ( emptyTyVarSet, unitTyVarSet, minusTyVarSet,
intersectTyVarSets,
intersectTyVarSets,
- TyVarSet(..)
+ SYN_IE(TyVarSet)
)
import UniqSet ( unionUniqSets )
)
import UniqSet ( unionUniqSets )
-import Usage ( UVar(..) )
+import Usage ( SYN_IE(UVar) )
import Util ( panic, assertPanic )
\end{code}
import Util ( panic, assertPanic )
\end{code}
@@
-74,8
+74,8
@@
data FVInfo
noFreeIds = emptyIdSet
noFreeTyVars = emptyTyVarSet
noFreeAnything = (noFreeIds, noFreeTyVars)
noFreeIds = emptyIdSet
noFreeTyVars = emptyTyVarSet
noFreeAnything = (noFreeIds, noFreeTyVars)
-aFreeId i = singletonIdSet i
-aFreeTyVar t = singletonTyVarSet t
+aFreeId i = unitIdSet i
+aFreeTyVar t = unitTyVarSet t
is_among = elementOfIdSet
munge_id_ty i = tyVarsOfType (idType i)
combine = unionUniqSets -- used both for {Id,TyVar}Sets
is_among = elementOfIdSet
munge_id_ty i = tyVarsOfType (idType i)
combine = unionUniqSets -- used both for {Id,TyVar}Sets
@@
-171,13
+171,13
@@
fvExpr id_cands tyvar_cands (Lam (UsageBinder uvar) body)
= panic "fvExpr:Lam UsageBinder"
fvExpr id_cands tyvar_cands (Lam b@(ValBinder binder) body)
= panic "fvExpr:Lam UsageBinder"
fvExpr id_cands tyvar_cands (Lam b@(ValBinder binder) body)
- = (FVInfo (freeVarsOf body2 `minusIdSet` singletonIdSet binder)
+ = (FVInfo (freeVarsOf body2 `minusIdSet` unitIdSet binder)
(freeTyVarsOf body2 `combine` munge_id_ty binder)
leakiness,
AnnLam b body2)
where
-- We need to collect free tyvars from the binders
(freeTyVarsOf body2 `combine` munge_id_ty binder)
leakiness,
AnnLam b body2)
where
-- We need to collect free tyvars from the binders
- body2 = fvExpr (singletonIdSet binder `combine` id_cands) tyvar_cands body
+ body2 = fvExpr (unitIdSet binder `combine` id_cands) tyvar_cands body
leakiness = case leakinessOf body2 of
MightLeak -> LeakFree 1
leakiness = case leakinessOf body2 of
MightLeak -> LeakFree 1
@@
-295,6
+295,15
@@
fvExpr id_cands tyvar_cands (SCC label expr)
= (fvinfo, AnnSCC label expr2)
where
expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
= (fvinfo, AnnSCC label expr2)
where
expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
+
+fvExpr id_cands tyvar_cands (Coerce c ty expr)
+ = (FVInfo (freeVarsOf expr2)
+ (freeTyVarsOf expr2 `combine` tfvs)
+ (leakinessOf expr2),
+ AnnCoerce c ty expr2)
+ where
+ expr2 = fvExpr id_cands tyvar_cands expr
+ tfvs = freeTy tyvar_cands ty
\end{code}
\begin{code}
\end{code}
\begin{code}
@@
-412,7
+421,7
@@
addExprFVs fv_cand in_scope (Lam binder body)
TyBinder t -> (TyBinder t, emptyIdSet)
UsageBinder u -> (UsageBinder u, emptyIdSet)
ValBinder b -> (ValBinder (b, lam_fvs),
TyBinder t -> (TyBinder t, emptyIdSet)
UsageBinder u -> (UsageBinder u, emptyIdSet)
ValBinder b -> (ValBinder (b, lam_fvs),
- singletonIdSet b)
+ unitIdSet b)
new_in_scope = in_scope `combine` binder_set
(new_body, body_fvs) = addExprFVs fv_cand new_in_scope body
new_in_scope = in_scope `combine` binder_set
(new_body, body_fvs) = addExprFVs fv_cand new_in_scope body
@@
-477,6
+486,11
@@
addExprFVs fv_cand in_scope (SCC label expr)
= (SCC label expr2, expr_fvs)
where
(expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
= (SCC label expr2, expr_fvs)
where
(expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
+
+addExprFVs fv_cand in_scope (Coerce c ty expr)
+ = (Coerce c ty expr2, expr_fvs)
+ where
+ (expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
\end{code}
\begin{code}
\end{code}
\begin{code}