X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsExpr.lhs;h=fba270ce23c832bda535ccb33c70594254abbaec;hp=5f1f776018ccf6b0b85d326e9f8ac2944cd55c60;hb=f6d254cccd3dc25fff9ff50c2e1bea52b10345e4;hpb=45bc009da2922cf8d5181d79d01c1c61e8d603fa diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index 5f1f776..fba270c 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -23,6 +23,8 @@ import Name import BasicTypes import DataCon import SrcLoc +import Util( dropTail ) +import StaticFlags( opt_PprStyle_Debug ) import Outputable import FastString @@ -146,8 +148,6 @@ data HsExpr id -- 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 @@ -439,7 +439,7 @@ ppr_expr (HsLet binds expr) = 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))) @@ -575,7 +575,7 @@ pprParendExpr expr 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 @@ -830,51 +830,83 @@ type LStmtLR idL idR = Located (StmtLR idL idR) 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, + -- 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 + -- For ListComp, PArrComp, we use the baked-in 'return' + -- For DoExpr, MDoExpr, we don't appply a 'return' at all + -- See Note [Monad Comprehensions] + | BindStmt (LPat idL) (LHsExpr idR) - (SyntaxExpr idR) -- The (>>=) operator + (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind] (SyntaxExpr idR) -- The fail operator -- The fail operator is noSyntaxExpr -- if the pattern match can't fail | ExprStmt (LHsExpr idR) -- See Note [ExprStmt] (SyntaxExpr idR) -- The (>>) operator + (SyntaxExpr idR) -- The `guard` operator; used only in MonadComp + -- 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])] - -- 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 + (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) (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 + [idR] -- After renaming, the Ids are the binders occurring -- within this transform statement that are used after it (LHsExpr idR) -- "then f" (Maybe (LHsExpr idR)) -- "by e" (optional) - | GroupStmt - [LStmt idL] -- Stmts to the *left* of the 'group' - -- which generates the tuples to be grouped + (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' + -- which generates the tuples to be grouped - [(idR, idR)] -- See Note [GroupStmt binder map] + grpS_bndrs :: [(idR, idR)], -- See Note [GroupStmt binder map] - (Maybe (LHsExpr idR)) -- "by e" (optional) + 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 - (Either -- "using f" - (LHsExpr idR) -- Left f => explicit "using f" - (SyntaxExpr idR)) -- Right f => implicit; filled in with 'groupWith' - + 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 + } -- See Note [Monad Comprehensions] -- Recursive statement (see Note [How RecStmt works] below) | RecStmt @@ -905,10 +937,25 @@ 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_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} +Note [The type of bind in Stmts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Some Stmts, notably BindStmt, keep the (>>=) bind operator. +We do NOT assume that it has type + (>>=) :: m a -> (a -> m b) -> m b +In some cases (see Trac #303, #1537) it might have a more +exotic type, such as + (>>=) :: m i j a -> (a -> m j k b) -> m i k b +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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ The [(idR,idR)] in a GroupStmt behaves as follows: @@ -918,7 +965,7 @@ The [(idR,idR)] in a GroupStmt behaves as follows: * After renaming: [ (x27,x27), ..., (z35,z35) ] These are the variables - bound by the stmts to the left of the 'group' + bound by the stmts to the left of the 'group' and used either in the 'by' clause, or in the stmts following the 'group' Each item is a pair of identical variables. @@ -952,7 +999,13 @@ depends on the context. Consider the following contexts: E :: Bool Translation: if E then fail else ... -Array comprehensions are handled like list comprehensions -=chak + A monad comprehension of type (m res_ty) + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * ExprStmt E Bool: [ .. | .... E ] + E :: Bool + Translation: guard E >> ... + +Array comprehensions are handled like list comprehensions. Note [How RecStmt works] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -993,23 +1046,63 @@ A (RecStmt stmts) types as if you had written 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 ] + +ExprStmts 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 _) = 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) +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) +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]) +pprStmt (GroupStmt { grpS_stmts = stmts, grpS_by = by, grpS_using = using, grpS_explicit = explicit }) + = sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using explicit]) pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids , recS_later_ids = later_ids }) @@ -1025,39 +1118,44 @@ pprTransformStmt bndrs using by , nest 2 (pprBy by)] pprGroupStmt :: OutputableBndr id => Maybe (LHsExpr id) - -> Either (LHsExpr id) (SyntaxExpr is) + -> LHsExpr id -> Bool -> SDoc -pprGroupStmt by using - = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 (ppr_using using)] +pprGroupStmt by using explicit + = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 pp_using ] where - ppr_using (Right _) = empty - ppr_using (Left e) = ptext (sLit "using") <+> ppr e + pp_using | explicit = ptext (sLit "using") <+> ppr using + | otherwise = empty pprBy :: OutputableBndr id => Maybe (LHsExpr id) -> SDoc 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 (punctuate semi (map ppr 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} %************************************************************************ @@ -1161,21 +1259,27 @@ 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 -- A pattern binding, or its guards - -- [x] = e, or x | [y] <- e = e + | 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 -- Recursive do-expression + | 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 @@ -1184,14 +1288,22 @@ data HsStmtContext id \begin{code} isDoExpr :: HsStmtContext id -> Bool -isDoExpr DoExpr = True -isDoExpr MDoExpr = True -isDoExpr _ = False +isDoExpr DoExpr = True +isDoExpr MDoExpr = True +isDoExpr GhciStmt = 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} @@ -1228,33 +1340,40 @@ pprMatchContextNoun ProcExpr = ptext (sLit "arrow abstraction") pprMatchContextNoun (StmtCtxt ctxt) = ptext (sLit "pattern binding in") $$ pprStmtContext ctxt -pprStmtContext :: Outputable id => HsStmtContext id -> SDoc +----------------- +pprAStmtContext, pprStmtContext :: Outputable id => HsStmtContext id -> SDoc +pprAStmtContext ctxt = article <+> pprStmtContext ctxt + where + pp_an = ptext (sLit "an") + pp_a = ptext (sLit "a") + article = case ctxt of + MDoExpr -> pp_an + PArrComp -> pp_an + GhciStmt -> pp_an + _ -> pp_a + + +----------------- +pprStmtContext GhciStmt = ptext (sLit "interactive GHCi command") +pprStmtContext DoExpr = ptext (sLit "'do' block") +pprStmtContext MDoExpr = ptext (sLit "'mdo' block") +pprStmtContext ListComp = ptext (sLit "list comprehension") +pprStmtContext MonadComp = ptext (sLit "monad comprehension") +pprStmtContext PArrComp = ptext (sLit "array comprehension") +pprStmtContext (PatGuard ctxt) = ptext (sLit "pattern guard for") $$ pprMatchContext ctxt + +-- Drop the inner contexts when reporting errors, else we get +-- Unexpected transform statement +-- in a transformed branch of +-- transformed branch of +-- transformed branch of monad comprehension pprStmtContext (ParStmtCtxt c) - = sep [ptext (sLit "a parallel branch of"), pprStmtContext c] + | opt_PprStyle_Debug = sep [ptext (sLit "parallel branch of"), pprAStmtContext c] + | otherwise = pprStmtContext c pprStmtContext (TransformStmtCtxt c) - = sep [ptext (sLit "a transformed branch of"), pprStmtContext c] -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 ListComp = ptext (sLit "a list comprehension") -pprStmtContext PArrComp = ptext (sLit "an array comprehension") - -{- -pprMatchRhsContext (FunRhs fun) = ptext (sLit "a right-hand side of function") <+> quotes (ppr fun) -pprMatchRhsContext CaseAlt = ptext (sLit "the body of a case alternative") -pprMatchRhsContext PatBindRhs = ptext (sLit "the right-hand side of a pattern binding") -pprMatchRhsContext LambdaExpr = ptext (sLit "the body of a lambda") -pprMatchRhsContext ProcExpr = ptext (sLit "the body of a proc") -pprMatchRhsContext other = panic "pprMatchRhsContext" -- RecUpd, StmtCtxt - --- Used for the result statement of comprehension --- e.g. the 'e' in [ e | ... ] --- or the 'r' in f x = r -pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt -pprStmtResultContext other = ptext (sLit "the result of") <+> pprStmtContext other --} + | opt_PprStyle_Debug = sep [ptext (sLit "transformed branch of"), pprAStmtContext c] + | otherwise = pprStmtContext c + -- Used to generate the string for a *runtime* error message matchContextErrString :: Outputable id => HsMatchContext id -> SDoc @@ -1272,6 +1391,7 @@ matchContextErrString (StmtCtxt GhciStmt) = ptext (sLit "interactive GHCi 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") \end{code} @@ -1283,11 +1403,17 @@ 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") <+> pprStmtContext 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 _ _ by using) = pprGroupStmt by using - ppr_stmt (TransformStmt _ bndrs using by) = pprTransformStmt bndrs using by - ppr_stmt stmt = pprStmt stmt + 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 \end{code}