diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-05-17 09:44:46 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-05-17 09:47:21 +0100 |
| commit | d6461f9684f6f758320a5e5afbf0634fcc2996a5 (patch) | |
| tree | 746371a7a1dc34d12433e7e82a95ede213506a7b /compiler/coreSyn | |
| parent | d9e9a9b3016a05e6153de3803998877f91c6cdf4 (diff) | |
| download | haskell-d6461f9684f6f758320a5e5afbf0634fcc2996a5.tar.gz | |
Handle type-lets better
Core allows non-recursive type-lets, thus
let a = TYPE ty in ...
They are substituted away very quickly, but it's convenient for
some passes to produce them (rather than to have to substitute
immediately).
Trac #13708 tried the effect of not running the simplifer at all
(a rather bizarre thing to do, but still). That showed that some
passes crashed because they always treated a let-bounder binder
as an Id. This patch adds some easy fixes.
Diffstat (limited to 'compiler/coreSyn')
| -rw-r--r-- | compiler/coreSyn/CoreFVs.hs | 27 |
1 files changed, 10 insertions, 17 deletions
diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index 4dc1ed2f4a..f5343caf2b 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -31,7 +31,7 @@ module CoreFVs ( varTypeTyCoVars, varTypeTyCoFVs, idUnfoldingVars, idFreeVars, dIdFreeVars, - idRuleAndUnfoldingVars, idRuleAndUnfoldingVarsDSet, + bndrRuleAndUnfoldingVarsDSet, idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, @@ -626,22 +626,15 @@ idFVs :: Id -> FV -- Type variables, rule variables, and inline variables idFVs id = ASSERT( isId id) varTypeTyCoFVs id `unionFV` - idRuleAndUnfoldingFVs id + bndrRuleAndUnfoldingFVs id -bndrRuleAndUnfoldingFVs :: Var -> FV -bndrRuleAndUnfoldingFVs v | isTyVar v = emptyFV - | otherwise = idRuleAndUnfoldingFVs v - -idRuleAndUnfoldingVars :: Id -> VarSet -idRuleAndUnfoldingVars id = fvVarSet $ idRuleAndUnfoldingFVs id - -idRuleAndUnfoldingVarsDSet :: Id -> DVarSet -idRuleAndUnfoldingVarsDSet id = fvDVarSet $ idRuleAndUnfoldingFVs id - -idRuleAndUnfoldingFVs :: Id -> FV -idRuleAndUnfoldingFVs id = ASSERT( isId id) - idRuleFVs id `unionFV` idUnfoldingFVs id +bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet +bndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id +bndrRuleAndUnfoldingFVs :: Id -> FV +bndrRuleAndUnfoldingFVs id + | isId id = idRuleFVs id `unionFV` idUnfoldingFVs id + | otherwise = emptyFV idRuleVars ::Id -> VarSet -- Does *not* include CoreUnfolding vars idRuleVars id = fvVarSet $ idRuleFVs id @@ -690,7 +683,7 @@ freeVarsBind :: CoreBind freeVarsBind (NonRec binder rhs) body_fvs = ( AnnNonRec binder rhs2 , freeVarsOf rhs2 `unionFVs` body_fvs2 - `unionFVs` fvDVarSet (bndrRuleAndUnfoldingFVs binder) ) + `unionFVs` bndrRuleAndUnfoldingVarsDSet binder ) where rhs2 = freeVars rhs body_fvs2 = binder `delBinderFV` body_fvs @@ -702,7 +695,7 @@ freeVarsBind (Rec binds) body_fvs (binders, rhss) = unzip binds rhss2 = map freeVars rhss rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2 - binders_fvs = fvDVarSet $ mapUnionFV idRuleAndUnfoldingFVs binders + binders_fvs = fvDVarSet $ mapUnionFV bndrRuleAndUnfoldingFVs binders all_fvs = rhs_body_fvs `unionFVs` binders_fvs -- The "delBinderFV" happens after adding the idSpecVars, -- since the latter may add some of the binders as fvs |