import BasicTypes
import DataCon
import SrcLoc
+import Util( dropTail )
import Outputable
import FastString
| HsCase (LHsExpr id)
(MatchGroup id)
- | HsIf (LHsExpr id) -- predicate
+ | HsIf (Maybe (SyntaxExpr id)) -- cond function
+ -- Nothing => use the built-in 'if'
+ -- See Note [Rebindable if]
+ (LHsExpr id) -- predicate
(LHsExpr id) -- then part
(LHsExpr id) -- else part
-- because in this context we never use
-- the PatGuard or ParStmt variant
[LStmt id] -- "do":one or more stmts
- (LHsExpr id) -- The body; the last expression in the
- -- 'do' of [ body | ... ] in a list comp
PostTcType -- Type of the whole expression
| ExplicitList -- syntactic list
-- pasted back in by the desugarer
\end{code}
-A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
-@ClassDictLam dictvars methods expr@ is, therefore:
-\begin{verbatim}
-\ x -> case x of ( dictvars-and-methods-tuple ) -> expr
-\end{verbatim}
+Note [Rebindable if]
+~~~~~~~~~~~~~~~~~~~~
+The rebindable syntax for 'if' is a bit special, because when
+rebindable syntax is *off* we do not want to treat
+ (if c then t else e)
+as if it was an application (ifThenElse c t e). Why not?
+Because we allow an 'if' to return *unboxed* results, thus
+ if blah then 3# else 4#
+whereas that would not be possible using a all to a polymorphic function
+(because you can't call a polymorphic function at an unboxed type).
+
+So we use Nothing to mean "use the old built-in typing rule".
\begin{code}
instance OutputableBndr id => Outputable (HsExpr id) where
nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches <+> char '}') ]
where idType :: HsExpr id -> HsMatchContext id; idType = undefined
-ppr_expr (HsIf e1 e2 e3)
+ppr_expr (HsIf _ e1 e2 e3)
= sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
nest 4 (ppr e2),
ptext (sLit "else"),
= sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
hang (ptext (sLit "in")) 2 (ppr expr)]
-ppr_expr (HsDo do_or_list_comp stmts body _) = pprDo do_or_list_comp stmts body
+ppr_expr (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp stmts
ppr_expr (ExplicitList _ exprs)
= brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
HsPar {} -> pp_as_was
HsBracket {} -> pp_as_was
HsBracketOut _ [] -> pp_as_was
- HsDo sc _ _ _
+ HsDo sc _ _
| isListCompExpr sc -> pp_as_was
_ -> parens pp_as_was
[Match id] -- bodies are HsCmd's
SrcLoc
- | HsIf (HsExpr id) -- predicate
+ | HsIf (Maybe (SyntaxExpr id)) -- cond function
+ (HsExpr id) -- predicate
(HsCmd id) -- then part
(HsCmd id) -- else part
SrcLoc
type Stmt id = StmtLR id id
--- The SyntaxExprs in here are used *only* for do-notation, which
--- has rebindable syntax. Otherwise they are unused.
+-- 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
- = BindStmt (LPat idL)
+ = LastStmt -- Always the last Stmt in ListComp, MonadComp, PArrComp, DoExpr, MDoExpr
+ -- Not used for GhciStmt, PatGuard, which scope over other stuff
+ (LHsExpr idR)
+ (SyntaxExpr idR) -- The return operator, used only for MonadComp
+ -- See Note [Monad Comprehensions]
+ | BindStmt (LPat idL)
(LHsExpr idR)
(SyntaxExpr idR) -- The (>>=) operator
(SyntaxExpr idR) -- The fail operator
| ExprStmt (LHsExpr idR) -- See Note [ExprStmt]
(SyntaxExpr idR) -- The (>>) operator
+ (SyntaxExpr idR) -- The `guard` operator
+ -- See notes [Monad Comprehensions]
PostTcType -- Element type of the RHS (used for arrows)
| LetStmt (HsLocalBindsLR idL idR)
- -- ParStmts only occur in a list comprehension
+ -- ParStmts only occur in a list/monad comprehension
| ParStmt [([LStmt idL], [idR])]
+ (SyntaxExpr idR) -- Polymorphic `mzip` for monad comprehensions
+ (SyntaxExpr idR) -- The `>>=` operator
+ (SyntaxExpr idR) -- Polymorphic `return` operator
+ -- 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)
- -- "qs, then f" ==> TransformStmt qs binders f Nothing
+ -- "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'
(Maybe (LHsExpr idR)) -- "by e" (optional)
+ (SyntaxExpr idR) -- The 'return' function for inner monad
+ -- comprehensions
+ (SyntaxExpr idR) -- The '(>>=)' operator.
+ -- See Note [Monad Comprehensions]
+
| GroupStmt
[LStmt idL] -- Stmts to the *left* of the 'group'
-- which generates the tuples to be grouped
(Either -- "using f"
(LHsExpr idR) -- Left f => explicit "using f"
(SyntaxExpr idR)) -- Right f => implicit; filled in with 'groupWith'
-
+ -- (list comprehensions) or 'groupM' (monad
+ -- comprehensions)
+
+ (SyntaxExpr idR) -- The 'return' function for inner monad
+ -- comprehensions
+ (SyntaxExpr idR) -- The '(>>=)' operator
+ (SyntaxExpr idR) -- The 'liftM' function from Control.Monad for desugaring
+ -- See Note [Monad Comprehensions]
-- Recursive statement (see Note [How RecStmt works] below)
| RecStmt
-- 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
+ , recS_ret_ty :: PostTcType -- The type of of do { stmts; return (a,b,c) }
+ -- With rebindable syntax the type might not
+ -- be quite as simple as (m (tya, tyb, tyc)).
}
deriving (Data, Typeable)
\end{code}
E :: Bool
Translation: if E then fail else ...
+ A monad comprehension of type (m res_ty)
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * ExprStmt E Bool: [ .. | .... E ]
+ E :: Bool
+ Translation: guard E >> ...
+
Array comprehensions are handled like list comprehensions -=chak
Note [How RecStmt works]
where v1..vn are the later_ids
r1..rm are the rec_ids
+Note [Monad Comprehensions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Monad comprehensions require separate functions like 'return' and
+'>>=' for desugaring. These functions are stored in the statements
+used in monad comprehensions. For example, the 'return' of the 'LastStmt'
+expression is used to lift the body of the monad comprehension:
+
+ [ body | stmts ]
+ =>
+ stmts >>= \bndrs -> return body
+
+In transform and grouping statements ('then ..' and 'then group ..') the
+'return' function is required for nested monad comprehensions, for example:
+
+ [ body | stmts, then f, rest ]
+ =>
+ f [ env | stmts ] >>= \bndrs -> [ body | rest ]
+
+Normal expressions require the 'Control.Monad.guard' function for boolean
+expressions:
+
+ [ body | exp, stmts ]
+ =>
+ guard exp >> [ body | stmts ]
+
+Grouping/parallel statements require the 'Control.Monad.Group.groupM' and
+'Control.Monad.Zip.mzip' functions:
+
+ [ body | stmts, then group by e, rest]
+ =>
+ groupM [ body | stmts ] >>= \bndrs -> [ body | rest ]
+
+ [ body | stmts1 | stmts2 | .. ]
+ =>
+ mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body
+
+In any other context than 'MonadComp', the fields for most of these
+'SyntaxExpr's stay bottom.
+
\begin{code}
instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) where
ppr stmt = pprStmt stmt
pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
+pprStmt (LastStmt expr _) = 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)
+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)
+pprStmt (GroupStmt stmts _ by using _ _ _)
= sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using])
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)
pprBy Nothing = empty
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 ListComp stmts body = brackets $ pprComp stmts body
-pprDo PArrComp stmts body = pa_brackets $ pprComp stmts body
-pprDo _ _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
+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 MDoExpr stmts = ptext (sLit "mdo") <+> ppr_do_stmts stmts
+pprDo ListComp stmts = brackets $ pprComp stmts
+pprDo PArrComp stmts = pa_brackets $ pprComp stmts
+pprDo MonadComp stmts = brackets $ pprComp stmts
+pprDo _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
-ppr_do_stmts :: OutputableBndr id => [LStmt id] -> LHsExpr id -> SDoc
+ppr_do_stmts :: OutputableBndr id => [LStmt id] -> SDoc
-- Print a bunch of do stmts, with explicit braces and semicolons,
-- so that we are not vulnerable to layout bugs
-ppr_do_stmts stmts body
- = lbrace <+> pprDeeperList vcat ([ppr s <> semi | s <- stmts] ++ [ppr body])
+ppr_do_stmts stmts
+ = lbrace <+> pprDeeperList vcat ([ppr s <> semi | s <- stmts])
<+> rbrace
ppr_lc_stmts :: OutputableBndr id => [LStmt id] -> [SDoc]
ppr_lc_stmts stmts = [ppr s <> comma | s <- stmts]
-pprComp :: OutputableBndr id => [LStmt id] -> LHsExpr id -> SDoc
-pprComp quals body -- Prints: body | qual1, ..., qualn
- = hang (ppr body <+> char '|') 2 (interpp'SP quals)
+pprComp :: OutputableBndr id => [LStmt id] -> SDoc
+pprComp quals -- Prints: body | qual1, ..., qualn
+ | not (null quals)
+ , L _ (LastStmt body _) <- last quals
+ = hang (ppr body <+> char '|') 2 (interpp'SP (dropTail 1 quals))
+ | otherwise
+ = pprPanic "pprComp" (interpp'SP quals)
\end{code}
%************************************************************************
| 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)
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)
+ | MonadComp
| PArrComp -- Parallel array comprehension
+
+ | DoExpr -- do { ... }
+ | MDoExpr -- mdo { ... } ie recursive do-expression
+
+ | 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
\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
-isListCompExpr PArrComp = True
-isListCompExpr _ = False
+isListCompExpr ListComp = True
+isListCompExpr PArrComp = True
+isListCompExpr MonadComp = True
+isListCompExpr _ = False
+
+isMonadCompExpr :: HsStmtContext id -> Bool
+isMonadCompExpr MonadComp = True
+isMonadCompExpr (ParStmtCtxt ctxt) = isMonadCompExpr ctxt
+isMonadCompExpr (TransformStmtCtxt ctxt) = isMonadCompExpr ctxt
+isMonadCompExpr _ = False
\end{code}
\begin{code}
= 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 MonadComp = ptext (sLit "a monad comprehension")
pprStmtContext PArrComp = ptext (sLit "an array comprehension")
{-
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 MonadComp) = ptext (sLit "monad comprehension")
matchContextErrString (StmtCtxt PArrComp) = ptext (sLit "array comprehension")
\end{code}
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}