-- friends:
import HsBinds ( HsBinds(..), nullBinds )
+import HsTypes ( PostTcType )
import HsLit ( HsLit, HsOverLit )
import BasicTypes ( Fixity(..) )
import HsTypes ( HsType )
import HsImpExp ( isOperator )
-- others:
+import Name ( Name )
import ForeignCall ( Safety )
import Outputable
import PprType ( pprParendType )
-import Type ( Type )
+import Type ( Type )
import Var ( TyVar )
import DataCon ( DataCon )
import CStrings ( CLabelString, pprCLabelString )
-import BasicTypes ( Boxity, tupleParens )
+import BasicTypes ( IPName, Boxity, tupleParens )
import SrcLoc ( SrcLoc )
\end{code}
\begin{code}
data HsExpr id pat
= HsVar id -- variable
- | HsIPVar id -- implicit parameter
+ | HsIPVar (IPName id) -- implicit parameter
| HsOverLit HsOverLit -- Overloaded literals; eliminated by type checker
| HsLit HsLit -- Simple (non-overloaded) literals
-- They are eventually removed by the type checker.
| NegApp (HsExpr id pat) -- negated expr
+ Name -- Name of 'negate' (see RnEnv.lookupSyntaxName)
| HsPar (HsExpr id pat) -- parenthesised expr
(HsExpr id pat)
| HsWith (HsExpr id pat) -- implicit parameter binding
- [(id, HsExpr id pat)]
+ [(IPName id, HsExpr id pat)]
| HsDo HsDoContext
[Stmt id pat] -- "do":one or more stmts
SrcLoc
| ExplicitList -- syntactic list
- [HsExpr id pat]
- | ExplicitListOut -- TRANSLATION
- Type -- Gives type of components of list
+ PostTcType -- Gives type of components of list
[HsExpr id pat]
| ExplicitTuple -- tuple
(HsRecordBinds id pat)
| RecordUpdOut (HsExpr id pat) -- TRANSLATION
+ Type -- Type of *input* record
Type -- Type of *result* record (may differ from
- -- type of input record)
+ -- type of input record)
[id] -- Dicts needed for construction
(HsRecordBinds id pat)
-- NOTE: this CCall is the *boxed*
-- version; the desugarer will convert
-- it into the unboxed "ccall#".
- Type -- The result type; will be *bottom*
+ PostTcType -- The result type; will be *bottom*
-- until the typechecker gets ahold of it
| HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
| isOperator v = parens (ppr v)
| otherwise = ppr v
-ppr_expr (HsIPVar v) = char '?' <> ppr v
+ppr_expr (HsIPVar v) = ppr v
ppr_expr (HsLit lit) = ppr lit
ppr_expr (HsOverLit lit) = ppr lit
| otherwise = char '`' <> ppr v <> char '`'
-- Put it in backquotes if it's not an operator already
-ppr_expr (NegApp e) = char '-' <+> pprParendExpr e
+ppr_expr (NegApp e _) = char '-' <+> pprParendExpr e
ppr_expr (HsPar e) = parens (ppr_expr e)
hang (ptext SLIT("in")) 2 (ppr expr)]
ppr_expr (HsWith expr binds)
- = hsep [ppr expr, ptext SLIT("with"), ppr binds]
+ = hsep [ppr expr, ptext SLIT("with"), pp_ipbinds 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
-ppr_expr (ExplicitList exprs)
- = brackets (fsep (punctuate comma (map ppr_expr exprs)))
-ppr_expr (ExplicitListOut ty exprs)
+ppr_expr (ExplicitList _ exprs)
= brackets (fsep (punctuate comma (map ppr_expr exprs)))
ppr_expr (ExplicitTuple exprs boxity)
ppr_expr (RecordUpd aexp rbinds)
= pp_rbinds (pprParendExpr aexp) rbinds
-ppr_expr (RecordUpdOut aexp _ _ rbinds)
+ppr_expr (RecordUpdOut aexp _ _ _ rbinds)
= pp_rbinds (pprParendExpr aexp) rbinds
ppr_expr (ExprWithTySig expr sig)
HsVar _ -> pp_as_was
HsIPVar _ -> pp_as_was
- ExplicitList _ -> pp_as_was
- ExplicitListOut _ _ -> pp_as_was
+ ExplicitList _ _ -> pp_as_was
ExplicitTuple _ _ -> pp_as_was
HsPar _ -> pp_as_was
hsep [ppr v, char '=', ppr e]
\end{code}
+\begin{code}
+pp_ipbinds :: (Outputable id, Outputable pat)
+ => [(IPName id, HsExpr id pat)] -> SDoc
+pp_ipbinds pairs = hsep (punctuate semi (map pp_item pairs))
+ where
+ pp_item (id,rhs) = ppr id <+> equals <+> ppr_expr rhs
+\end{code}
%************************************************************************
\begin{code}
data Match id pat
= Match
- [id] -- Tyvars wrt which this match is universally quantified
- -- empty after typechecking
[pat] -- The patterns
(Maybe (HsType id)) -- A type signature for the result of the match
-- Nothing after typechecking
data GRHSs id pat
= GRHSs [GRHS id pat] -- Guarded RHSs
(HsBinds id pat) -- The where clause
- (Maybe Type) -- Just rhs_ty after type checking
+ PostTcType -- Type of RHS (after type checking)
data GRHS id pat
= GRHS [Stmt id pat] -- The RHS is the final ResultStmt
-- it printed 'wrong' in error messages
SrcLoc
-mkSimpleMatch :: [pat] -> HsExpr id pat -> Maybe Type -> SrcLoc -> Match id pat
-mkSimpleMatch pats rhs maybe_rhs_ty locn
- = Match [] pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds maybe_rhs_ty)
+mkSimpleMatch :: [pat] -> HsExpr id pat -> Type -> SrcLoc -> Match id pat
+mkSimpleMatch pats rhs rhs_ty locn
+ = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
unguardedRHS :: HsExpr id pat -> SrcLoc -> [GRHS id pat]
unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc]
\begin{code}
getMatchLoc :: Match id pat -> SrcLoc
-getMatchLoc (Match _ _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
+getMatchLoc (Match _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
\end{code}
We know the list must have at least one @Match@ in it.
pprMatch :: (Outputable id, Outputable pat)
=> HsMatchContext id -> Match id pat -> SDoc
-pprMatch ctxt (Match _ pats maybe_ty grhss)
+pprMatch ctxt (Match pats maybe_ty grhss)
= pp_name ctxt <+> sep [sep (map ppr pats),
ppr_maybe_ty,
nest 2 (pprGRHSs ctxt grhss)]
pprGRHSs :: (Outputable id, Outputable pat)
=> HsMatchContext id -> GRHSs id pat -> SDoc
-pprGRHSs ctxt (GRHSs grhss binds maybe_ty)
+pprGRHSs ctxt (GRHSs grhss binds ty)
= vcat (map (pprGRHS ctxt) grhss)
$$
(if nullBinds binds then empty
data Stmt id pat
= BindStmt pat (HsExpr id pat) SrcLoc
| LetStmt (HsBinds id pat)
- | ResultStmt (HsExpr id pat) SrcLoc -- See notes that follow
- | ExprStmt (HsExpr id pat) SrcLoc -- See notes that follow
- | ParStmt [[Stmt id pat]] -- List comp only: parallel set of quals
- | ParStmtOut [([id], [Stmt id pat])] -- PLC after renaming; the ids are the binders
- -- bound by the stmts
+ | ResultStmt (HsExpr id pat) SrcLoc -- See notes that follow
+ | ExprStmt (HsExpr id pat) PostTcType SrcLoc -- See notes that follow
+ -- The type is the *element type* of the expression
+ | ParStmt [[Stmt id pat]] -- List comp only: parallel set of quals
+ | ParStmtOut [([id], [Stmt id pat])] -- PLC after renaming; the ids are the binders
+ -- bound by the stmts
\end{code}
ExprStmts and ResultStmts are a bit tricky, because what they mean
A do expression of type (m res_ty)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- * ExprStmt E: do { ....; E; ... }
+ * ExprStmt E any_ty: do { ....; E; ... }
E :: m any_ty
Translation: E >> ...
A list comprehensions of type [elt_ty]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- * ExprStmt E: [ .. | .... E ]
+ * ExprStmt E Bool: [ .. | .... E ]
[ .. | ..., E, ... ]
[ .. | .... | ..., E | ... ]
E :: Bool
A guard list, guarding a RHS of type rhs_ty
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- * ExprStmt E: f x | ..., E, ... = ...rhs...
+ * ExprStmt E Bool: f x | ..., E, ... = ...rhs...
E :: Bool
Translation: if E then fail else ...
pprStmt (BindStmt pat expr _) = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
pprStmt (LetStmt binds) = hsep [ptext SLIT("let"), pprBinds binds]
-pprStmt (ExprStmt expr _) = ppr expr
+pprStmt (ExprStmt expr _ _) = ppr expr
pprStmt (ResultStmt expr _) = ppr expr
pprStmt (ParStmt stmtss)
= hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
projects / ghc-hetmet.git / blobdiff