| SectionR (LHsExpr id) -- operator
(LHsExpr id) -- operand
+ | ExplicitTuple -- Used for explicit tuples and sections thereof
+ [HsTupArg id]
+ Boxity
+
| HsCase (LHsExpr id)
(MatchGroup id)
PostTcType -- type of elements of the parallel array
[LHsExpr id]
- | ExplicitTuple -- tuple
- [LHsExpr id]
- -- NB: Unit is ExplicitTuple []
- -- for tuples, we can get the types
- -- direct from the components
- Boxity
-
-
-- Record construction
| RecordCon (Located id) -- The constructor. After type checking
-- it's the dataConWrapId of the constructor
| HsWrap HsWrapper -- TRANSLATION
(HsExpr id)
+-- HsTupArg is used for tuple sections
+-- (,a,) is represented by ExplicitTuple [Mising ty1, Present a, Missing ty3]
+-- Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
+data HsTupArg id
+ = Present (LHsExpr id) -- The argument
+ | Missing PostTcType -- The argument is missing, but this is its type
+
+tupArgPresent :: HsTupArg id -> Bool
+tupArgPresent (Present {}) = True
+tupArgPresent (Missing {}) = False
+
type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
-- pasted back in by the desugarer
\end{code}
pp_infixly v
= (sep [pprHsInfix v, pp_expr])
+ppr_expr (ExplicitTuple exprs boxity)
+ = tupleParens boxity (fcat (ppr_tup_args exprs))
+ where
+ ppr_tup_args [] = []
+ ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
+ ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
+
+ punc (Present {} : _) = comma <> space
+ punc (Missing {} : _) = comma
+ punc [] = empty
+
--avoid using PatternSignatures for stage1 code portability
ppr_expr exprType@(HsLam matches)
= pprMatches (LambdaExpr `asTypeOf` idType exprType) matches
ppr_expr (ExplicitPArr _ exprs)
= pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
-ppr_expr (ExplicitTuple exprs boxity)
- = tupleParens boxity (sep (punctuate comma (map ppr_lexpr exprs)))
-
ppr_expr (RecordCon con_id _ rbinds)
= hang (ppr con_id) 2 (ppr rbinds)
-- I think that is usually (always?) right
in
case unLoc expr of
- ArithSeq{} -> pp_as_was
- PArrSeq{} -> pp_as_was
- HsLit _ -> pp_as_was
- HsOverLit _ -> pp_as_was
- HsVar _ -> pp_as_was
- HsIPVar _ -> pp_as_was
- ExplicitList _ _ -> pp_as_was
- ExplicitPArr _ _ -> pp_as_was
- ExplicitTuple _ _ -> pp_as_was
- HsPar _ -> pp_as_was
- HsBracket _ -> pp_as_was
- HsBracketOut _ [] -> pp_as_was
+ ArithSeq {} -> pp_as_was
+ PArrSeq {} -> pp_as_was
+ HsLit {} -> pp_as_was
+ HsOverLit {} -> pp_as_was
+ HsVar {} -> pp_as_was
+ HsIPVar {} -> pp_as_was
+ ExplicitTuple {} -> pp_as_was
+ ExplicitList {} -> pp_as_was
+ ExplicitPArr {} -> pp_as_was
+ HsPar {} -> pp_as_was
+ HsBracket {} -> pp_as_was
+ HsBracketOut _ [] -> pp_as_was
HsDo sc _ _ _
| isListCompExpr sc -> pp_as_was
_ -> parens pp_as_was
where usingExprDoc = either (\usingExpr -> hsep [ptext (sLit "using"), ppr usingExpr]) (const empty) eitherUsingExpr
pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
-pprDo DoExpr stmts body = ptext (sLit "do") <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
-pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
+pprDo DoExpr 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
pprDo _ _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
+ppr_do_stmts :: OutputableBndr id => [LStmt id] -> LHsExpr 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])
+ <+> rbrace
+
pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
pprComp brack quals body
= brack $