| HsOverLit HsOverLit -- Overloaded literals; eliminated by type checker
| HsLit HsLit -- Simple (non-overloaded) literals
- | HsLam (LMatch id) -- lambda
- | HsApp (LHsExpr id) -- application
+ | HsLam (MatchGroup id) -- Currently always a single match
+
+ | HsApp (LHsExpr id) -- Application
(LHsExpr id)
-- Operator applications:
(LHsExpr id) -- operand
| HsCase (LHsExpr id)
- [LMatch id]
+ (MatchGroup id)
| HsIf (LHsExpr id) -- predicate
(LHsExpr id) -- then part
-- type of input record)
(HsRecordBinds id)
- | ExprWithTySig -- signature binding
+ | ExprWithTySig -- e :: type
(LHsExpr id)
(LHsType id)
+
+ | ExprWithTySigOut -- TRANSLATION
+ (LHsExpr id)
+ (LHsType Name) -- Retain the signature for round-tripping purposes
+
| ArithSeqIn -- arithmetic sequence
(ArithSeqInfo id)
| ArithSeqOut
ppr_expr (HsLit lit) = ppr lit
ppr_expr (HsOverLit lit) = ppr lit
-ppr_expr (HsLam match) = pprMatch LambdaExpr (unLoc match)
-
ppr_expr (HsApp e1 e2)
= let (fun, args) = collect_args e1 [e2] in
(ppr_lexpr fun) <+> (sep (map pprParendExpr args))
pp_infixly v
= parens (sep [ppr v, pp_expr])
+ppr_expr (HsLam matches)
+ = pprMatches LambdaExpr matches
+
ppr_expr (HsCase expr matches)
= sep [ sep [ptext SLIT("case"), nest 4 (ppr expr), ptext SLIT("of")],
nest 2 (pprMatches CaseAlt matches) ]
ppr_expr (ExprWithTySig expr sig)
= hang (nest 2 (ppr_lexpr expr) <+> dcolon)
4 (ppr sig)
+ppr_expr (ExprWithTySigOut expr sig)
+ = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
+ 4 (ppr sig)
ppr_expr (ArithSeqIn info)
= brackets (ppr info)
ppr_expr (HsSpliceE s) = pprSplice s
ppr_expr (HsBracket b) = pprHsBracket b
-ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("where") <+> ppr ps
+ppr_expr (HsBracketOut e []) = ppr e
+ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("pending") <+> ppr ps
ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
= hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), ppr cmd]
ExplicitPArr _ _ -> pp_as_was
ExplicitTuple _ _ -> pp_as_was
HsPar _ -> pp_as_was
+ HsBracket _ -> pp_as_was
+ HsBracketOut _ [] -> pp_as_was
_ -> parens pp_as_was
\end{code}
patterns in each equation.
\begin{code}
+data MatchGroup id
+ = MatchGroup
+ [LMatch id] -- The alternatives
+ PostTcType -- The type is the type of the entire group
+ -- t1 -> ... -> tn -> tr
+ -- where there are n patterns
+
type LMatch id = Located (Match id)
data Match id
[LPat id] -- The patterns
(Maybe (LHsType id)) -- A type signature for the result of the match
-- Nothing after typechecking
-
(GRHSs id)
+-- gaw 2004
+hsLMatchPats :: LMatch id -> [LPat id]
+hsLMatchPats (L _ (Match pats _ _)) = pats
+
-- GRHSs are used both for pattern bindings and for Matches
data GRHSs id
= GRHSs [LGRHS id] -- Guarded RHSs
[HsBindGroup id] -- The where clause
- PostTcType -- Type of RHS (after type checking)
+-- gaw 2004
+-- PostTcType -- Type of RHS (after type checking)
type LGRHS id = Located (GRHS id)
We know the list must have at least one @Match@ in it.
\begin{code}
-pprMatches :: (OutputableBndr id) => HsMatchContext id -> [LMatch id] -> SDoc
-pprMatches ctxt matches = vcat (map (pprMatch ctxt) (map unLoc matches))
+pprMatches :: (OutputableBndr id) => HsMatchContext id -> MatchGroup id -> SDoc
+pprMatches ctxt (MatchGroup matches _) = vcat (map (pprMatch ctxt) (map unLoc matches))
-- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprFunBind :: (OutputableBndr id) => id -> [LMatch id] -> SDoc
+pprFunBind :: (OutputableBndr id) => id -> MatchGroup id -> SDoc
pprFunBind fun matches = pprMatches (FunRhs fun) matches
-- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprPatBind :: (OutputableBndr id)
- => LPat id -> GRHSs id -> SDoc
+pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
+ => LPat bndr -> GRHSs id -> SDoc
pprPatBind pat grhss = sep [ppr pat, nest 4 (pprGRHSs PatBindRhs grhss)]
pprMatch :: OutputableBndr id => HsMatchContext id -> Match id -> SDoc
+-- gaw 2004
pprMatch ctxt (Match pats maybe_ty grhss)
= pp_name ctxt <+> sep [sep (map ppr pats),
- ppr_maybe_ty,
+ ppr_maybe_ty,
nest 2 (pprGRHSs ctxt grhss)]
where
pp_name (FunRhs fun) = ppr fun -- Not pprBndr; the AbsBinds will
pprGRHSs :: OutputableBndr id => HsMatchContext id -> GRHSs id -> SDoc
-pprGRHSs ctxt (GRHSs grhss binds ty)
+-- gaw 2004
+pprGRHSs ctxt (GRHSs grhss binds)
= vcat (map (pprGRHS ctxt . unLoc) grhss)
$$
(if null binds then empty
| ParStmt [([LStmt id], [id])] -- After remaing, the ids are the binders
-- bound by the stmts and used subsequently
- -- Recursive statement
+ -- Recursive statement (see Note [RecStmt] below)
| RecStmt [LStmt id]
--- The next two fields are only valid after renaming
[id] -- The ids are a subset of the variables bound by the stmts
Array comprehensions are handled like list comprehensions -=chak
+Note [RecStmt]
+~~~~~~~~~~~~~~
+Example:
+ 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 ]
+
+ , 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.
+
+
\begin{code}
instance OutputableBndr id => Outputable (Stmt id) where
ppr stmt = pprStmt stmt
projects / ghc-hetmet.git / blobdiff