import VarSet
import VarEnv
import TysWiredIn
-import TysPrim( intPrimTy )
+import TysPrim( intPrimTy, ecKind )
import PrimOp( tagToEnumKey )
import PrelNames
import Module
; expr' <- updHetMetLevel (\old_lev -> (fresh_ec_name:old_lev))
$ tcPolyExpr e elt_ty
; unifyType (TyVarTy fresh_ec_name) inferred_name
- ; return $ mkHsWrapCoI coi (HsHetMetBrak (TyVarTy fresh_ec_name) expr') }
+ ; return $ mkHsWrapCo coi (HsHetMetBrak (TyVarTy fresh_ec_name) expr') }
tcExpr (HsHetMetEsc _ _ e) res_ty =
do { cur_level <- getHetMetLevel
; expr' <- updHetMetLevel (\old_lev -> tail old_lev)
$ tcExpr (unLoc e) (mkTyConApp hetMetCodeTypeTyCon [(TyVarTy $ head cur_level),res_ty])
; ty' <- zonkTcType res_ty
- ; return $ mkHsWrapCoI (ACo res_ty) (HsHetMetEsc (TyVarTy $ head cur_level) ty' (noLoc expr')) }
+ ; return $ HsHetMetEsc (TyVarTy $ head cur_level) ty' (noLoc expr') }
tcExpr (HsHetMetCSP _ e) res_ty =
do { cur_level <- getHetMetLevel
; expr' <- updHetMetLevel (\old_lev -> tail old_lev)
$ tcExpr (unLoc e) res_ty
- ; return $ mkHsWrapCoI (ACo res_ty) (HsHetMetCSP (TyVarTy $ head cur_level) (noLoc expr')) }
+ ; return $ HsHetMetCSP (TyVarTy $ head cur_level) (noLoc expr') }
+
+tcExpr (HsKappa match) res_ty =
+ do { v1 <- newFlexiTyVar liftedTypeKind
+ ; v2 <- newFlexiTyVar liftedTypeKind
+ ; v3 <- newFlexiTyVar liftedTypeKind
+ ; (_, [ty_ab, ty_c]) <- matchExpectedTyConApp hetMetKappaTyCon res_ty
+ ; (_, [ty_a, ty_b]) <- matchExpectedTyConApp pairTyCon ty_ab
+ ; (co_fn, match') <- tcMatchLambda match (mkFunTy
+ (mkHetMetKappaTy unitTy ty_a)
+ (mkHetMetKappaTy ty_b ty_c))
+ ; return (HsKappa match') }
+
+tcExpr (HsKappaApp e1 e2) res_ty =
+ do { v1 <- newFlexiTyVar liftedTypeKind
+ ; v2 <- newFlexiTyVar liftedTypeKind
+ ; v3 <- newFlexiTyVar liftedTypeKind
+ ; e1' <- tcExpr (unLoc e1) (mkHetMetKappaTy (mkTyConApp pairTyCon [(TyVarTy v1), (TyVarTy v2)]) (TyVarTy v3))
+ ; e2' <- tcExpr (unLoc e2) (mkHetMetKappaTy unitTy (TyVarTy v1))
+ ; unifyType res_ty (mkHetMetKappaTy (TyVarTy v2) (TyVarTy v3))
+ ; return (HsKappaApp (noLoc e1') (noLoc e2')) }
tcExpr (HsApp e1 e2) res_ty = tcApp e1 [e2] res_ty