X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsExpr.lhs;h=8ea0c4fbf57fe9c06e1fa2cc7f417d0d455f9dc9;hp=dd33cae373f5d836773c5bd94be8ea03728a038b;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=6a1aab7737016aa714b2ffec2b5657a18fac0e42

diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index dd33cae..8ea0c4f 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -106,6 +106,10 @@ data HsExpr id
 
   | HsApp     (LHsExpr id) (LHsExpr id) -- Application
 
+  | HsKappa    (MatchGroup id)
+
+  | HsKappaApp (LHsExpr id) (LHsExpr id)
+
   -- Operator applications:
   -- NB Bracketed ops such as (+) come out as Vars.
 
@@ -223,6 +227,13 @@ data HsExpr id
                 (LHsCmdTop id)          -- body of the abstraction
                                         -- always has an empty stack
 
+  -----------------------------------------------------------
+  -- Heterogeneous Metaprogramming extension
+
+  | HsHetMetBrak  PostTcType            (LHsExpr id)            -- code type brackets
+  | HsHetMetEsc   PostTcType PostTcType (LHsExpr id)            -- code type escape
+  | HsHetMetCSP   PostTcType            (LHsExpr id)            -- code type cross-stage persistence
+
   ---------------------------------------
   -- The following are commands, not expressions proper
 
@@ -353,10 +364,15 @@ ppr_expr (HsIPVar v)     = ppr v
 ppr_expr (HsLit lit)     = ppr lit
 ppr_expr (HsOverLit lit) = ppr lit
 ppr_expr (HsPar e)       = parens (ppr_lexpr e)
+ppr_expr (HsHetMetBrak  _   e) = ptext (sLit "<[") <> (ppr_lexpr e) <> ptext (sLit "]>")
+ppr_expr (HsHetMetEsc   _ _ e) = ptext (sLit "~~") <> (ppr_lexpr e)
+ppr_expr (HsHetMetCSP   _   e) = ptext (sLit "%%") <> (ppr_lexpr e)
 
 ppr_expr (HsCoreAnn s e)
   = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
 
+ppr_expr (HsKappaApp e1 e2) = ppr_expr $ HsApp e1 e2
+ppr_expr (HsKappa    e) = ppr_expr $ HsLam e
 ppr_expr (HsApp e1 e2)
   = let (fun, args) = collect_args e1 [e2] in
     hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))