X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsExpr.lhs;h=8ea0c4fbf57fe9c06e1fa2cc7f417d0d455f9dc9;hp=cf9c0d7402fb31c261dd0c7e6b0b54a7f867e459;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=d76d9636aeebe933d160157331b8c8c0087e73ac diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index cf9c0d7..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)) @@ -833,7 +849,8 @@ type Stmt id = StmtLR id id -- The SyntaxExprs in here are used *only* for do-notation and monad -- comprehensions, which have rebindable syntax. Otherwise they are unused. data StmtLR idL idR - = LastStmt -- Always the last Stmt in ListComp, MonadComp, PArrComp, DoExpr, MDoExpr + = LastStmt -- Always the last Stmt in ListComp, MonadComp, PArrComp, + -- and (after the renamer) DoExpr, MDoExpr -- Not used for GhciStmt, PatGuard, which scope over other stuff (LHsExpr idR) (SyntaxExpr idR) -- The return operator, used only for MonadComp @@ -863,48 +880,24 @@ data StmtLR idL idR -- with type (forall a. a -> m a) -- See notes [Monad Comprehensions] -- After renaming, the ids are the binders - -- bound by the stmts and used after them - - -- "qs, then f by e" ==> TransformStmt qs binders f (Just e) (return) (>>=) - -- "qs, then f" ==> TransformStmt qs binders f Nothing (return) (>>=) - | TransformStmt - [LStmt idL] -- Stmts are the ones to the left of the 'then' - - [idR] -- After renaming, the Ids are the binders occurring - -- within this transform statement that are used after it - - (LHsExpr idR) -- "then f" + -- bound by the stmts and used after themp - (Maybe (LHsExpr idR)) -- "by e" (optional) - - (SyntaxExpr idR) -- The 'return' function for inner monad - -- comprehensions - (SyntaxExpr idR) -- The '(>>=)' operator. - -- See Note [Monad Comprehensions] - - | GroupStmt { - grpS_stmts :: [LStmt idL], -- Stmts to the *left* of the 'group' + | TransStmt { + trS_form :: TransForm, + trS_stmts :: [LStmt idL], -- Stmts to the *left* of the 'group' -- which generates the tuples to be grouped - grpS_bndrs :: [(idR, idR)], -- See Note [GroupStmt binder map] + trS_bndrs :: [(idR, idR)], -- See Note [TransStmt binder map] - grpS_by :: Maybe (LHsExpr idR), -- "by e" (optional) - - grpS_using :: LHsExpr idR, - grpS_explicit :: Bool, -- True <=> explicit "using f" - -- False <=> implicit; grpS_using is filled in with - -- 'groupWith' (list comprehensions) or - -- 'groupM' (monad comprehensions) - - -- Invariant: if grpS_explicit = False, then grp_by = Just e - -- That is, we can have group by e - -- group using f - -- group by e using f - - grpS_ret :: SyntaxExpr idR, -- The 'return' function for inner monad - -- comprehensions - grpS_bind :: SyntaxExpr idR, -- The '(>>=)' operator - grpS_fmap :: SyntaxExpr idR -- The polymorphic 'fmap' function for desugaring + trS_using :: LHsExpr idR, + trS_by :: Maybe (LHsExpr idR), -- "by e" (optional) + -- Invariant: if trS_form = GroupBy, then grp_by = Just e + + trS_ret :: SyntaxExpr idR, -- The monomorphic 'return' function for + -- the inner monad comprehensions + trS_bind :: SyntaxExpr idR, -- The '(>>=)' operator + trS_fmap :: SyntaxExpr idR -- The polymorphic 'fmap' function for desugaring + -- Only for 'group' forms } -- See Note [Monad Comprehensions] -- Recursive statement (see Note [How RecStmt works] below) @@ -942,6 +935,15 @@ data StmtLR idL idR -- be quite as simple as (m (tya, tyb, tyc)). } deriving (Data, Typeable) + +data TransForm -- The 'f' below is the 'using' function, 'e' is the by function + = ThenForm -- then f or then f by e + | GroupFormU -- group using f or group using f by e + | GroupFormB -- group by e + -- In the GroupByFormB, trS_using is filled in with + -- 'groupWith' (list comprehensions) or + -- 'groupM' (monad comprehensions) + deriving (Data, Typeable) \end{code} Note [The type of bind in Stmts] @@ -955,9 +957,9 @@ exotic type, such as So we must be careful not to make assumptions about the type. In particular, the monad may not be uniform throughout. -Note [GroupStmt binder map] +Note [TransStmt binder map] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The [(idR,idR)] in a GroupStmt behaves as follows: +The [(idR,idR)] in a TransStmt behaves as follows: * Before renaming: [] @@ -1090,18 +1092,15 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) ppr stmt = pprStmt stmt pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc -pprStmt (LastStmt expr _) = ppr expr +pprStmt (LastStmt expr _) = ifPprDebug (ptext (sLit "[last]")) <+> ppr expr pprStmt (BindStmt pat expr _ _) = hsep [ppr pat, ptext (sLit "<-"), ppr expr] pprStmt (LetStmt binds) = hsep [ptext (sLit "let"), pprBinds binds] pprStmt (ExprStmt expr _ _ _) = ppr expr pprStmt (ParStmt stmtss _ _ _) = hsep (map doStmts stmtss) where doStmts stmts = ptext (sLit "| ") <> ppr stmts -pprStmt (TransformStmt stmts bndrs using by _ _) - = sep (ppr_lc_stmts stmts ++ [pprTransformStmt bndrs using by]) - -pprStmt (GroupStmt { grpS_stmts = stmts, grpS_by = by, grpS_using = using, grpS_explicit = explicit }) - = sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using explicit]) +pprStmt (TransStmt { trS_stmts = stmts, trS_by = by, trS_using = using, trS_form = form }) + = sep (ppr_lc_stmts stmts ++ [pprTransStmt by using form]) pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids , recS_later_ids = later_ids }) @@ -1116,14 +1115,15 @@ pprTransformStmt bndrs using by , nest 2 (ppr using) , nest 2 (pprBy by)] -pprGroupStmt :: OutputableBndr id => Maybe (LHsExpr id) - -> LHsExpr id -> Bool +pprTransStmt :: OutputableBndr id => Maybe (LHsExpr id) + -> LHsExpr id -> TransForm -> SDoc -pprGroupStmt by using explicit - = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 pp_using ] - where - pp_using | explicit = ptext (sLit "using") <+> ppr using - | otherwise = empty +pprTransStmt by using ThenForm + = sep [ ptext (sLit "then"), nest 2 (ppr using), nest 2 (pprBy by)] +pprTransStmt by _ GroupFormB + = sep [ ptext (sLit "then group"), nest 2 (pprBy by) ] +pprTransStmt by using GroupFormU + = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)] pprBy :: OutputableBndr id => Maybe (LHsExpr id) -> SDoc pprBy Nothing = empty @@ -1132,6 +1132,7 @@ pprBy (Just e) = ptext (sLit "by") <+> ppr e pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> SDoc pprDo DoExpr stmts = ptext (sLit "do") <+> ppr_do_stmts stmts pprDo GhciStmt stmts = ptext (sLit "do") <+> ppr_do_stmts stmts +pprDo ArrowExpr stmts = ptext (sLit "do") <+> ppr_do_stmts stmts pprDo MDoExpr stmts = ptext (sLit "mdo") <+> ppr_do_stmts stmts pprDo ListComp stmts = brackets $ pprComp stmts pprDo PArrComp stmts = pa_brackets $ pprComp stmts @@ -1277,32 +1278,30 @@ data HsStmtContext id | DoExpr -- do { ... } | MDoExpr -- mdo { ... } ie recursive do-expression + | ArrowExpr -- do-notation in an arrow-command context | GhciStmt -- A command-line Stmt in GHCi pat <- rhs | PatGuard (HsMatchContext id) -- Pattern guard for specified thing | ParStmtCtxt (HsStmtContext id) -- A branch of a parallel stmt - | TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt + | TransStmtCtxt (HsStmtContext id) -- A branch of a transform stmt deriving (Data, Typeable) \end{code} \begin{code} -isDoExpr :: HsStmtContext id -> Bool -isDoExpr DoExpr = True -isDoExpr MDoExpr = True -isDoExpr GhciStmt = True -isDoExpr _ = False - isListCompExpr :: HsStmtContext id -> Bool -isListCompExpr ListComp = True -isListCompExpr PArrComp = True -isListCompExpr MonadComp = True -isListCompExpr _ = False +-- Uses syntax [ e | quals ] +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 -isMonadCompExpr (ParStmtCtxt ctxt) = isMonadCompExpr ctxt -isMonadCompExpr (TransformStmtCtxt ctxt) = isMonadCompExpr ctxt -isMonadCompExpr _ = False +isMonadCompExpr MonadComp = True +isMonadCompExpr (ParStmtCtxt ctxt) = isMonadCompExpr ctxt +isMonadCompExpr (TransStmtCtxt ctxt) = isMonadCompExpr ctxt +isMonadCompExpr _ = False \end{code} \begin{code} @@ -1354,8 +1353,9 @@ pprAStmtContext ctxt = article <+> pprStmtContext ctxt ----------------- pprStmtContext GhciStmt = ptext (sLit "interactive GHCi command") -pprStmtContext DoExpr = ptext (sLit "'do' expression") -pprStmtContext MDoExpr = ptext (sLit "'mdo' expression") +pprStmtContext DoExpr = ptext (sLit "'do' block") +pprStmtContext MDoExpr = ptext (sLit "'mdo' block") +pprStmtContext ArrowExpr = ptext (sLit "'do' block in an arrow command") pprStmtContext ListComp = ptext (sLit "list comprehension") pprStmtContext MonadComp = ptext (sLit "monad comprehension") pprStmtContext PArrComp = ptext (sLit "array comprehension") @@ -1369,7 +1369,7 @@ pprStmtContext (PatGuard ctxt) = ptext (sLit "pattern guard for") $$ pprMatchCon pprStmtContext (ParStmtCtxt c) | opt_PprStyle_Debug = sep [ptext (sLit "parallel branch of"), pprAStmtContext c] | otherwise = pprStmtContext c -pprStmtContext (TransformStmtCtxt c) +pprStmtContext (TransStmtCtxt c) | opt_PprStyle_Debug = sep [ptext (sLit "transformed branch of"), pprAStmtContext c] | otherwise = pprStmtContext c @@ -1383,15 +1383,16 @@ matchContextErrString RecUpd = ptext (sLit "record update") matchContextErrString LambdaExpr = ptext (sLit "lambda") matchContextErrString ProcExpr = ptext (sLit "proc") matchContextErrString ThPatQuote = panic "matchContextErrString" -- Not used at runtime -matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c) -matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c) -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 ListComp) = ptext (sLit "list comprehension") -matchContextErrString (StmtCtxt MonadComp) = ptext (sLit "monad comprehension") -matchContextErrString (StmtCtxt PArrComp) = ptext (sLit "array comprehension") +matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c) +matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c) +matchContextErrString (StmtCtxt (PatGuard _)) = ptext (sLit "pattern guard") +matchContextErrString (StmtCtxt GhciStmt) = ptext (sLit "interactive GHCi command") +matchContextErrString (StmtCtxt DoExpr) = ptext (sLit "'do' block") +matchContextErrString (StmtCtxt ArrowExpr) = ptext (sLit "'do' block") +matchContextErrString (StmtCtxt MDoExpr) = ptext (sLit "'mdo' block") +matchContextErrString (StmtCtxt ListComp) = ptext (sLit "list comprehension") +matchContextErrString (StmtCtxt MonadComp) = ptext (sLit "monad comprehension") +matchContextErrString (StmtCtxt PArrComp) = ptext (sLit "array comprehension") \end{code} \begin{code} @@ -1402,12 +1403,16 @@ pprMatchInCtxt ctxt match = hang (ptext (sLit "In") <+> pprMatchContext ctxt <> pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR) => HsStmtContext idL -> StmtLR idL idR -> SDoc -pprStmtInCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprAStmtContext ctxt <> colon) - 4 (ppr_stmt stmt) +pprStmtInCtxt ctxt (LastStmt e _) + | isListCompExpr ctxt -- For [ e | .. ], do not mutter about "stmts" + = hang (ptext (sLit "In the expression:")) 2 (ppr e) + +pprStmtInCtxt ctxt stmt + = hang (ptext (sLit "In a stmt of") <+> pprAStmtContext ctxt <> colon) + 2 (ppr_stmt stmt) where -- For Group and Transform Stmts, don't print the nested stmts! - ppr_stmt (GroupStmt { grpS_by = by, grpS_using = using - , grpS_explicit = explicit }) = pprGroupStmt by using explicit - ppr_stmt (TransformStmt _ bndrs using by _ _) = pprTransformStmt bndrs using by - ppr_stmt stmt = pprStmt stmt + ppr_stmt (TransStmt { trS_by = by, trS_using = using + , trS_form = form }) = pprTransStmt by using form + ppr_stmt stmt = pprStmt stmt \end{code}