[commit: ghc] master: Refactor SetLevels.abstractVars (a1a507a)
git at git.haskell.org
git at git.haskell.org
Mon Jun 4 15:54:28 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/a1a507a1faefef550378758f5228bd01c78c4f25/ghc
>---------------------------------------------------------------
commit a1a507a1faefef550378758f5228bd01c78c4f25
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Jun 1 16:42:11 2018 +0100
Refactor SetLevels.abstractVars
This patch is pure refactoring: using utility functions
rather than special-purpose code, especially for closeOverKinds
>---------------------------------------------------------------
a1a507a1faefef550378758f5228bd01c78c4f25
compiler/simplCore/SetLevels.hs | 20 ++++++--------------
1 file changed, 6 insertions(+), 14 deletions(-)
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index 25b2018..65f7713 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -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
More information about the ghc-commits
mailing list