X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsExpr.lhs;h=b7fe6fc1331324faab65b036fd36d9d2d5342da8;hp=ee1aeca8db7535eb09364ce3bb84375603aa77da;hb=16b9e80dc14db24509f051f294b5b51943285090;hpb=4e0c994eb1613c62e94069642d7acdb2e69b773b diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index ee1aeca..b7fe6fc 100644 --- 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} @@ -1008,8 +1015,8 @@ pprStmt (ExprStmt expr _ _) = ppr expr pprStmt (ParStmt stmtss) = hsep (map doStmts stmtss) where doStmts stmts = ptext (sLit "| ") <> ppr stmts -pprStmt (TransformStmt stmts _ using by) - = sep (ppr_lc_stmts stmts ++ [pprTransformStmt using by]) +pprStmt (TransformStmt stmts bndrs using by) + = sep (ppr_lc_stmts stmts ++ [pprTransformStmt bndrs using by]) pprStmt (GroupStmt stmts _ by using) = sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using]) @@ -1021,8 +1028,11 @@ pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids , ifPprDebug (vcat [ ptext (sLit "rec_ids=") <> ppr rec_ids , ptext (sLit "later_ids=") <> ppr later_ids])] -pprTransformStmt :: OutputableBndr id => LHsExpr id -> Maybe (LHsExpr id) -> SDoc -pprTransformStmt using by = sep [ ptext (sLit "then"), nest 2 (ppr using), nest 2 (pprBy by)] +pprTransformStmt :: OutputableBndr id => [id] -> LHsExpr id -> Maybe (LHsExpr id) -> SDoc +pprTransformStmt bndrs using by + = sep [ ptext (sLit "then") <+> ifPprDebug (braces (ppr bndrs)) + , nest 2 (ppr using) + , nest 2 (pprBy by)] pprGroupStmt :: OutputableBndr id => Maybe (LHsExpr id) -> Either (LHsExpr id) (SyntaxExpr is) @@ -1040,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 @@ -1161,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) @@ -1173,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 @@ -1185,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 @@ -1238,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") @@ -1271,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} @@ -1288,7 +1300,7 @@ pprStmtInCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprStmtContext c 4 (ppr_stmt stmt) where -- For Group and Transform Stmts, don't print the nested stmts! - ppr_stmt (GroupStmt _ _ by using) = pprGroupStmt by using - ppr_stmt (TransformStmt _ _ using by) = pprTransformStmt using by - ppr_stmt stmt = pprStmt stmt + ppr_stmt (GroupStmt _ _ by using) = pprGroupStmt by using + ppr_stmt (TransformStmt _ bndrs using by) = pprTransformStmt bndrs using by + ppr_stmt stmt = pprStmt stmt \end{code}