| 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.
(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
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))
-- 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
-- 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)
-- 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]
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: []
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 })
, 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
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
| 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}
-----------------
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")
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
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}
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}
projects / ghc-hetmet.git / blobdiff