X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=86e8f0904a6b2db0339af14ffa8286ae76411fd2;hp=70592af07f84e65d60d0c43b9f81bf1940b1d5ce;hb=9241ac84d10f7e6b23841da2c0765275072ad7c1;hpb=f22c873e99d5b371a03d249febb89195a4fda2fc

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 70592af..86e8f09 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -186,6 +186,26 @@ tcExpr (HsHetMetCSP _ e) res_ty =
                    $ tcExpr (unLoc e) res_ty
        ; 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
 
 tcExpr (HsLit lit)   res_ty =