Commit a1a507a1 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor SetLevels.abstractVars

This patch is pure refactoring: using utility functions
rather than special-purpose code, especially for closeOverKinds
parent 9d600ea6
......@@ -88,6 +88,7 @@ import Demand ( StrictSig, Demand, isStrictDmd, splitStrictSig, increa
import Name ( getOccName, mkSystemVarName )
import OccName ( occNameString )
import Type ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType )
import TyCoRep ( closeOverKindsDSet )
import BasicTypes ( Arity, RecFlag(..), isRec )
import DataCon ( dataConOrigResTy )
import TysWiredIn
......@@ -1558,17 +1559,14 @@ abstractVars :: Level -> LevelEnv -> DVarSet -> [OutVar]
-- Uniques are not deterministic.
abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs
= -- NB: sortQuantVars might not put duplicates next to each other
map zap $ sortQuantVars $ uniq
[out_var | out_fv <- dVarSetElems (substDVarSet subst in_fvs)
, out_var <- dVarSetElems (close out_fv)
, abstract_me out_var ]
map zap $ sortQuantVars $
filter abstract_me $
dVarSetElems $
closeOverKindsDSet $
substDVarSet subst in_fvs
-- NB: it's important to call abstract_me only on the OutIds the
-- come from substDVarSet (not on fv, which is an InId)
where
uniq :: [Var] -> [Var]
-- Remove duplicates, preserving order
uniq = dVarSetElems . mkDVarSet
abstract_me v = case lookupVarEnv lvl_env v of
Just lvl -> dest_lvl `ltLvl` lvl
Nothing -> False
......@@ -1581,12 +1579,6 @@ abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs
setIdInfo v vanillaIdInfo
| otherwise = v
close :: Var -> DVarSet -- Close over variables free in the type
-- Result includes the input variable itself
close v = foldDVarSet (unionDVarSet . close)
(unitDVarSet v)
(fvDVarSet $ varTypeTyCoFVs v)
type LvlM result = UniqSM result
initLvl :: UniqSupply -> UniqSM a -> a
......
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