| 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
(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
-- 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
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]
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"),
[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
pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
=> LPat bndr -> GRHSs id -> SDoc
pprPatBind pat ty@(grhss)
- = sep [ppr pat, nest 4 (pprGRHSs (PatBindRhs `asTypeOf` idType ty) grhss)]
+ = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs `asTypeOf` idType ty) grhss)]
--avoid using PatternSignatures for stage1 code portability
where idType :: GRHSs id -> HsMatchContext id; idType = undefined
pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
pprMatch ctxt (Match pats maybe_ty grhss)
- = herald <+> sep [sep (map pprParendLPat other_pats),
- ppr_maybe_ty,
- nest 2 (pprGRHSs ctxt grhss)]
+ = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats)
+ , nest 2 ppr_maybe_ty
+ , nest 2 (pprGRHSs ctxt grhss) ]
where
(herald, other_pats)
= case ctxt of
-- because the Id may be *polymorphic*, but
-- 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
}
deriving (Data, Typeable)
\end{code}
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)
= sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using])
, 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)
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 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
| 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)
= 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)
+ | MDoExpr -- Recursive do-expression
| PArrComp -- Parallel array comprehension
| PatGuard (HsMatchContext id) -- Pattern guard for specified thing
| ParStmtCtxt (HsStmtContext id) -- A branch of a parallel 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
= 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 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 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}
projects / ghc-hetmet.git / blobdiff