--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
+%
+\section[HsExpr]{Abstract Haskell syntax: expressions}
+
+\begin{code}
+#include "HsVersions.h"
+
+module HsExpr where
+
+import AbsUniType ( pprUniType, pprParendUniType, TyVar, UniType
+ IF_ATTACK_PRAGMAS(COMMA cmpTyVar)
+ IF_ATTACK_PRAGMAS(COMMA cmpUniType)
+ )
+import Name ( Name )
+import Unique ( Unique )
+import HsBinds ( Binds )
+import HsLit ( Literal )
+import HsMatches ( pprMatches, pprMatch, Match )
+import HsPat ( ProtoNamePat(..), RenamedPat(..),
+ TypecheckedPat, InPat
+ IF_ATTACK_PRAGMAS(COMMA typeOfPat)
+ )
+import HsTypes ( PolyType )
+import Id ( Id, DictVar(..), DictFun(..) )
+import Outputable
+import ProtoName ( ProtoName(..) ) -- .. for pragmas only
+import Pretty
+import Util
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[AbsSyn-Expr]{Expressions proper}
+%* *
+%************************************************************************
+
+\begin{code}
+data Expr bdee pat
+ = Var bdee -- variable
+ | Lit Literal -- literal
+
+ | Lam (Match bdee pat) -- lambda
+ | App (Expr bdee pat) -- application
+ (Expr bdee pat)
+
+ -- Operator applications and sections.
+ -- NB Bracketed ops such as (+) come out as Vars.
+
+ | OpApp (Expr bdee pat) (Expr bdee pat) (Expr bdee pat)
+ -- middle expr is the "op"
+
+ -- ADR Question? Why is the "op" in a section an expr when it will
+ -- have to be of the form (Var op) anyway?
+ -- WDP Answer: But when the typechecker gets ahold of it, it may
+ -- apply the var to a few types; it will then be an expression.
+
+ | SectionL (Expr bdee pat) (Expr bdee pat)
+ -- right expr is the "op"
+ | SectionR (Expr bdee pat) (Expr bdee pat)
+ -- left expr is the "op"
+
+ | CCall FAST_STRING -- call into the C world; string is
+ [Expr bdee pat] -- the C function; exprs are the
+ -- arguments to pass.
+ Bool -- True <=> might cause Haskell
+ -- garbage-collection (must generate
+ -- more paranoid code)
+ Bool -- True <=> it's really a "casm"
+ -- NOTE: this CCall is the *boxed*
+ -- version; the desugarer will convert
+ -- it into the unboxed "ccall#".
+ UniType -- The result type; will be *bottom*
+ -- until the typechecker gets ahold of it
+
+ | SCC FAST_STRING -- set cost centre annotation
+ (Expr bdee pat) -- expr whose cost is to be measured
+
+ | Case (Expr bdee pat)
+ [Match bdee pat] -- must have at least one Match
+
+ | If -- conditional
+ (Expr bdee pat) -- predicate
+ (Expr bdee pat) -- then part
+ (Expr bdee pat) -- else part
+
+ | Let (Binds bdee pat) -- let(rec)
+ (Expr bdee pat)
+
+ | ListComp (Expr bdee pat) -- list comprehension
+ [Qual bdee pat] -- at least one Qual(ifier)
+
+ | ExplicitList -- syntactic list
+ [Expr bdee pat]
+ | ExplicitListOut -- TRANSLATION
+ UniType -- Unitype gives type of components of list
+ [Expr bdee pat]
+
+ | ExplicitTuple -- tuple
+ [Expr bdee pat]
+ -- NB: Unit is ExplicitTuple []
+ -- for tuples, we can get the types
+ -- direct from the components
+
+ | ExprWithTySig -- signature binding
+ (Expr bdee pat)
+ (PolyType bdee)
+ | ArithSeqIn -- arithmetic sequence
+ (ArithSeqInfo bdee pat)
+ | ArithSeqOut
+ (Expr bdee pat) -- (typechecked, of course)
+ (ArithSeqInfo bdee pat)
+#ifdef DPH
+ | ParallelZF
+ (Expr bdee pat)
+ (ParQuals bdee pat)
+ | ExplicitPodIn
+ [Expr bdee pat]
+ | ExplicitPodOut
+ UniType -- Unitype gives type of components of list
+ [Expr bdee pat]
+ | ExplicitProcessor
+ [Expr bdee pat]
+ (Expr bdee pat)
+#endif {- Data Parallel Haskell -}
+\end{code}
+
+Everything from here on appears only in typechecker output; hence, the
+explicit @Id@s.
+\begin{code}
+ | TyLam -- TRANSLATION
+ [TyVar] -- Not TyVarTemplate, which only occur in a
+ -- binding position in a forall type.
+ (Expr bdee pat)
+ | TyApp -- TRANSLATION
+ (Expr bdee pat) -- generated by Spec
+ [UniType]
+
+ -- DictLam and DictApp are "inverses"
+ | DictLam
+ [DictVar]
+ (Expr bdee pat)
+ | DictApp
+ (Expr bdee pat)
+ [DictVar] -- dictionary names
+
+ -- ClassDictLam and Dictionary are "inverses" (see note below)
+ | ClassDictLam
+ [DictVar]
+ [Id]
+ -- The ordering here allows us to do away with dicts and methods
+
+ -- [I don't understand this comment. WDP. Perhaps a ptr to
+ -- a complete description of what's going on ? ]
+ (Expr bdee pat)
+ | Dictionary
+ [DictVar] -- superclass dictionary names
+ [Id] -- method names
+ | SingleDict -- a simple special case of Dictionary
+ DictVar -- local dictionary name
+\end{code}
+
+\begin{code}
+type ProtoNameExpr = Expr ProtoName ProtoNamePat
+
+type RenamedExpr = Expr Name RenamedPat
+
+type TypecheckedExpr = Expr Id TypecheckedPat
+\end{code}
+
+A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
+@ClassDictLam dictvars methods expr@ is, therefore:
+\begin{verbatim}
+\ x -> case x of ( dictvars-and-methods-tuple ) -> expr
+\end{verbatim}
+
+\begin{code}
+instance (NamedThing bdee, Outputable bdee,
+ NamedThing pat, Outputable pat) =>
+ Outputable (Expr bdee pat) where
+ ppr = pprExpr
+\end{code}
+
+\begin{code}
+pprExpr :: (NamedThing bdee, Outputable bdee,
+ NamedThing pat, Outputable pat) =>
+ PprStyle -> Expr bdee pat -> Pretty
+
+pprExpr sty (Var v)
+ = if (isOpLexeme v) then
+ ppBesides [ppLparen, ppr sty v, ppRparen]
+ else
+ ppr sty v
+
+pprExpr sty (Lit lit) = ppr sty lit
+pprExpr sty (Lam match)
+ = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
+
+pprExpr sty expr@(App e1 e2)
+ = let (fun, args) = collect_args expr [] in
+ ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
+ where
+ collect_args (App fun arg) args = collect_args fun (arg:args)
+ collect_args fun args = (fun, args)
+
+pprExpr sty (OpApp e1 op e2)
+ = case op of
+ Var v -> pp_infixly v
+ _ -> pp_prefixly
+ where
+ pp_e1 = pprParendExpr sty e1
+ pp_e2 = pprParendExpr sty e2
+
+ pp_prefixly
+ = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
+
+ pp_infixly v
+ = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
+
+pprExpr sty (SectionL expr op)
+ = case op of
+ Var v -> pp_infixly v
+ _ -> pp_prefixly
+ where
+ pp_expr = pprParendExpr sty expr
+
+ pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
+ 4 (ppCat [pp_expr, ppStr "_x )"])
+ pp_infixly v
+ = ppSep [ ppBesides [ppLparen, pp_expr],
+ ppBesides [pprOp sty v, ppRparen] ]
+
+pprExpr sty (SectionR op expr)
+ = case op of
+ Var v -> pp_infixly v
+ _ -> pp_prefixly
+ where
+ pp_expr = pprParendExpr sty expr
+
+ pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppStr "_x"])
+ 4 (ppBesides [pp_expr, ppRparen])
+ pp_infixly v
+ = ppSep [ ppBesides [ppLparen, pprOp sty v],
+ ppBesides [pp_expr, ppRparen] ]
+
+pprExpr sty (CCall fun args _ is_asm result_ty)
+ = ppHang (if is_asm
+ then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
+ else ppCat [ppStr "_ccall_", ppPStr fun])
+ 4 (ppSep (map (pprParendExpr sty) args
+ {-++ [ppCat [ppStr "{-", ppr sty result_ty, ppStr "-}"]]-}))
+ -- printing the result type can give reader panics (ToDo: fix)
+
+pprExpr sty (SCC label expr)
+ = ppSep [ ppBesides [ppStr "scc", ppBesides [ppChar '"', ppPStr label, ppChar '"'] ],
+ pprParendExpr sty expr ]
+
+pprExpr sty (Case expr matches)
+ = ppSep [ ppSep [ppStr "case", ppNest 4 (pprExpr sty expr), ppStr "of"],
+ ppNest 2 (pprMatches sty (True, ppNil) matches) ]
+
+pprExpr sty (ListComp expr quals)
+ = ppHang (ppCat [ppStr "[", pprExpr sty expr, ppStr "|"])
+ 4 (ppSep [interpp'SP sty quals, ppRbrack])
+
+-- special case: let ... in let ...
+pprExpr sty (Let binds expr@(Let _ _))
+ = ppSep [ppHang (ppStr "let") 2 (ppCat [ppr sty binds, ppStr "in"]),
+ ppr sty expr]
+
+pprExpr sty (Let binds expr)
+ = ppSep [ppHang (ppStr "let") 2 (ppr sty binds),
+ ppHang (ppStr "in") 2 (ppr sty expr)]
+
+pprExpr sty (ExplicitList exprs)
+ = ppBesides [ppLbrack, ppInterleave ppComma (map (pprExpr sty) exprs), ppRbrack]
+pprExpr sty (ExplicitListOut ty exprs)
+ = ppBesides [ ppLbrack, ppInterleave ppComma (map (pprExpr sty) exprs), ppRbrack,
+ case sty of
+ PprForUser -> ppNil
+ _ -> ppBesides [ppStr " (", pprUniType sty ty, ppStr ")"] ]
+
+pprExpr sty (ExplicitTuple exprs)
+ = ppBesides [ppLparen, ppInterleave ppComma (map (pprExpr sty) exprs), ppRparen]
+pprExpr sty (ExprWithTySig expr sig)
+ = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppStr " ::"])
+ 4 (ppBesides [ppr sty sig, ppRparen])
+
+pprExpr sty (If e1 e2 e3)
+ = ppSep [ppCat [ppStr "if", ppNest 2 (pprExpr sty e1), ppStr "then"],
+ ppNest 4 (pprExpr sty e2),
+ ppStr "else",
+ ppNest 4 (pprExpr sty e3)]
+pprExpr sty (ArithSeqIn info)
+ = ppCat [ppLbrack, ppr sty info, ppRbrack]
+pprExpr sty (ArithSeqOut expr info)
+ = case sty of
+ PprForUser ->
+ ppBesides [ppLbrack, ppr sty info, ppRbrack]
+ _ ->
+ ppBesides [ppLbrack, ppLparen, ppr sty expr, ppRparen, ppr sty info, ppRbrack]
+#ifdef DPH
+pprExpr sty (ParallelZF expr pquals)
+ = ppHang (ppCat [ppStr "<<" , pprExpr sty expr , ppStr "|"])
+ 4 (ppSep [ppr sty pquals, ppStr ">>"])
+
+pprExpr sty (ExplicitPodIn exprs)
+ = ppBesides [ppStr "<<", ppInterleave ppComma (map (pprExpr sty) exprs) ,
+ ppStr ">>"]
+
+pprExpr sty (ExplicitPodOut ty exprs)
+ = ppBesides [ppStr "(",ppStr "<<",
+ ppInterleave ppComma (map (pprExpr sty) exprs),
+ ppStr ">>", ppStr " ::" , ppStr "<<" , pprUniType sty ty ,
+ ppStr ">>" , ppStr ")"]
+
+pprExpr sty (ExplicitProcessor exprs expr)
+ = ppBesides [ppStr "(|", ppInterleave ppComma (map (pprExpr sty) exprs) ,
+ ppSemi , pprExpr sty expr, ppStr "|)"]
+
+#endif {- Data Parallel Haskell -}
+
+-- for these translation-introduced things, we don't show them
+-- if style is PprForUser
+
+pprExpr sty (TyLam tyvars expr)
+ = case sty of
+ PprForUser -> pprExpr sty expr
+ _ -> ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
+ 4 (pprExpr sty expr)
+
+pprExpr sty (TyApp expr [ty])
+ = case sty of
+ PprForUser -> pprExpr sty expr
+ _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (pprParendUniType sty ty)
+ where
+ pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ")
+
+pprExpr sty (TyApp expr tys)
+ = case sty of
+ PprForUser -> pprExpr sty expr
+ _ -> ppHang (ppBeside pp_note (pprExpr sty expr))
+ 4 (ppBesides [ppLbrack, interpp'SP sty tys, ppRbrack])
+ where
+ pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ")
+
+pprExpr sty (DictLam dictvars expr)
+ = case sty of
+ PprForUser -> pprExpr sty expr
+ _ -> ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
+ 4 (pprExpr sty expr)
+
+pprExpr sty (DictApp expr [dname])
+ = case sty of
+ PprForUser -> pprExpr sty expr
+ _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (ppr sty dname)
+ where
+ pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ")
+
+pprExpr sty (DictApp expr dnames)
+ = case sty of
+ PprForUser -> pprExpr sty expr
+ _ -> ppHang (ppBeside pp_note (pprExpr sty expr))
+ 4 (ppBesides [ppLbrack, interpp'SP sty dnames, ppRbrack])
+ where
+ pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ")
+
+pprExpr sty (ClassDictLam dicts methods expr)
+ = case sty of
+ PprForUser -> pprExpr sty expr
+ _ -> ppHang (ppCat [ppStr "\\{-classdict-}",
+ ppBesides [ppLbrack, interppSP sty dicts, ppRbrack],
+ ppBesides [ppLbrack, interppSP sty methods, ppRbrack],
+ ppStr "->"])
+ 4 (pprExpr sty expr)
+
+pprExpr sty (Dictionary dictNames methods)
+ = ppSep [ppBesides [ppLparen, ppStr "{-dict-}"],
+ ppBesides [ppLbrack, interpp'SP sty dictNames, ppRbrack],
+ ppBesides [ppLbrack, interpp'SP sty methods, ppRbrack, ppRparen]]
+
+pprExpr sty (SingleDict dname)
+ = ppCat [ppStr "{-singleDict-}", ppr sty dname]
+\end{code}
+
+Parenthesize unless very simple:
+\begin{code}
+pprParendExpr :: (NamedThing bdee, Outputable bdee,
+ NamedThing pat, Outputable pat) =>
+ PprStyle -> Expr bdee pat -> Pretty
+pprParendExpr sty e@(Var _) = pprExpr sty e
+pprParendExpr sty e@(Lit _) = pprExpr sty e
+pprParendExpr sty other_e = ppBesides [ppLparen, pprExpr sty other_e, ppRparen]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[AbsSyntax-enums-list-comps]{Enumerations and list comprehensions}
+%* *
+%************************************************************************
+
+\begin{code}
+data ArithSeqInfo bdee pat
+ = From (Expr bdee pat)
+ | FromThen (Expr bdee pat) (Expr bdee pat)
+ | FromTo (Expr bdee pat) (Expr bdee pat)
+ | FromThenTo (Expr bdee pat) (Expr bdee pat) (Expr bdee pat)
+
+type ProtoNameArithSeqInfo = ArithSeqInfo ProtoName ProtoNamePat
+type RenamedArithSeqInfo = ArithSeqInfo Name RenamedPat
+type TypecheckedArithSeqInfo = ArithSeqInfo Id TypecheckedPat
+\end{code}
+
+\begin{code}
+instance (NamedThing bdee, Outputable bdee,
+ NamedThing pat, Outputable pat) =>
+ Outputable (ArithSeqInfo bdee pat) where
+ ppr sty (From e1) = ppBesides [ppr sty e1, ppStr " .. "]
+ ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, ppStr " .. "]
+ ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, ppStr " .. ", ppr sty e3]
+ ppr sty (FromThenTo e1 e2 e3)
+ = ppBesides [ppr sty e1, pp'SP, ppr sty e2, ppStr " .. ", ppr sty e3]
+\end{code}
+
+``Qualifiers'' in list comprehensions:
+\begin{code}
+data Qual bdee pat
+ = GeneratorQual pat (Expr bdee pat)
+ | FilterQual (Expr bdee pat)
+
+type ProtoNameQual = Qual ProtoName ProtoNamePat
+type RenamedQual = Qual Name RenamedPat
+type TypecheckedQual = Qual Id TypecheckedPat
+\end{code}
+
+\begin{code}
+instance (NamedThing bdee, Outputable bdee,
+ NamedThing pat, Outputable pat) =>
+ Outputable (Qual bdee pat) where
+ ppr sty (GeneratorQual pat expr)
+ = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
+ ppr sty (FilterQual expr) = ppr sty expr
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[AbsSyntax-parallel-quals]{Parallel Qualifiers for ZF expressions}
+%* *
+%************************************************************************
+
+\begin{code}
+#ifdef DPH
+data ParQuals var pat
+ = AndParQuals (ParQuals var pat)
+ (ParQuals var pat)
+ | DrawnGenIn [pat]
+ pat
+ (Expr var pat) -- (|pat1,...,patN;pat|)<<-exp
+
+ | DrawnGenOut [pat] -- Same information as processor
+ [(Expr var pat)] -- Conversion fn of type t -> Integer
+ pat -- to keep things together :-)
+ (Expr var pat)
+ | IndexGen [(Expr var pat)]
+ pat
+ (Expr var pat) -- (|exp1,...,expN;pat|)<<-exp
+ | ParFilter (Expr var pat)
+
+type ProtoNameParQuals = ParQuals ProtoName ProtoNamePat
+type RenamedParQuals = ParQuals Name RenamedPat
+type TypecheckedParQuals = ParQuals Id TypecheckedPat
+
+instance (NamedThing bdee, Outputable bdee,
+ NamedThing pat, Outputable pat) =>
+ Outputable (ParQuals bdee pat) where
+ ppr sty (AndParQuals quals1 quals2)
+ = ppBesides [ppr sty quals1, pp'SP, ppr sty quals2]
+ ppr sty (DrawnGenIn pats pat expr)
+ = ppCat [ppStr "(|",
+ ppInterleave ppComma (map (ppr sty) pats),
+ ppSemi, ppr sty pat,ppStr "|)",
+ ppStr "<<-", ppr sty expr]
+
+ ppr sty (DrawnGenOut pats convs pat expr)
+ = case sty of
+ PprForUser -> basic_ppr
+ _ -> ppHang basic_ppr 4 exprs_ppr
+ where
+ basic_ppr = ppCat [ppStr "(|",
+ ppInterleave ppComma (map (ppr sty) pats),
+ ppSemi, ppr sty pat,ppStr "|)",
+ ppStr "<<-", ppr sty expr]
+
+ exprs_ppr = ppBesides [ppStr "{- " ,
+ ppr sty convs,
+ ppStr " -}"]
+
+ ppr sty (IndexGen exprs pat expr)
+ = ppCat [ppStr "(|",
+ ppInterleave ppComma (map (pprExpr sty) exprs),
+ ppSemi, ppr sty pat, ppStr "|)",
+ ppStr "<<=", ppr sty expr]
+
+ ppr sty (ParFilter expr) = ppr sty expr
+#endif {-Data Parallel Haskell -}
+\end{code}
projects / ghc-hetmet.git / blobdiff