Very small tweaks to pave the way for solving kind constraints in the simplifier.
authorDimitrios Vytiniotis <dimitris@microsoft.com>
Thu, 22 Dec 2011 11:36:09 +0000 (11:36 +0000)
committerDimitrios Vytiniotis <dimitris@microsoft.com>
Thu, 22 Dec 2011 11:36:09 +0000 (11:36 +0000)
compiler/typecheck/TcRnMonad.lhs
compiler/typecheck/TcRnTypes.lhs
compiler/types/TypeRep.lhs

index 381d535..08125d7 100644 (file)
@@ -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) }
index ab26fa1..b85a892 100644 (file)
@@ -66,7 +66,8 @@ module TcRnTypes(
         Implication(..),
         CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin,
        CtOrigin(..), EqOrigin(..), 
-        WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt,
+        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
index 3458b63..26526ab 100644 (file)
@@ -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