Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/221f409db51f210d5395ec13ef4bf0c0883ad939 >--------------------------------------------------------------- commit 221f409db51f210d5395ec13ef4bf0c0883ad939 Author: Dimitrios Vytiniotis <[email protected]> Date: Thu Dec 22 11:36:09 2011 +0000 Very small tweaks to pave the way for solving kind constraints in the simplifier. >--------------------------------------------------------------- compiler/typecheck/TcRnMonad.lhs | 11 +++++++++-- compiler/typecheck/TcRnTypes.lhs | 5 +++++ compiler/types/TypeRep.lhs | 2 +- 3 files changed, 15 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 381d535..08125d7 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -23,6 +23,8 @@ import Module import RdrName import Name import Type +import Kind ( isSuperKind ) + import TcType import InstEnv import FamInstEnv @@ -1042,8 +1044,13 @@ captureUntouchables thing_inside ; return (res, TouchableRange low_meta high_meta) } isUntouchable :: TcTyVar -> TcM Bool -isUntouchable tv = do { env <- getLclEnv - ; return (varUnique tv < tcl_untch env) } +isUntouchable tv + -- Kind variables are always touchable + | isSuperKind (tyVarKind tv) + = return False + | otherwise + = do { env <- getLclEnv + ; return (varUnique tv < tcl_untch env) } getLclTypeEnv :: TcM TcTypeEnv getLclTypeEnv = do { env <- getLclEnv; return (tcl_env env) } diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index ab26fa1..b85a892 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -67,6 +67,7 @@ module TcRnTypes( CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin, CtOrigin(..), EqOrigin(..), WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt, + pushErrCtxtSameOrigin, SkolemInfo(..), @@ -1296,6 +1297,10 @@ setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig pushErrCtxt o err (CtLoc _ s errs) = CtLoc o s (err:errs) +pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc orig -> CtLoc orig +-- Just add information w/o updating the origin! +pushErrCtxtSameOrigin err (CtLoc o s errs) = CtLoc o s (err:errs) + pprArising :: CtOrigin -> SDoc -- Used for the main, top-level error message -- We've done special processing for TypeEq and FunDep origins diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index 3458b63..26526ab 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -274,7 +274,7 @@ isLiftedTypeKind _ = False \begin{code} tyVarsOfType :: Type -> VarSet -- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym --- tyVarsOfType returns only the free *type* variables of a type +-- tyVarsOfType returns only the free variables of a type -- For example, tyVarsOfType (a::k) returns {a}, not including the -- kind variable {k} tyVarsOfType (TyVarTy v) = unitVarSet v _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
