-dsExpr (HsHetMetBrak c e) = do { e' <- dsExpr (unLoc e)
- ; brak <- dsLookupGlobalId hetmet_brak_name
- ; return $ mkApps (Var brak) [ (Type c), (Type $ exprType e'), e'] }
-dsExpr (HsHetMetEsc c t e) = do { e' <- dsExpr (unLoc e)
- ; esc <- dsLookupGlobalId hetmet_esc_name
- ; return $ mkApps (Var esc) [ (Type c), (Type t), e'] }
+dsExpr (HsHetMetBrak c e) =
+ do { e' <- dsExpr (unLoc e)
+ ; brak <- dsLookupGlobalId hetmet_brak_name
+ ; return $ mkApps (Var brak) [ (Type c), (Type $ exprType e'), e'] }
+dsExpr (HsHetMetEsc c t e) =
+ do { e' <- dsExpr (unLoc e)
+ ; esc <- dsLookupGlobalId hetmet_esc_name
+ ; return $ mkApps (Var esc) [ (Type c), (Type t), e'] }
+dsExpr (HsKappa a_Match) =
+ do { e' <- dsExpr (HsLam a_Match)
+ ; let ([ua],bc) = tcSplitFunTys (exprType e')
+ ; let (_,[_,a]) = tcSplitAppTys ua
+ ; let (_,[b,c]) = tcSplitAppTys bc
+ ; kap <- dsLookupGlobalId hetmet_kappa_name
+ ; return $ mkApps (Var kap) [ (Type a), (Type b), (Type c), e'] }
+dsExpr (HsKappaApp e1 e2) =
+ do { e1' <- dsExpr (unLoc e1)
+ ; e2' <- dsExpr (unLoc e2)
+ ; let (_,[_ ,a]) = tcSplitAppTys $ exprType e2'
+ ; let (_,[ab,c]) = tcSplitAppTys $ exprType e1'
+ ; let (_,[a,b]) = tcSplitAppTys $ ab
+ ; kap_app <- dsLookupGlobalId hetmet_kappa_app_name
+ ; return $ mkApps (Var kap_app) [ (Type a), (Type b), (Type c), e1', e2'] }