pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
pprMatch ctxt (Match pats maybe_ty grhss)
- = herald <+> sep [sep (map ppr other_pats),
+ = herald <+> sep [sep (map pprParendLPat other_pats),
ppr_maybe_ty,
nest 2 (pprGRHSs ctxt grhss)]
where
-- Not pprBndr; the AbsBinds will
-- have printed the signature
- | null pats3 -> (pp_infix, [])
+ | null pats2 -> (pp_infix, [])
-- x &&& y = e
- | otherwise -> (parens pp_infix, pats3)
+ | otherwise -> (parens pp_infix, pats2)
-- (x &&& y) z = e
where
- (pat1:pat2:pats3) = pats
- pp_infix = ppr pat1 <+> ppr fun <+> ppr pat2
+ pp_infix = pprParendLPat pat1 <+> ppr fun <+> pprParendLPat pat2
LambdaExpr -> (char '\\', pats)
- _ -> (empty, pats)
+
+ _ -> ASSERT( null pats1 )
+ (ppr pat1, []) -- No parens around the single pat
+ (pat1:pats1) = pats
+ (pat2:pats2) = pats1
ppr_maybe_ty = case maybe_ty of
Just ty -> dcolon <+> ppr ty
Nothing -> empty
=> HsMatchContext idL -> GRHSs idR -> SDoc
pprGRHSs ctxt (GRHSs grhss binds)
= vcat (map (pprGRHS ctxt . unLoc) grhss)
- $$ if isEmptyLocalBinds binds then empty
- else text "where" $$ nest 4 (pprBinds binds)
+ $$ ppUnless (isEmptyLocalBinds binds)
+ (text "where" $$ nest 4 (pprBinds binds))
pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
=> HsMatchContext idL -> GRHS idR -> SDoc
, recS_rec_ids :: [idR] -- Ditto, but these variables are the "recursive" ones,
-- that are used before they are bound in the stmts of
-- the RecStmt.
-
-- An Id can be in both groups
-- Both sets of Ids are (now) treated monomorphically
- -- The only reason they are separate is becuase the DsArrows
- -- code uses them separately, and I don't understand it well
- -- enough to change it
+ -- See Note [How RecStmt works] for why they are separate
-- Rebindable syntax
, recS_bind_fn :: SyntaxExpr idR -- The bind function
Note [How RecStmt works]
~~~~~~~~~~~~~~~~~~~~~~~~
Example:
- HsDo [ BindStmt x ex
+ HsDo [ BindStmt x ex
- , RecStmt [a::forall a. a -> a, b]
- [a::Int -> Int, c]
- [ BindStmt b (return x)
- , LetStmt a = ea
- , BindStmt c ec ]
+ , RecStmt { recS_rec_ids = [a, c]
+ , recS_stmts = [ BindStmt b (return (a,c))
+ , LetStmt a = ...b...
+ , BindStmt c ec ]
+ , recS_later_ids = [a, b]
- , return (a b) ]
+ , return (a b) ]
Here, the RecStmt binds a,b,c; but
- Only a,b are used in the stmts *following* the RecStmt,
- This 'a' is *polymorphic'
- Only a,c are used in the stmts *inside* the RecStmt
*before* their bindings
- This 'a' is monomorphic
-Nota Bene: the two a's have different types, even though they
-have the same Name.
+Why do we need *both* rec_ids and later_ids? For monads they could be
+combined into a single set of variables, but not for arrows. That
+follows from the types of the respective feedback operators:
+
+ mfix :: MonadFix m => (a -> m a) -> m a
+ loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
+
+* For mfix, the 'a' covers the union of the later_ids and the rec_ids
+* For 'loop', 'c' is the later_ids and 'd' is the rec_ids
Note [Typing a RecStmt]
~~~~~~~~~~~~~~~~~~~~~~~
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 = pprComp brackets stmts body
pprDo PArrComp stmts body = pprComp pa_brackets stmts body
= char '$' <> ifPprDebug (brackets (ppr n)) <> pprParendExpr e
-data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
- | PatBr (LPat id) -- [p| pat |]
- | DecBr (HsGroup id) -- [d| decls |]
- | TypBr (LHsType id) -- [t| type |]
- | VarBr id -- 'x, ''T
+data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
+ | PatBr (LPat id) -- [p| pat |]
+ | DecBrL [LHsDecl id] -- [d| decls |]; result of parser
+ | DecBrG (HsGroup id) -- [d| decls |]; result of renamer
+ | TypBr (LHsType id) -- [t| type |]
+ | VarBr id -- 'x, ''T
instance OutputableBndr id => Outputable (HsBracket id) where
ppr = pprHsBracket
pprHsBracket :: OutputableBndr id => HsBracket id -> SDoc
-pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
-pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
-pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
-pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
-pprHsBracket (VarBr n) = char '\'' <> ppr n
+pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
+pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
+pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
+pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
+pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
+pprHsBracket (VarBr n) = char '\'' <> ppr n
-- Infelicity: can't show ' vs '', because
-- we can't ask n what its OccName is, because the
-- pretty-printer for HsExpr doesn't ask for NamedThings
-- tell matchWrapper what sort of
-- runtime error message to generate]
| StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
+ | ThPatQuote -- A Template Haskell pattern quotation [p| (a,b) |]
deriving ()
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)
matchSeparator PatBindRhs = ptext (sLit "=")
matchSeparator (StmtCtxt _) = ptext (sLit "<-")
matchSeparator RecUpd = panic "unused"
+matchSeparator ThPatQuote = panic "unused"
\end{code}
\begin{code}
<+> quotes (ppr fun)
pprMatchContext CaseAlt = ptext (sLit "a case alternative")
pprMatchContext RecUpd = ptext (sLit "a record-update construct")
+pprMatchContext ThPatQuote = ptext (sLit "a Template Haskell pattern quotation")
pprMatchContext PatBindRhs = ptext (sLit "a pattern binding")
pprMatchContext LambdaExpr = ptext (sLit "a lambda abstraction")
pprMatchContext ProcExpr = ptext (sLit "an arrow abstraction")
= 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")
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")
projects / ghc-hetmet.git / blobdiff