+++ /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