% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-
-HsExpr: Abstract Haskell syntax: expressions
-
\begin{code}
+
+-- | Abstract Haskell syntax for expressions.
module HsExpr where
#include "HsVersions.h"
%************************************************************************
\begin{code}
+-- * Expressions proper
+
type LHsExpr id = Located (HsExpr id)
-------------------------
--- PostTcExpr is an evidence expression attached to the
--- syntax tree by the type checker (c.f. postTcType)
--- We use a PostTcTable where there are a bunch of pieces of
--- evidence, more than is convenient to keep individually
+-- | PostTcExpr is an evidence expression attached to the syntax tree by the
+-- type checker (c.f. postTcType).
type PostTcExpr = HsExpr Id
+-- | We use a PostTcTable where there are a bunch of pieces of evidence, more
+-- than is convenient to keep individually.
type PostTcTable = [(Name, Id)]
noPostTcExpr :: PostTcExpr
noPostTcTable = []
-------------------------
--- SyntaxExpr is like PostTcExpr, but it's filled in a little earlier,
+-- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
-- by the renamer. It's used for rebindable syntax.
--- E.g. (>>=) is filled in before the renamer by the appropriate Name
--- for (>>=), and then instantiated by the type checker with its
--- type args tec
+--
+-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
+-- @(>>=)@, and then instantiated by the type checker with its type args
+-- tec
type SyntaxExpr id = HsExpr id
type SyntaxTable id = [(Name, SyntaxExpr id)]
--- *** Currently used only for CmdTop (sigh) ***
--- * Before the renamer, this list is noSyntaxTable
+-- ^ Currently used only for 'CmdTop' (sigh)
+--
+-- * Before the renamer, this list is 'noSyntaxTable'
--
--- * After the renamer, it takes the form [(std_name, HsVar actual_name)]
+-- * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
-- For example, for the 'return' op of a monad
--- normal case: (GHC.Base.return, HsVar GHC.Base.return)
--- with rebindable syntax: (GHC.Base.return, return_22)
--- where return_22 is whatever "return" is in scope
--
--- * After the type checker, it takes the form [(std_name, <expression>)]
--- where <expression> is the evidence for the method
+-- * normal case: @(GHC.Base.return, HsVar GHC.Base.return)@
+--
+-- * with rebindable syntax: @(GHC.Base.return, return_22)@
+-- where @return_22@ is whatever @return@ is in scope
+--
+-- * After the type checker, it takes the form @[(std_name, <expression>)]@
+-- where @<expression>@ is the evidence for the method
noSyntaxTable :: SyntaxTable id
noSyntaxTable = []
-------------------------
+-- | A Haskell expression.
data HsExpr id
- = HsVar id -- variable
- | HsIPVar (IPName id) -- implicit parameter
- | HsOverLit (HsOverLit id) -- Overloaded literals
+ = HsVar id -- ^ variable
+ | HsIPVar (IPName id) -- ^ implicit parameter
+ | HsOverLit (HsOverLit id) -- ^ Overloaded literals
- | HsLit HsLit -- Simple (non-overloaded) literals
+ | HsLit HsLit -- ^ Simple (non-overloaded) literals
| HsLam (MatchGroup id) -- Currently always a single match
| 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
-- Record update
| RecordUpd (LHsExpr id)
(HsRecordBinds id)
+-- (HsMatchGroup Id) -- Filled in by the type checker to be
+-- -- a match that does the job
[DataCon] -- Filled in by the type checker to the
-- _non-empty_ list of DataCons that have
-- all the upd'd fields
| 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
where idType :: HsExpr id -> HsMatchContext id; idType = undefined
ppr_expr exprType@(HsCase expr matches)
- = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of")],
- nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches) ]
+ = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
+ nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches <+> char '}') ]
where idType :: HsExpr id -> HsMatchContext id; idType = undefined
ppr_expr (HsIf e1 e2 e3)
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
- 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
-- Nothing after typechecking
(GRHSs id)
+isEmptyMatchGroup :: MatchGroup id -> Bool
+isEmptyMatchGroup (MatchGroup ms _) = null ms
+
matchGroupArity :: MatchGroup id -> Arity
matchGroupArity (MatchGroup [] _)
- = panic "matchGroupArity" -- MatchGroup is never empty
+ = panic "matchGroupArity" -- Precondition: MatchGroup is non-empty
matchGroupArity (MatchGroup (match:matches) _)
= ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
-- Assertion just checks that all the matches have the same number of pats
hsLMatchPats :: LMatch id -> [LPat id]
hsLMatchPats (L _ (Match pats _ _)) = pats
--- GRHSs are used both for pattern bindings and for Matches
+-- | GRHSs are used both for pattern bindings and for Matches
data GRHSs id
- = GRHSs [LGRHS id] -- Guarded RHSs
- (HsLocalBinds id) -- The where clause
+ = GRHSs {
+ grhssGRHSs :: [LGRHS id], -- ^ Guarded RHSs
+ grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
+ }
type LGRHS id = Located (GRHS id)
+-- | Guarded Right Hand Side.
data GRHS id = GRHS [LStmt id] -- Guards
(LHsExpr id) -- Right hand side
\end{code}
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 $
\begin{code}
data HsMatchContext id -- Context of a Match
= FunRhs id Bool -- Function binding for f; True <=> written infix
- | CaseAlt -- Guard on a case alternative
- | LambdaExpr -- Pattern of a lambda
- | ProcExpr -- Pattern of a proc
- | PatBindRhs -- Pattern binding
+ | CaseAlt -- Patterns and guards on a case alternative
+ | LambdaExpr -- Patterns of a lambda
+ | ProcExpr -- Patterns of a proc
+ | PatBindRhs -- Patterns in the *guards* of a pattern binding
| RecUpd -- Record update [used only in DsExpr to
-- tell matchWrapper what sort of
-- runtime error message to generate]
-}
-- Used to generate the string for a *runtime* error message
-matchContextErrString :: Outputable id => HsMatchContext id -> String
-matchContextErrString (FunRhs fun _) = "function " ++ showSDoc (ppr fun)
-matchContextErrString CaseAlt = "case"
-matchContextErrString PatBindRhs = "pattern binding"
-matchContextErrString RecUpd = "record update"
-matchContextErrString LambdaExpr = "lambda"
-matchContextErrString ProcExpr = "proc"
+matchContextErrString :: Outputable id => HsMatchContext id -> SDoc
+matchContextErrString (FunRhs fun _) = ptext (sLit "function") <+> ppr fun
+matchContextErrString CaseAlt = ptext (sLit "case")
+matchContextErrString PatBindRhs = ptext (sLit "pattern binding")
+matchContextErrString RecUpd = ptext (sLit "record update")
+matchContextErrString LambdaExpr = ptext (sLit "lambda")
+matchContextErrString ProcExpr = ptext (sLit "proc")
matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c)
-matchContextErrString (StmtCtxt (PatGuard _)) = "pattern guard"
-matchContextErrString (StmtCtxt DoExpr) = "'do' expression"
-matchContextErrString (StmtCtxt (MDoExpr _)) = "'mdo' expression"
-matchContextErrString (StmtCtxt ListComp) = "list comprehension"
-matchContextErrString (StmtCtxt PArrComp) = "array comprehension"
+matchContextErrString (StmtCtxt (PatGuard _)) = ptext (sLit "pattern guard")
+matchContextErrString (StmtCtxt DoExpr) = ptext (sLit "'do' expression")
+matchContextErrString (StmtCtxt (MDoExpr _)) = ptext (sLit "'mdo' expression")
+matchContextErrString (StmtCtxt ListComp) = ptext (sLit "list comprehension")
+matchContextErrString (StmtCtxt PArrComp) = ptext (sLit "array comprehension")
\end{code}
\begin{code}
projects / ghc-hetmet.git / blobdiff