% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
-- | Abstract Haskell syntax for expressions.
module HsExpr where
import SrcLoc
import Outputable
import FastString
+
+-- libraries:
+import Data.Data hiding (Fixity)
\end{code}
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)]
+type PostTcTable = [(Name, PostTcExpr)]
noPostTcExpr :: PostTcExpr
noPostTcExpr = HsLit (HsString (fsLit "noPostTcExpr"))
--
-- 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
+-- etc
type SyntaxExpr id = HsExpr id
| HsWrap HsWrapper -- TRANSLATION
(HsExpr id)
+ deriving (Data, Typeable)
-- HsTupArg is used for tuple sections
-- (,a,) is represented by ExplicitTuple [Mising ty1, Present a, Missing ty3]
data HsTupArg id
= Present (LHsExpr id) -- The argument
| Missing PostTcType -- The argument is missing, but this is its type
+ deriving (Data, Typeable)
tupArgPresent :: HsTupArg id -> Bool
tupArgPresent (Present {}) = True
type LHsCmd id = LHsExpr id
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
+ deriving (Data, Typeable)
\end{code}
The legal constructors for commands are:
PostTcType -- return type of the command
(SyntaxTable id) -- after type checking:
-- names used in the command's desugaring
+ deriving (Data, Typeable)
\end{code}
%************************************************************************
PostTcType -- The type is the type of the entire group
-- t1 -> ... -> tn -> tr
-- where there are n patterns
+ deriving (Data, Typeable)
type LMatch id = Located (Match id)
(Maybe (LHsType id)) -- A type signature for the result of the match
-- Nothing after typechecking
(GRHSs id)
+ deriving (Data, Typeable)
isEmptyMatchGroup :: MatchGroup id -> Bool
isEmptyMatchGroup (MatchGroup ms _) = null ms
= GRHSs {
grhssGRHSs :: [LGRHS id], -- ^ Guarded RHSs
grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
- }
+ } deriving (Data, Typeable)
type LGRHS id = Located (GRHS id)
-- | Guarded Right Hand Side.
data GRHS id = GRHS [LStmt id] -- Guards
(LHsExpr id) -- Right hand side
+ deriving (Data, Typeable)
\end{code}
We know the list must have at least one @Match@ in it.
-- the returned thing has to be *monomorphic*,
-- so they may be type applications
- , recS_dicts :: DictBinds idR -- Method bindings of Ids bound by the
- -- RecStmt, and used afterwards
+ , recS_dicts :: TcEvBinds -- Method bindings of Ids bound by the
+ -- RecStmt, and used afterwards
}
+ deriving (Data, Typeable)
\end{code}
Note [GroupStmt binder map]
data HsSplice id = HsSplice -- $z or $(f 4)
id -- The id is just a unique name to
(LHsExpr id) -- identify this splice point
+ deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsSplice id) where
ppr = pprSplice
pprSplice :: OutputableBndr id => HsSplice id -> SDoc
pprSplice (HsSplice n e)
- = char '$' <> ifPprDebug (brackets (ppr n)) <> pprParendExpr e
-
+ = char '$' <> ifPprDebug (brackets (ppr n)) <> eDoc
+ where
+ -- We use pprLExpr to match pprParendExpr:
+ -- Using pprLExpr makes sure that we go 'deeper'
+ -- I think that is usually (always?) right
+ pp_as_was = pprLExpr e
+ eDoc = case unLoc e of
+ HsPar _ -> pp_as_was
+ HsVar _ -> pp_as_was
+ _ -> parens pp_as_was
data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
| PatBr (LPat id) -- [p| pat |]
| DecBrG (HsGroup id) -- [d| decls |]; result of renamer
| TypBr (LHsType id) -- [t| type |]
| VarBr id -- 'x, ''T
+ deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsBracket id) where
ppr = pprHsBracket
| FromThenTo (LHsExpr id)
(LHsExpr id)
(LHsExpr id)
+ deriving (Data, Typeable)
\end{code}
\begin{code}
\begin{code}
data HsMatchContext id -- Context of a Match
= FunRhs id Bool -- Function binding for f; True <=> written infix
- | CaseAlt -- Patterns and guards on a case alternative
| LambdaExpr -- Patterns of a lambda
+ | CaseAlt -- Patterns and guards on a case alternative
| ProcExpr -- Patterns of a proc
| PatBindRhs -- Patterns in the *guards* of a pattern binding
| RecUpd -- Record update [used only in DsExpr to
-- runtime error message to generate]
| StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
| ThPatQuote -- A Template Haskell pattern quotation [p| (a,b) |]
- deriving ()
+ deriving (Data, Typeable)
data HsStmtContext id
= ListComp
| PatGuard (HsMatchContext id) -- Pattern guard for specified thing
| ParStmtCtxt (HsStmtContext id) -- A branch of a parallel stmt
| TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt
+ deriving (Data, Typeable)
\end{code}
\begin{code}
\begin{code}
pprMatchContext :: Outputable id => HsMatchContext id -> SDoc
-pprMatchContext (FunRhs fun _) = ptext (sLit "the definition of")
- <+> quotes (ppr fun)
-pprMatchContext CaseAlt = ptext (sLit "a case alternative")
-pprMatchContext RecUpd = ptext (sLit "a record-update construct")
-pprMatchContext ThPatQuote = ptext (sLit "a Template Haskell pattern quotation")
-pprMatchContext PatBindRhs = ptext (sLit "a pattern binding")
-pprMatchContext LambdaExpr = ptext (sLit "a lambda abstraction")
-pprMatchContext ProcExpr = ptext (sLit "an arrow abstraction")
-pprMatchContext (StmtCtxt ctxt) = ptext (sLit "a pattern binding in")
- $$ pprStmtContext ctxt
+pprMatchContext ctxt
+ | want_an ctxt = ptext (sLit "an") <+> pprMatchContextNoun ctxt
+ | otherwise = ptext (sLit "a") <+> pprMatchContextNoun ctxt
+ where
+ want_an (FunRhs {}) = True -- Use "an" in front
+ want_an ProcExpr = True
+ want_an _ = False
+
+pprMatchContextNoun :: Outputable id => HsMatchContext id -> SDoc
+pprMatchContextNoun (FunRhs fun _) = ptext (sLit "equation for")
+ <+> quotes (ppr fun)
+pprMatchContextNoun CaseAlt = ptext (sLit "case alternative")
+pprMatchContextNoun RecUpd = ptext (sLit "record-update construct")
+pprMatchContextNoun ThPatQuote = ptext (sLit "Template Haskell pattern quotation")
+pprMatchContextNoun PatBindRhs = ptext (sLit "pattern binding")
+pprMatchContextNoun LambdaExpr = ptext (sLit "lambda abstraction")
+pprMatchContextNoun ProcExpr = ptext (sLit "arrow abstraction")
+pprMatchContextNoun (StmtCtxt ctxt) = ptext (sLit "pattern binding in")
+ $$ pprStmtContext ctxt
pprStmtContext :: Outputable id => HsStmtContext id -> SDoc
pprStmtContext (ParStmtCtxt c)
projects / ghc-hetmet.git / blobdiff