-- friends:
import {-# SOURCE #-} HsMatches ( pprMatches, pprMatch, Match )
-import HsBinds ( HsBinds )
+import HsBinds ( HsBinds(..) )
import HsBasic ( HsLit )
import BasicTypes ( Fixity(..), FixityDirection(..) )
import HsTypes ( HsType )
-- others:
-import Name ( Name, NamedThing(..), isSymOcc )
+import Name ( Name, isLexId )
import Outputable
import PprType ( pprType, pprParendType )
import Type ( Type )
import Var ( TyVar, Id )
import DataCon ( DataCon )
+import CStrings ( CLabelString, pprCLabelString )
+import BasicTypes ( Boxity, tupleParens )
import SrcLoc ( SrcLoc )
\end{code}
\begin{code}
data HsExpr id pat
= HsVar id -- variable
+ | HsIPVar id -- implicit parameter
| HsLit HsLit -- literal
| HsLitOut HsLit -- TRANSLATION
Type -- (with its type)
| HsLet (HsBinds id pat) -- let(rec)
(HsExpr id pat)
+ | HsWith (HsExpr id pat) -- implicit parameter binding
+ [(id, HsExpr id pat)]
+
| HsDo StmtCtxt
[Stmt id pat] -- "do":one or more stmts
SrcLoc
-- NB: Unit is ExplicitTuple []
-- for tuples, we can get the types
-- direct from the components
- Bool -- boxed?
+ Boxity
- | HsCon DataCon -- TRANSLATION; a saturated constructor application
- [Type]
- [HsExpr id pat]
-- Record construction
| RecordCon id -- The constructor
(HsRecordBinds id pat)
| RecordUpdOut (HsExpr id pat) -- TRANSLATION
- Type -- Type of *result* record (may differ from
+ Type -- Type of *result* record (may differ from
-- type of input record)
- [id] -- Dicts needed for construction
+ [id] -- Dicts needed for construction
(HsRecordBinds id pat)
| ExprWithTySig -- signature binding
(HsExpr id pat) -- (typechecked, of course)
(ArithSeqInfo id pat)
- | CCall FAST_STRING -- call into the C world; string is
+ | HsCCall CLabelString -- call into the C world; string is
[HsExpr id pat] -- the C function; exprs are the
-- arguments to pass.
Bool -- True <=> might cause Haskell
(HsExpr id pat) -- expr whose cost is to be measured
\end{code}
+These constructors only appear temporarily in the parser.
+The renamer translates them into the Right Thing.
+
+\begin{code}
+ | EWildPat -- wildcard
+
+ | EAsPat id -- as pattern
+ (HsExpr id pat)
+
+ | ELazyPat (HsExpr id pat) -- ~ pattern
+\end{code}
+
Everything from here on appears only in typechecker output.
\begin{code}
\end{verbatim}
\begin{code}
-instance (NamedThing id, Outputable id, Outputable pat) =>
+instance (Outputable id, Outputable pat) =>
Outputable (HsExpr id pat) where
ppr expr = pprExpr expr
\end{code}
\begin{code}
-pprExpr :: (NamedThing id, Outputable id, Outputable pat)
+pprExpr :: (Outputable id, Outputable pat)
=> HsExpr id pat -> SDoc
pprExpr e = pprDeeper (ppr_expr e)
pprBinds b = pprDeeper (ppr b)
ppr_expr (HsVar v) = ppr v
+ppr_expr (HsIPVar v) = {- char '?' <> -} ppr v
ppr_expr (HsLit lit) = ppr lit
ppr_expr (HsLitOut lit _) = ppr lit
= hang (pprExpr op) 4 (sep [pp_e1, pp_e2])
pp_infixly v
- = sep [pp_e1, hsep [pp_v, pp_e2]]
+ = sep [pp_e1, hsep [pp_v_op, pp_e2]]
where
- pp_v | isSymOcc (getOccName v) = ppr v
- | otherwise = char '`' <> ppr v <> char '`'
+ pp_v = ppr v
+ pp_v_op | isLexId (_PK_ (showSDoc pp_v)) = char '`' <> pp_v <> char '`'
+ | otherwise = pp_v
+ -- Put it in backquotes if it's not an operator already
+ -- We use (showSDoc pp_v), rather than isSymOcc (getOccName v) simply so
+ -- that we don't need NamedThing in the context of all these funcions.
+ -- Gruesome, but simple.
ppr_expr (NegApp e _)
= char '-' <+> pprParendExpr e
= sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
hang (ptext SLIT("in")) 2 (ppr expr)]
+ppr_expr (HsWith expr binds)
+ = hsep [ppr expr, ptext SLIT("with"), ppr binds]
+
ppr_expr (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp stmts
ppr_expr (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp stmts
= hcat [ brackets (fsep (punctuate comma (map ppr_expr exprs))),
ifNotPprForUser ((<>) space (parens (pprType ty))) ]
-ppr_expr (ExplicitTuple exprs True)
- = parens (sep (punctuate comma (map ppr_expr exprs)))
-
-ppr_expr (ExplicitTuple exprs False)
- = ptext SLIT("(#") <> sep (punctuate comma (map ppr_expr exprs)) <> ptext SLIT("#)")
-
-ppr_expr (HsCon con_id tys args)
- = ppr con_id <+> sep (map pprParendType tys ++
- map pprParendExpr args)
+ppr_expr (ExplicitTuple exprs boxity)
+ = tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
ppr_expr (RecordCon con_id rbinds)
= pp_rbinds (ppr con_id) rbinds
ppr_expr (ArithSeqOut expr info)
= brackets (ppr info)
-ppr_expr (CCall fun args _ is_asm result_ty)
+ppr_expr EWildPat = char '_'
+ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
+ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
+
+ppr_expr (HsCCall fun args _ is_asm result_ty)
= hang (if is_asm
- then ptext SLIT("_casm_ ``") <> ptext fun <> ptext SLIT("''")
- else ptext SLIT("_ccall_") <+> ptext fun)
+ then ptext SLIT("_casm_ ``") <> pprCLabelString fun <> ptext SLIT("''")
+ else ptext SLIT("_ccall_") <+> pprCLabelString fun)
4 (sep (map pprParendExpr args))
-ppr_expr (HsSCC label expr)
- = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ptext label), pprParendExpr expr ]
+ppr_expr (HsSCC lbl expr)
+ = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ptext lbl), pprParendExpr expr ]
ppr_expr (TyLam tyvars expr)
= hang (hsep [ptext SLIT("/\\"), interppSP tyvars, ptext SLIT("->")])
Parenthesize unless very simple:
\begin{code}
-pprParendExpr :: (NamedThing id, Outputable id, Outputable pat)
+pprParendExpr :: (Outputable id, Outputable pat)
=> HsExpr id pat -> SDoc
pprParendExpr expr
HsLitOut l _ -> ppr l
HsVar _ -> pp_as_was
+ HsIPVar _ -> pp_as_was
ExplicitList _ -> pp_as_was
ExplicitListOut _ _ -> pp_as_was
ExplicitTuple _ _ -> pp_as_was
%************************************************************************
\begin{code}
-pp_rbinds :: (NamedThing id, Outputable id, Outputable pat)
+pp_rbinds :: (Outputable id, Outputable pat)
=> SDoc
-> HsRecordBinds id pat -> SDoc
pp_rbinds thing rbinds
= hang thing
- 4 (braces (hsep (punctuate comma (map (pp_rbind) rbinds))))
+ 4 (braces (sep (punctuate comma (map (pp_rbind) rbinds))))
where
pp_rbind (v, e, pun_flag)
= getPprStyle $ \ sty ->
SrcLoc
| ReturnStmt (HsExpr id pat) -- List comps only, at the end
+
+consLetStmt :: HsBinds id pat -> [Stmt id pat] -> [Stmt id pat]
+consLetStmt EmptyBinds stmts = stmts
+consLetStmt binds stmts = LetStmt binds : stmts
\end{code}
\begin{code}
-instance (NamedThing id, Outputable id, Outputable pat) =>
+instance (Outputable id, Outputable pat) =>
Outputable (Stmt id pat) where
ppr stmt = pprStmt stmt
\end{code}
\begin{code}
-instance (NamedThing id, Outputable id, Outputable pat) =>
+instance (Outputable id, Outputable pat) =>
Outputable (ArithSeqInfo id pat) where
ppr (From e1) = hcat [ppr e1, pp_dotdot]
ppr (FromThen e1 e2) = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
projects / ghc-hetmet.git / blobdiff