Commit 221f409d authored by dimitris's avatar dimitris
Browse files

Very small tweaks to pave the way for solving kind constraints in the simplifier.

parent 82e19ffc
...@@ -23,6 +23,8 @@ import Module ...@@ -23,6 +23,8 @@ import Module
import RdrName import RdrName
import Name import Name
import Type import Type
import Kind ( isSuperKind )
import TcType import TcType
import InstEnv import InstEnv
import FamInstEnv import FamInstEnv
...@@ -1042,8 +1044,13 @@ captureUntouchables thing_inside ...@@ -1042,8 +1044,13 @@ captureUntouchables thing_inside
; return (res, TouchableRange low_meta high_meta) } ; return (res, TouchableRange low_meta high_meta) }
isUntouchable :: TcTyVar -> TcM Bool isUntouchable :: TcTyVar -> TcM Bool
isUntouchable tv = do { env <- getLclEnv isUntouchable tv
; return (varUnique tv < tcl_untch env) } -- Kind variables are always touchable
| isSuperKind (tyVarKind tv)
= return False
| otherwise
= do { env <- getLclEnv
; return (varUnique tv < tcl_untch env) }
getLclTypeEnv :: TcM TcTypeEnv getLclTypeEnv :: TcM TcTypeEnv
getLclTypeEnv = do { env <- getLclEnv; return (tcl_env env) } getLclTypeEnv = do { env <- getLclEnv; return (tcl_env env) }
......
...@@ -66,7 +66,8 @@ module TcRnTypes( ...@@ -66,7 +66,8 @@ module TcRnTypes(
Implication(..), Implication(..),
CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin, CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin,
CtOrigin(..), EqOrigin(..), CtOrigin(..), EqOrigin(..),
WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt, WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt,
pushErrCtxtSameOrigin,
SkolemInfo(..), SkolemInfo(..),
...@@ -1296,6 +1297,10 @@ setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c ...@@ -1296,6 +1297,10 @@ setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig
pushErrCtxt o err (CtLoc _ s errs) = CtLoc o s (err:errs) 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 pprArising :: CtOrigin -> SDoc
-- Used for the main, top-level error message -- Used for the main, top-level error message
-- We've done special processing for TypeEq and FunDep origins -- We've done special processing for TypeEq and FunDep origins
......
...@@ -274,7 +274,7 @@ isLiftedTypeKind _ = False ...@@ -274,7 +274,7 @@ isLiftedTypeKind _ = False
\begin{code} \begin{code}
tyVarsOfType :: Type -> VarSet tyVarsOfType :: Type -> VarSet
-- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym -- ^ 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 -- For example, tyVarsOfType (a::k) returns {a}, not including the
-- kind variable {k} -- kind variable {k}
tyVarsOfType (TyVarTy v) = unitVarSet v tyVarsOfType (TyVarTy v) = unitVarSet v
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment