[commit: ghc] wip/ghc-8.0-det: Kill varSetElems in markNominal (352391e)

git at git.haskell.org git at git.haskell.org
Thu Jul 14 13:53:41 UTC 2016


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

On branch  : wip/ghc-8.0-det
Link       : http://ghc.haskell.org/trac/ghc/changeset/352391e779365f5598a4c4422e24bcd0279d7dc8/ghc

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

commit 352391e779365f5598a4c4422e24bcd0279d7dc8
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


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

352391e779365f5598a4c4422e24bcd0279d7dc8
 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 a4b6537..53b1c08 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -31,7 +31,7 @@ module TcTyDecls(
 import TcRnMonad
 import TcEnv
 import TcBinds( tcRecSelBinds )
-import TyCoRep( Type(..), TyBinder(..), delBinderVar )
+import TyCoRep( Type(..), TyBinder(..), delBinderVarFV )
 import TcType
 import TysWiredIn( unitTy )
 import MkCore( rEC_SEL_ERROR_ID )
@@ -61,6 +61,7 @@ import Maybes
 import Data.List
 import Bag
 import FastString
+import FV
 
 import Control.Monad
 
@@ -726,21 +727,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 7054ed5..59799e1 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