[commit: ghc] ghc-kinds: Comments. (3bf80b2)

[José Pedro Magalhães]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-kinds

http://hackage.haskell.org/trac/ghc/changeset/3bf80b226f4a16a2b0619f6f52dbb25d638b1020

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

commit 3bf80b226f4a16a2b0619f6f52dbb25d638b1020
Author: Jose Pedro Magalhaes <jpm at cs.uu.nl>
Date:   Fri Oct 28 14:21:26 2011 +0100

    Comments.

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

 compiler/ghci/RtClosureInspect.hs   |    2 +-
 compiler/typecheck/TcHsSyn.lhs      |    2 --
 compiler/typecheck/TcInstDcls.lhs   |    2 +-
 compiler/typecheck/TcTyClsDecls.lhs |    2 +-
 compiler/types/Kind.lhs             |    8 +++-----
 compiler/types/TypeRep.lhs          |   28 +++++-----------------------
 6 files changed, 11 insertions(+), 33 deletions(-)

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 7867054..f900cb7 100755
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -1124,7 +1124,7 @@ zonkTerm = foldTermM (TermFoldM
 zonkRttiType :: TcType -> TcM Type
 -- Zonk the type, replacing any unbound Meta tyvars
 -- by skolems, safely out of Meta-tyvar-land
-zonkRttiType = zonkType (mkZonkTcTyVar zonk_unbound_meta mkTyVarTy) -- JPM
+zonkRttiType = zonkType (mkZonkTcTyVar zonk_unbound_meta mkTyVarTy)
   where
     zonk_unbound_meta tv 
       = ASSERT( isTcTyVar tv )
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 3e7b771..982bc35 100755
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -453,7 +453,6 @@ zonk_bind env sig_warn (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
     	    ; new_exports   <- mapM (zonkExport env3) exports
     	    ; return (new_val_binds, new_exports) } 
        ; sig_warn True (map abe_poly new_exports)
--- tyvars' <- mapM (updateTyVarKindM zonkTcKind) tyvars -- JPM
        ; return (AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs
                           , abs_ev_binds = new_ev_binds
 			  , abs_exports = new_exports, abs_binds = new_val_bind }) }
@@ -1049,7 +1048,6 @@ zonkVect env (HsNoVect v)
        }
 zonkVect env (HsVectTypeOut t ty)
   = do { ty' <- fmapMaybeM (zonkTcTypeToType env) ty
---   = do { ty' <- fmapMaybeM (zonkTypeZapping env) ty -- JPM
        ; return $ HsVectTypeOut t ty'
        }
 zonkVect _ (HsVectTypeIn _ _) = panic "TcHsSyn.zonkVect: HsVectTypeIn"
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index ab5f8a0..2308d86 100755
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -626,7 +626,7 @@ tcAssocDecl clas mini_env (L loc decl)
                  (badATErr clas (tyConName at_tc))
 
        -- See Note [Checking consistent instantiation]
-       ; zipWithM_ check_arg (tyConTyVars fam_tc) at_tys -- JPM restore
+       ; zipWithM_ check_arg (tyConTyVars fam_tc) at_tys
 
        ; return at_tc }
   where
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index daf4ace..88cdcf9 100755
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -283,7 +283,7 @@ getInitialKinds (L _ decl)
 	; inner_pairs <- get_inner_kinds decl
 	; return (main_pair : inner_pairs) }
   where
-    mk_arg_kind (UserTyVar _ _)        = newMetaKindVar
+    mk_arg_kind (UserTyVar _ _)        = newMetaKindVar -- liftedTypeKind -- JPM
     mk_arg_kind (KindedTyVar _ kind _) = scDsLHsKind kind
 
     mk_res_kind (TyFamily { tcdKind    = Just kind }) = scDsLHsKind kind
diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs
index 4e6acdb..9b26c8d 100755
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.lhs
@@ -267,14 +267,12 @@ isKiVar v = isSuperKind (varType v)
 
 -- Returns the free kind variables in a kind
 kiVarsOfKind :: Kind -> VarSet
-kiVarsOfKind = tyVarsOfTypeStratified
+kiVarsOfKind = tyVarsOfType
 
 kiVarsOfKinds :: [Kind] -> VarSet
-kiVarsOfKinds = tyVarsOfTypesStratified
-
-
--- About promoting a type to a kind
+kiVarsOfKinds = tyVarsOfTypes
 
+-- Datatype promotion
 isPromotableType :: Type -> Bool
 isPromotableType = go emptyVarSet
   where
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 0eb8d37..da4a965 100755
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -28,7 +28,6 @@ module TypeRep (
 
         -- Free variables
         tyVarsOfType, tyVarsOfTypes,
-        tyVarsOfTypeStratified, tyVarsOfTypesStratified,
 
         -- Substitutions
         TvSubst(..), TvSubstEnv
@@ -289,34 +288,17 @@ isLiftedTypeKind _                = False
 \begin{code}  
 tyVarsOfType :: Type -> VarSet
 -- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
--- tyVarsOfType returns the free type *and kind* variables of a type
--- For example, tyVarsOfType (a::k) returns {a,k}, not just {a}
--- See tyVarsOfTypeStratified for a function that returns only current level variables
-tyVarsOfType (TyVarTy v)         = unitVarSet v -- `unionVarSet` tyVarsOfType (tyVarKind v)
-	     	      		   	      	-- JPM Commenting out as experiment!
+-- tyVarsOfType returns only the free *type* variables of a type
+-- For example, tyVarsOfType (a::k) returns {a}, not including the
+-- kind variable {k}
+tyVarsOfType (TyVarTy v)         = unitVarSet v
 tyVarsOfType (TyConApp _ tys)    = tyVarsOfTypes tys
 tyVarsOfType (FunTy arg res)     = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 tyVarsOfType (AppTy fun arg)     = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
-tyVarsOfType (ForAllTy tyvar ty) = delVarSet (tyVarsOfType ty) tyvar -- `unionVarSet` tyVarsOfType (tyVarKind tyvar)
+tyVarsOfType (ForAllTy tyvar ty) = delVarSet (tyVarsOfType ty) tyvar
 
 tyVarsOfTypes :: [Type] -> TyVarSet
 tyVarsOfTypes tys = foldr (unionVarSet . tyVarsOfType) emptyVarSet tys
-
-tyVarsOfTypeStratified :: Type -> VarSet
--- only returns variables of the current level (don't look in kind signatures)
-tyVarsOfTypeStratified (TyVarTy v)
-  = unitVarSet v
-tyVarsOfTypeStratified (TyConApp _ tys)
-  = tyVarsOfTypesStratified tys
-tyVarsOfTypeStratified (FunTy arg res)
-  = tyVarsOfTypeStratified arg `unionVarSet` tyVarsOfTypeStratified res
-tyVarsOfTypeStratified (AppTy fun arg)
-  = tyVarsOfTypeStratified fun `unionVarSet` tyVarsOfTypeStratified arg
-tyVarsOfTypeStratified (ForAllTy tyvar ty)
-  = delVarSet (tyVarsOfTypeStratified ty) tyvar
-
-tyVarsOfTypesStratified :: [Type] -> VarSet
-tyVarsOfTypesStratified tys = foldr (unionVarSet . tyVarsOfTypeStratified) emptyVarSet tys
 \end{code}
 
 %************************************************************************