diff options
Diffstat (limited to 'ghc/compiler/abstractSyn/HsExpr.lhs')
-rw-r--r-- | ghc/compiler/abstractSyn/HsExpr.lhs | 506 |
1 files changed, 0 insertions, 506 deletions
diff --git a/ghc/compiler/abstractSyn/HsExpr.lhs b/ghc/compiler/abstractSyn/HsExpr.lhs deleted file mode 100644 index 131958c1ca..0000000000 --- a/ghc/compiler/abstractSyn/HsExpr.lhs +++ /dev/null @@ -1,506 +0,0 @@ -% -% (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} |