[commit: ghc] wip/gadtpm: Replaced `pureGenInstSkolTyVarsX' with (the proper) `cloneTyVarBndrs' (e646f44)

[git at git.haskell.org]

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

On branch  : wip/gadtpm
Link       : http://ghc.haskell.org/trac/ghc/changeset/e646f44261501a29a71d0295a71e0bf6f9533763/ghc

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

commit e646f44261501a29a71d0295a71e0bf6f9533763
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Wed Jun 24 15:12:12 2015 +0200

    Replaced `pureGenInstSkolTyVarsX' with (the proper) `cloneTyVarBndrs'


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

e646f44261501a29a71d0295a71e0bf6f9533763
 compiler/deSugar/Check.hs     |  4 ++--
 compiler/typecheck/TcMType.hs | 36 ------------------------------------
 compiler/types/Type.hs        | 11 ++++++++++-
 3 files changed, 12 insertions(+), 39 deletions(-)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index c7a0632..eca9977 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -36,7 +36,7 @@ import TcType ( mkTcEqPred, toTcType, toTcTypeBag )
 import VarSet
 import Bag
 import ErrUtils
-import TcMType (pureGenInstSkolTyVarsX, genInstSkolTyVarsX)
+import TcMType (genInstSkolTyVarsX)
 import IOEnv (tryM, failM)
 
 import Data.Maybe (isJust)
@@ -631,7 +631,7 @@ mkOneConFull x usupply con = (con_abs, constraints)
     subst1  = zipTopTvSubst univ_tvs tc_args
 
     -- IS THE SECOND PART OF THE TUPLE THE SET OF FRESHENED EXISTENTIALS? MUST BE
-    (subst, ex_tvs') = pureGenInstSkolTyVarsX usupply1 noSrcSpan subst1 ex_tvs
+    (subst, ex_tvs') = cloneTyVarBndrs subst1 ex_tvs usupply1
 
     arguments  = mkConVars usupply2 (substTys subst arg_tys)      -- Constructor arguments (value abstractions)
     theta_cs   = substTheta subst (eqSpecPreds eq_spec ++ thetas) -- All the constraints bound by the constructor
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index aaa17ea..6276b92 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -30,11 +30,6 @@ module TcMType (
   -- Creating fresh type variables for pm checking
   genInstSkolTyVarsX,
 
-  -- Pure versions
-  pureGenInstSkolTyVarsX,
-  pureInstSkolTyVarsX,
-  pureInstSkolTyVarX,
-
   --------------------------------
   -- Creating new evidence variables
   newEvVar, newEvVars, newEq, newDict,
@@ -1017,34 +1012,3 @@ genInstSkolTyVarsX :: SrcSpan -> TvSubst -> [TyVar] -> TcRnIf gbl lcl (TvSubst,
 -- see Note [Kind substitution when instantiating]
 -- Get the location from the monad; this is a complete freshening operation
 genInstSkolTyVarsX loc subst tvs = instSkolTyVarsX (mkTcSkolTyVar loc False) subst tvs
-
--- PURE VERSIONS
-pureGenInstSkolTyVarsX :: UniqSupply -> SrcSpan -> TvSubst -> [TyVar] -> (TvSubst, [TcTyVar])
-pureGenInstSkolTyVarsX usupply loc subst tvs
-  = pureInstSkolTyVarsX usupply (mkTcSkolTyVar loc False) subst tvs
-
-pureInstSkolTyVarsX :: UniqSupply
-                    -> (Unique -> Name -> Kind -> TyVar)
-                    -> TvSubst
-                    -> [TyVar]
-                    -> (TvSubst, [TyVar])
-pureInstSkolTyVarsX us mk_tv subst
-  = mapAccumLU (pureInstSkolTyVarX mk_tv) (us,subst)
-  where
-    mapAccumLU :: (UniqSupply -> acc -> x -> (acc, y))
-               -> (UniqSupply, acc) -> [x] -> (acc, [y])
-    mapAccumLU f (u,s) []     = (s,[])
-    mapAccumLU f (u,s) (x:xs) = let (us1, us2) = splitUniqSupply u
-                                    (s' , y ) = f us1 s x
-                                    (s'', ys) = mapAccumLU f (us2,s') xs
-                                in  (s'', y:ys)
-
-pureInstSkolTyVarX :: (Unique -> Name -> Kind -> TyVar)
-                   -> UniqSupply -> TvSubst -> TyVar -> (TvSubst, TyVar)
-pureInstSkolTyVarX mk_tv usupply subst tyvar
-  = (extendTvSubst subst tyvar (mkTyVarTy new_tv), new_tv)
-  where
-    new_tv   = mk_tv (uniqFromSupply usupply) old_name kind
-    old_name = tyVarName tyvar
-    kind     = substTy subst (tyVarKind tyvar)
-
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index edc3067..ab4d2dc 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -122,7 +122,7 @@ module Type (
         -- ** Performing substitution on types and kinds
         substTy, substTys, substTyWith, substTysWith, substTheta,
         substTyVar, substTyVars, substTyVarBndr,
-        cloneTyVarBndr, deShadowTy, lookupTyVar,
+        cloneTyVarBndr, cloneTyVarBndrs, deShadowTy, lookupTyVar,
         substKiWith, substKisWith,
 
         -- * Pretty-printing
@@ -168,6 +168,7 @@ import CoAxiom
 
 -- others
 import Unique           ( Unique, hasKey )
+import UniqSupply       ( UniqSupply, takeUniqFromSupply )
 import BasicTypes       ( Arity, RepArity )
 import Util
 import ListSetOps       ( getNth )
@@ -1642,6 +1643,14 @@ cloneTyVarBndr (TvSubst in_scope tv_env) tv uniq
     tv' = setVarUnique tv uniq  -- Simply set the unique; the kind
                                 -- has no type variables to worry about
 
+cloneTyVarBndrs :: TvSubst -> [TyVar] -> UniqSupply -> (TvSubst, [TyVar])
+cloneTyVarBndrs subst []     _usupply = (subst, [])
+cloneTyVarBndrs subst (t:ts)  usupply = (subst'', tv:tvs)
+  where
+    (uniq, usupply') = takeUniqFromSupply usupply
+    (subst' , tv )   = cloneTyVarBndr subst t uniq
+    (subst'', tvs)   = cloneTyVarBndrs subst' ts usupply'
+
 {-
 ----------------------------------------------------
 -- Kind Stuff