Initial checkin of HetMet / -XModalTypes modifications

[ghc-hetmet.git] / compiler / hsSyn / HsExpr.lhs

diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index 7857707..b7fe6fc 100644 (file)
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -223,6 +223,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,6 +360,9 @@ 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]
@@ -905,9 +915,6 @@ data StmtLR idL idR
                                      -- because the Id may be *polymorphic*, but
                                      -- the returned thing has to be *monomorphic*, 
                                     -- so they may be type applications
-
-      , recS_dicts :: TcEvBinds    -- Method bindings of Ids bound by the
-                                   -- RecStmt, and used afterwards
       }
   deriving (Data, Typeable)
 \end{code}
@@ -1043,7 +1050,7 @@ pprBy (Just e) = ptext (sLit "by") <+> ppr e
 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
 pprDo DoExpr      stmts body = ptext (sLit "do")  <+> ppr_do_stmts stmts body
 pprDo GhciStmt    stmts body = ptext (sLit "do")  <+> ppr_do_stmts stmts body
-pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> ppr_do_stmts stmts body
+pprDo MDoExpr     stmts body = ptext (sLit "mdo") <+> ppr_do_stmts stmts body
 pprDo ListComp    stmts body = brackets    $ pprComp stmts body
 pprDo PArrComp    stmts body = pa_brackets $ pprComp stmts body
 pprDo _           _     _    = panic "pprDo" -- PatGuard, ParStmtCxt
@@ -1164,11 +1171,15 @@ data HsMatchContext id  -- Context of a Match
   | LambdaExpr                  -- Patterns of a lambda
   | CaseAlt                     -- Patterns and guards on a case alternative
   | ProcExpr                    -- Patterns of a proc
-  | PatBindRhs                  -- Patterns in the *guards* of a pattern binding
+  | PatBindRhs                  -- A pattern binding  eg [y] <- e = e
+
   | RecUpd                      -- Record update [used only in DsExpr to
                                 --    tell matchWrapper what sort of
                                 --    runtime error message to generate]
-  | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
+
+  | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt, list comprehension, 
+                               -- pattern guard, etc
+
   | ThPatQuote                 -- A Template Haskell pattern quotation [p| (a,b) |]
   deriving (Data, Typeable)
 
@@ -1176,9 +1187,7 @@ data HsStmtContext id
   = ListComp
   | DoExpr
   | GhciStmt                            -- A command-line Stmt in GHCi pat <- rhs
-  | MDoExpr PostTcTable                  -- Recursive do-expression
-                                         -- (tiresomely, it needs table
-                                         --  of its return/bind ops)
+  | MDoExpr                              -- Recursive do-expression
   | PArrComp                             -- Parallel array comprehension
   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
@@ -1188,9 +1197,9 @@ data HsStmtContext id
 
 \begin{code}
 isDoExpr :: HsStmtContext id -> Bool
-isDoExpr DoExpr      = True
-isDoExpr (MDoExpr _) = True
-isDoExpr _           = False
+isDoExpr DoExpr  = True
+isDoExpr MDoExpr = True
+isDoExpr _       = False
 
 isListCompExpr :: HsStmtContext id -> Bool
 isListCompExpr ListComp = True
@@ -1241,7 +1250,7 @@ pprStmtContext (PatGuard ctxt)
  = ptext (sLit "a pattern guard for") $$ pprMatchContext ctxt
 pprStmtContext GhciStmt        = ptext (sLit "an interactive GHCi command")
 pprStmtContext DoExpr          = ptext (sLit "a 'do' expression")
-pprStmtContext (MDoExpr _)     = ptext (sLit "an 'mdo' expression")
+pprStmtContext MDoExpr         = ptext (sLit "an 'mdo' expression")
 pprStmtContext ListComp        = ptext (sLit "a list comprehension")
 pprStmtContext PArrComp        = ptext (sLit "an array comprehension")
 
@@ -1274,7 +1283,7 @@ matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (
 matchContextErrString (StmtCtxt (PatGuard _))    = ptext (sLit "pattern guard")
 matchContextErrString (StmtCtxt GhciStmt)        = ptext (sLit "interactive GHCi command")
 matchContextErrString (StmtCtxt DoExpr)          = ptext (sLit "'do' expression")
-matchContextErrString (StmtCtxt (MDoExpr _))     = ptext (sLit "'mdo' expression")
+matchContextErrString (StmtCtxt MDoExpr)         = ptext (sLit "'mdo' expression")
 matchContextErrString (StmtCtxt ListComp)        = ptext (sLit "list comprehension")
 matchContextErrString (StmtCtxt PArrComp)        = ptext (sLit "array comprehension")
 \end{code}