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

diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index 9c88783..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))
@@ -1274,10 +1290,12 @@ data HsStmtContext id
 \begin{code}
 isListCompExpr :: HsStmtContext id -> Bool
 -- Uses syntax [ e | quals ]
-isListCompExpr ListComp  = True
-isListCompExpr PArrComp  = True
-isListCompExpr MonadComp = True
-isListCompExpr _         = False
+isListCompExpr ListComp  	 = True
+isListCompExpr PArrComp  	 = True
+isListCompExpr MonadComp 	 = True  
+isListCompExpr (ParStmtCtxt c)   = isListCompExpr c
+isListCompExpr (TransStmtCtxt c) = isListCompExpr c
+isListCompExpr _                 = False
 
 isMonadCompExpr :: HsStmtContext id -> Bool
 isMonadCompExpr MonadComp            = True