diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-11-24 12:26:24 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-11-25 17:46:50 +0000 |
commit | a5a392649b10f956aaf3c84ac9321e242a383bbe (patch) | |
tree | 61692100e02b2e80a2d07de6e665581d05374257 /compiler/iface | |
parent | 83a952d14012ff4706a366a3155712f8caa69ead (diff) | |
download | haskell-a5a392649b10f956aaf3c84ac9321e242a383bbe.tar.gz |
Kill off ifaceTyVarsOfType
IfaceTypes are really not well suited to finding free variables etc.
Nevertheless, there was quite a lot of code to do just that; but it
was only used to see if a kind is variable-free so as to decide
whether to print a forall binder.
This patch simplifies to deal with just that case, replacing all
the free-vars stuff with just ifTypeIsVarFree
Diffstat (limited to 'compiler/iface')
-rw-r--r-- | compiler/iface/IfaceType.hs | 90 |
1 files changed, 21 insertions, 69 deletions
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index d6a9a212e1..a797b9e88e 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -63,7 +63,6 @@ import Binary import Outputable import FastString import FastStringEnv -import UniqSet import UniqFM import Util @@ -321,73 +320,26 @@ ifTyConBinderTyVar = binderVar ifTyConBinderName :: IfaceTyConBinder -> IfLclName ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb) -ifTyVarsOfType :: IfaceType -> UniqSet IfLclName -ifTyVarsOfType ty - = case ty of - IfaceTyVar v -> unitUniqSet v - IfaceAppTy fun arg - -> ifTyVarsOfType fun `unionUniqSets` ifTyVarsOfType arg - IfaceFunTy arg res - -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res - IfaceDFunTy arg res - -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res - IfaceForAllTy bndr ty - -> let (free, bound) = ifTyVarsOfForAllBndr bndr in - delListFromUniqSet (ifTyVarsOfType ty) bound `unionUniqSets` free - IfaceTyConApp _ args -> ifTyVarsOfArgs args - IfaceLitTy _ -> emptyUniqSet - IfaceCastTy ty co - -> ifTyVarsOfType ty `unionUniqSets` ifTyVarsOfCoercion co - IfaceCoercionTy co -> ifTyVarsOfCoercion co - IfaceTupleTy _ _ args -> ifTyVarsOfArgs args - -ifTyVarsOfForAllBndr :: IfaceForAllBndr - -> ( UniqSet IfLclName -- names used free in the binder - , [IfLclName] ) -- names bound by this binder -ifTyVarsOfForAllBndr (TvBndr (name, kind) _) = (ifTyVarsOfType kind, [name]) - -ifTyVarsOfArgs :: IfaceTcArgs -> UniqSet IfLclName -ifTyVarsOfArgs args = argv emptyUniqSet args - where - argv vs (ITC_Vis t ts) = argv (vs `unionUniqSets` (ifTyVarsOfType t)) ts - argv vs (ITC_Invis k ks) = argv (vs `unionUniqSets` (ifTyVarsOfType k)) ks - argv vs ITC_Nil = vs - -ifTyVarsOfCoercion :: IfaceCoercion -> UniqSet IfLclName -ifTyVarsOfCoercion = go +ifTypeIsVarFree :: IfaceType -> Bool +-- Returns True if the type definitely has no variables at all +-- Just used to control pretty printing +ifTypeIsVarFree ty = go ty where - go (IfaceReflCo _ ty) = ifTyVarsOfType ty - go (IfaceFunCo _ c1 c2) = go c1 `unionUniqSets` go c2 - go (IfaceTyConAppCo _ _ cos) = ifTyVarsOfCoercions cos - go (IfaceAppCo c1 c2) = go c1 `unionUniqSets` go c2 - go (IfaceForAllCo (bound, _) kind_co co) - = go co `delOneFromUniqSet` bound `unionUniqSets` go kind_co - go (IfaceCoVarCo cv) = unitUniqSet cv - go (IfaceAxiomInstCo _ _ cos) = ifTyVarsOfCoercions cos - go (IfaceUnivCo p _ ty1 ty2) = go_prov p `unionUniqSets` - ifTyVarsOfType ty1 `unionUniqSets` - ifTyVarsOfType ty2 - go (IfaceSymCo co) = go co - go (IfaceTransCo c1 c2) = go c1 `unionUniqSets` go c2 - go (IfaceNthCo _ co) = go co - go (IfaceLRCo _ co) = go co - go (IfaceInstCo c1 c2) = go c1 `unionUniqSets` go c2 - go (IfaceCoherenceCo c1 c2) = go c1 `unionUniqSets` go c2 - go (IfaceKindCo co) = go co - go (IfaceSubCo co) = go co - go (IfaceAxiomRuleCo rule cos) - = unionManyUniqSets - [ unitUniqSet rule - , ifTyVarsOfCoercions cos ] - - go_prov IfaceUnsafeCoerceProv = emptyUniqSet - go_prov (IfacePhantomProv co) = go co - go_prov (IfaceProofIrrelProv co) = go co - go_prov (IfacePluginProv _) = emptyUniqSet - go_prov (IfaceHoleProv _) = emptyUniqSet - -ifTyVarsOfCoercions :: [IfaceCoercion] -> UniqSet IfLclName -ifTyVarsOfCoercions = foldr (unionUniqSets . ifTyVarsOfCoercion) emptyUniqSet + go (IfaceTyVar {}) = False + go (IfaceTcTyVar {}) = False + go (IfaceAppTy fun arg) = go fun && go arg + go (IfaceFunTy arg res) = go arg && go res + go (IfaceDFunTy arg res) = go arg && go res + go (IfaceForAllTy {}) = False + go (IfaceTyConApp _ args) = go_args args + go (IfaceTupleTy _ _ args) = go_args args + go (IfaceLitTy _) = True + go (IfaceCastTy {}) = False -- Safe + go (IfaceCoercionTy {}) = False -- Safe + + go_args ITC_Nil = True + go_args (ITC_Vis arg args) = go arg && go_args args + go_args (ITC_Invis arg args) = go arg && go_args args {- Substitutions on IfaceType. This is only used during pretty-printing to construct @@ -927,8 +879,8 @@ pprUserIfaceForAll tvs ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $ pprIfaceForAll tvs where - tv_has_kind_var bndr - = not (isEmptyUniqSet (fst (ifTyVarsOfForAllBndr bndr))) + tv_has_kind_var (TvBndr (_,kind) _) = not (ifTypeIsVarFree kind) + ------------------- |