Commit e9123102 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Use isFamFreeTyCon now we have it

Refactoring only
parent 6305674f
...@@ -19,7 +19,6 @@ import TyCoRep -- performs delicate algorithm on types ...@@ -19,7 +19,6 @@ import TyCoRep -- performs delicate algorithm on types
import Coercion import Coercion
import Var import Var
import VarEnv import VarEnv
import NameEnv
import Outputable import Outputable
import TcSMonad as TcS import TcSMonad as TcS
import BasicTypes( SwapFlag(..) ) import BasicTypes( SwapFlag(..) )
...@@ -895,19 +894,16 @@ flatten_one (AppTy ty1 ty2) ...@@ -895,19 +894,16 @@ flatten_one (AppTy ty1 ty2)
role2 co2 xi2 ty2 role2 co2 xi2 ty2
role1 ) } -- output should match fmode role1 ) } -- output should match fmode
flatten_one ty@(TyConApp tc tys) flatten_one (TyConApp tc tys)
-- Expand type synonyms that mention type families -- Expand type synonyms that mention type families
-- on the RHS; see Note [Flattening synonyms] -- on the RHS; see Note [Flattening synonyms]
| Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
, let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys'
= do { mode <- getMode = do { mode <- getMode
; let used_tcs = tyConsOfType rhs
; case mode of ; case mode of
FM_FlattenAll | anyNameEnv isTypeFamilyTyCon used_tcs FM_FlattenAll | not (isFamFreeTyCon tc)
-> do { traceFlat "flatten_one syn expand" (ppr ty $$ ppr used_tcs) -> flatten_one expanded_ty
; flatten_one expanded_ty } _ -> flatten_ty_con_app tc tys }
_ -> do { traceFlat "flatten_one syn no expand" (ppr ty)
; flatten_ty_con_app tc tys } }
-- Otherwise, it's a type function application, and we have to -- Otherwise, it's a type function application, and we have to
-- flatten it away as well, and generate a new given equality constraint -- flatten it away as well, and generate a new given equality constraint
......
...@@ -627,7 +627,7 @@ data TyCon ...@@ -627,7 +627,7 @@ data TyCon
synIsTau :: Bool, -- True <=> the RHS of this synonym does not synIsTau :: Bool, -- True <=> the RHS of this synonym does not
-- have any foralls, after expanding any -- have any foralls, after expanding any
-- nested synonyms -- nested synonyms
synIsFamFree :: Bool -- True <=> the RHS of this synonym does mention synIsFamFree :: Bool -- True <=> the RHS of this synonym does not mention
-- any type synonym families (data families -- any type synonym families (data families
-- are fine), again after expanding any -- are fine), again after expanding any
-- nested synonyms -- nested synonyms
......
...@@ -767,7 +767,7 @@ test('T9872c', ...@@ -767,7 +767,7 @@ test('T9872c',
test('T9872d', test('T9872d',
[ only_ways(['normal']), [ only_ways(['normal']),
compiler_stats_num_field('bytes allocated', compiler_stats_num_field('bytes allocated',
[(wordsize(64), 506691240, 5), [(wordsize(64), 478169352, 5),
# 2014-12-18 796071864 Initally created # 2014-12-18 796071864 Initally created
# 2014-12-18 739189056 Reduce type families even more eagerly # 2014-12-18 739189056 Reduce type families even more eagerly
# 2015-01-07 687562440 TrieMap leaf compression # 2015-01-07 687562440 TrieMap leaf compression
...@@ -775,6 +775,8 @@ test('T9872d', ...@@ -775,6 +775,8 @@ test('T9872d',
# 2015-12-11 566134504 TypeInType; see #11196 # 2015-12-11 566134504 TypeInType; see #11196
# 2016-02-08 534693648 Improved a bit by tyConRolesRepresentational # 2016-02-08 534693648 Improved a bit by tyConRolesRepresentational
# 2016-03-18 506691240 optimize Unify & zonking # 2016-03-18 506691240 optimize Unify & zonking
# 2016-12-05 478169352 using tyConIsTyFamFree, I think, but only
# a 1% improvement 482 -> 478
(wordsize(32), 264566040, 5) (wordsize(32), 264566040, 5)
# some date 328810212 # some date 328810212
# 2015-07-11 350369584 # 2015-07-11 350369584
......
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