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
PostTcType -- Gives type of components of list
[HsExpr id pat]
+ | ExplicitPArr -- syntactic parallel array: [:e1, ..., en:]
+ PostTcType -- type of elements of the parallel array
+ [HsExpr id pat]
+
| ExplicitTuple -- tuple
[HsExpr id pat]
-- NB: Unit is ExplicitTuple []
| ArithSeqOut
(HsExpr id pat) -- (typechecked, of course)
(ArithSeqInfo id pat)
+ | PArrSeqIn -- arith. sequence for parallel array
+ (ArithSeqInfo id pat) -- [:e1..e2:] or [:e1, e2..e3:]
+ | PArrSeqOut
+ (HsExpr id pat) -- (typechecked, of course)
+ (ArithSeqInfo id pat)
| HsCCall CLabelString -- call into the C world; string is
[HsExpr id pat] -- the C function; exprs are the
| 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 (ExplicitPArr _ exprs)
+ = pabrackets (fsep (punctuate comma (map ppr_expr exprs)))
+
ppr_expr (ExplicitTuple exprs boxity)
= tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
ppr_expr (ArithSeqOut expr info)
= brackets (ppr info)
+ppr_expr (PArrSeqIn info)
+ = pabrackets (ppr info)
+ppr_expr (PArrSeqOut expr info)
+ = pabrackets (ppr info)
+
ppr_expr EWildPat = char '_'
ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
4 (brackets (interpp'SP dnames))
ppr_expr (HsType id) = ppr id
-
+
+-- add parallel array brackets around a document
+--
+pabrackets :: SDoc -> SDoc
+pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
\end{code}
Parenthesize unless very simple:
HsVar _ -> pp_as_was
HsIPVar _ -> pp_as_was
ExplicitList _ _ -> pp_as_was
+ ExplicitPArr _ _ -> 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
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)
+ = 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)]
E :: rhs_ty
Translation: E
+Array comprehensions are handled like list comprehensions -=chak
\begin{code}
consLetStmt :: HsBinds id pat -> [Stmt id pat] -> [Stmt id pat]
pprStmt (ParStmtOut stmtss)
= hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
-pprDo :: (Outputable id, Outputable pat) => HsDoContext -> [Stmt id pat] -> SDoc
+pprDo :: (Outputable id, Outputable pat)
+ => HsDoContext -> [Stmt id pat] -> SDoc
pprDo DoExpr stmts = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
-pprDo ListComp stmts = brackets $
- hang (pprExpr expr <+> char '|')
- 4 (interpp'SP quals)
- where
- ResultStmt expr _ = last stmts -- Last stmt should
- quals = init stmts -- be an ResultStmt
+pprDo ListComp stmts = pprComp brackets stmts
+pprDo PArrComp stmts = pprComp pabrackets stmts
+
+pprComp :: (Outputable id, Outputable pat)
+ => (SDoc -> SDoc) -> [Stmt id pat] -> SDoc
+pprComp brack stmts = brack $
+ hang (pprExpr expr <+> char '|')
+ 4 (interpp'SP quals)
+ where
+ ResultStmt expr _ = last stmts -- Last stmt should
+ quals = init stmts -- be an ResultStmt
\end{code}
%************************************************************************
| RecUpd -- Record update
deriving ()
-data HsDoContext = ListComp | DoExpr
+data HsDoContext = ListComp
+ | DoExpr
+ | PArrComp -- parallel array comprehension
\end{code}
\begin{code}
pprMatchContext PatBindRhs = ptext SLIT("In a pattern binding")
pprMatchContext LambdaExpr = ptext SLIT("In a lambda abstraction")
pprMatchContext (DoCtxt DoExpr) = ptext SLIT("In a 'do' expression pattern binding")
-pprMatchContext (DoCtxt ListComp) = ptext SLIT("In a 'list comprehension' pattern binding")
+pprMatchContext (DoCtxt ListComp) =
+ ptext SLIT("In a 'list comprehension' pattern binding")
+pprMatchContext (DoCtxt PArrComp) =
+ ptext SLIT("In an 'array comprehension' pattern binding")
-- Used to generate the string for a *runtime* error message
matchContextErrString (FunRhs fun) = "function " ++ showSDoc (ppr fun)
matchContextErrString LambdaExpr = "lambda"
matchContextErrString (DoCtxt DoExpr) = "'do' expression"
matchContextErrString (DoCtxt ListComp) = "list comprehension"
+matchContextErrString (DoCtxt PArrComp) = "array comprehension"
\end{code}
projects / ghc-hetmet.git / blobdiff