X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=64b347654d3dbe643babb6cfa7f7bde05ecf73d8;hb=9241ac84d10f7e6b23841da2c0765275072ad7c1;hp=e33b113ae783ddc8ea1f035743d455f245022c2a;hpb=ca53c38335cdc671f0b1e0949aa1514fc3fd72a5;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index e33b113..64b3476 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -216,6 +216,33 @@ dsLExpr (L loc e) = putSrcSpanDs loc $ dsExpr e
 
 dsExpr :: HsExpr Id -> DsM CoreExpr
 dsExpr (HsPar e) 	      = dsLExpr 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'] }
+dsExpr (HsHetMetCSP  c   e)   = do { e' <- dsExpr (unLoc e)
+                                 ; csp <- dsLookupGlobalId hetmet_csp_name
+                                 ; return $ mkApps (Var csp)  [ (Type c), (Type $ exprType e'), e'] }
 dsExpr (ExprWithTySigOut e _) = dsLExpr e
 dsExpr (HsVar var)     	      = return (Var var)
 dsExpr (HsIPVar ip)    	      = return (Var (ipNameName ip))
@@ -237,6 +264,7 @@ dsExpr (HsLam a_Match)
 
 dsExpr (HsApp fun arg)
   = mkCoreAppDs <$> dsLExpr fun <*>  dsLExpr arg
+
 \end{code}
 
 Operator sections.  At first it looks as if we can convert