diff options
Diffstat (limited to 'compiler/simplCore/SetLevels.lhs')
| -rw-r--r-- | compiler/simplCore/SetLevels.lhs | 22 |
1 files changed, 9 insertions, 13 deletions
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 9af757c1af..7e3b44c7d5 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -78,7 +78,8 @@ import Literal ( litIsTrivial ) import Demand ( StrictSig, increaseStrictSigArity ) import Name ( getOccName, mkSystemVarName ) import OccName ( occNameString ) -import Type ( isUnLiftedType, Type ) +import Type ( isUnLiftedType, Type, sortQuantVars ) +import Kind ( kiVarsOfKinds ) import BasicTypes ( Arity ) import UniqSupply import Util @@ -996,22 +997,13 @@ abstractVars :: Level -> LevelEnv -> VarSet -> [Var] -- whose level is greater than the destination level -- These are the ones we are going to abstract out abstractVars dest_lvl (LE { le_lvl_env = lvl_env, le_env = id_env }) fvs - = map zap $ uniq $ sortLe le + = map zap $ uniq $ sortQuantVars -- IA0_NOTE: centralizing sorting on variables [var | fv <- varSetElems fvs , var <- absVarsOf id_env fv , abstract_me var ] -- NB: it's important to call abstract_me only on the OutIds the -- come from absVarsOf (not on fv, which is an InId) where - -- Sort the variables so the true type variables come first; - -- the tyvars scope over Ids and coercion vars - v1 `le` v2 = case (is_tv v1, is_tv v2) of - (True, False) -> True - (False, True) -> False - _ -> v1 <= v2 -- Same family - - is_tv v = isTyVar v - uniq :: [Var] -> [Var] -- Remove adjacent duplicates; the sort will have brought them together uniq (v1:v2:vs) | v1 == v2 = uniq (v2:vs) @@ -1036,7 +1028,9 @@ absVarsOf :: IdEnv ([Var], LevelledExpr) -> Var -> [Var] -- variables -- -- Also, if x::a is an abstracted variable, then so is a; that is, - -- we must look in x's type + -- we must look in x's type. What's more, if a mentions kind variables, + -- we must also return those. + -- -- And similarly if x is a coercion variable. absVarsOf id_env v | isId v = [av2 | av1 <- lookup_avs v @@ -1047,7 +1041,9 @@ absVarsOf id_env v Just (abs_vars, _) -> abs_vars Nothing -> [v] - add_tyvars v = v : varSetElems (varTypeTyVars v) + add_tyvars v = v : (varSetElems tyvars ++ varSetElems kivars) + tyvars = varTypeTyVars v + kivars = kiVarsOfKinds (map tyVarKind (varSetElems tyvars)) \end{code} \begin{code} |