[commit: ghc] master: Kill varSetElems in markNominal (f13a8d2)

git at git.haskell.org git at git.haskell.org
Tue Apr 26 20:01:36 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f13a8d219fbb16ece2bede66ac47f8599a86d3e2/ghc

>---------------------------------------------------------------

commit f13a8d219fbb16ece2bede66ac47f8599a86d3e2
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Tue Apr 26 13:04:08 2016 -0700

    Kill varSetElems in markNominal
    
    varSetElems introduces unnecessary nondeterminism and it was
    straighforward to just get a deterministic list.
    
    Test Plan: ./validate
    
    Reviewers: austin, goldfire, bgamari, simonmar, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2145
    
    GHC Trac Issues: #4012


>---------------------------------------------------------------

f13a8d219fbb16ece2bede66ac47f8599a86d3e2
 compiler/typecheck/TcTyDecls.hs | 21 +++++++++++----------
 compiler/types/TyCoRep.hs       |  2 +-
 2 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 6579b5f..bbfccc5 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -29,7 +29,7 @@ import TcRnMonad
 import TcEnv
 import TcBinds( tcRecSelBinds )
 import RnEnv( RoleAnnotEnv, lookupRoleAnnot )
-import TyCoRep( Type(..), TyBinder(..), delBinderVar )
+import TyCoRep( Type(..), TyBinder(..), delBinderVarFV )
 import TcType
 import TysWiredIn( unitTy )
 import MkCore( rEC_SEL_ERROR_ID )
@@ -59,6 +59,7 @@ import Maybes
 import Data.List
 import Bag
 import FastString
+import FV
 
 import Control.Monad
 
@@ -703,21 +704,21 @@ irExTyVars orig_tvs thing = go emptyVarSet orig_tvs
 
 markNominal :: TyVarSet   -- local variables
             -> Type -> RoleM ()
-markNominal lcls ty = let nvars = get_ty_vars ty `minusVarSet` lcls in
-                      mapM_ (updateRole Nominal) (varSetElems nvars)
+markNominal lcls ty = let nvars = fvVarList (FV.delFVs lcls $ get_ty_vars ty) in
+                      mapM_ (updateRole Nominal) nvars
   where
      -- get_ty_vars gets all the tyvars (no covars!) from a type *without*
      -- recurring into coercions. Recall: coercions are totally ignored during
      -- role inference. See [Coercions in role inference]
-    get_ty_vars (TyVarTy tv)     = unitVarSet tv
-    get_ty_vars (AppTy t1 t2)    = get_ty_vars t1 `unionVarSet` get_ty_vars t2
-    get_ty_vars (TyConApp _ tys) = foldr (unionVarSet . get_ty_vars) emptyVarSet tys
+    get_ty_vars (TyVarTy tv)     = FV.unitFV tv
+    get_ty_vars (AppTy t1 t2)    = get_ty_vars t1 `unionFV` get_ty_vars t2
+    get_ty_vars (TyConApp _ tys) = mapUnionFV get_ty_vars tys
     get_ty_vars (ForAllTy bndr ty)
-      = get_ty_vars ty `delBinderVar` bndr
-        `unionVarSet` (tyCoVarsOfType $ binderType bndr)
-    get_ty_vars (LitTy {})       = emptyVarSet
+      = delBinderVarFV bndr (get_ty_vars ty)
+        `unionFV` (tyCoFVsOfType $ binderType bndr)
+    get_ty_vars (LitTy {})       = emptyFV
     get_ty_vars (CastTy ty _)    = get_ty_vars ty
-    get_ty_vars (CoercionTy _)   = emptyVarSet
+    get_ty_vars (CoercionTy _)   = emptyFV
 
 -- like lookupRoles, but with Nominal tags at the end for oversaturated TyConApps
 lookupRolesX :: TyCon -> RoleM [Role]
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index b1aad56..118fd95 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -45,7 +45,7 @@ module TyCoRep (
 
         -- * Functions over binders
         binderType, delBinderVar, isInvisibleBinder, isVisibleBinder,
-        isNamedBinder, isAnonBinder,
+        isNamedBinder, isAnonBinder, delBinderVarFV,
 
         -- * Functions over coercions
         pickLR,



More information about the ghc-commits mailing list