[project @ 2000-11-24 17:02:01 by simonpj]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsExpr.lhs

diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index fb4429d..4ba2e2a 100644 (file)
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -12,16 +12,16 @@ module HsExpr where
 import {-# SOURCE #-} HsMatches ( pprMatches, pprMatch, Match )
 
 import HsBinds         ( HsBinds(..) )
-import HsBasic         ( HsLit )
-import BasicTypes      ( Fixity(..), FixityDirection(..) )
+import HsLit           ( HsLit, HsOverLit )
+import BasicTypes      ( Fixity(..) )
 import HsTypes         ( HsType )
 
 -- others:
-import Name            ( Name, isLexId ) 
+import Name            ( Name, isLexSym ) 
 import Outputable      
-import PprType         ( pprType, pprParendType )
+import PprType         ( pprParendType )
 import Type            ( Type )
-import Var             ( TyVar, Id )
+import Var             ( TyVar )
 import DataCon         ( DataCon )
 import CStrings                ( CLabelString, pprCLabelString )
 import BasicTypes      ( Boxity, tupleParens )
@@ -36,11 +36,10 @@ import SrcLoc               ( SrcLoc )
 
 \begin{code}
 data HsExpr id pat
-  = HsVar      id                              -- variable
-  | HsIPVar    id                              -- implicit parameter
-  | HsLit      HsLit                           -- literal
-  | HsLitOut   HsLit                           -- TRANSLATION
-               Type            -- (with its type)
+  = HsVar      id              -- variable
+  | HsIPVar    id              -- implicit parameter
+  | HsOverLit  (HsOverLit id)  -- Overloaded literals; eliminated by type checker
+  | HsLit      HsLit           -- Simple (non-overloaded) literals
 
   | HsLam      (Match  id pat) -- lambda
   | HsApp      (HsExpr id pat) -- application
@@ -61,7 +60,7 @@ data HsExpr id pat
   -- They are eventually removed by the type checker.
 
   | NegApp     (HsExpr id pat) -- negated expr
-               (HsExpr id pat) -- the negate id (in a HsVar)
+               id              -- the negate id (in a HsVar)
 
   | HsPar      (HsExpr id pat) -- parenthesised expr
 
@@ -154,6 +153,7 @@ data HsExpr id pat
 
   | HsSCC      FAST_STRING     -- "set cost centre" (_scc_) annotation
                (HsExpr id pat) -- expr whose cost is to be measured
+
 \end{code}
 
 These constructors only appear temporarily in the parser.
@@ -166,6 +166,8 @@ The renamer translates them into the Right Thing.
                (HsExpr id pat)
 
   | ELazyPat   (HsExpr id pat) -- ~ pattern
+
+  | HsType      (HsType id)     -- Explicit type argument; e.g  f {| Int |} x y
 \end{code}
 
 Everything from here on appears only in typechecker output.
@@ -211,11 +213,14 @@ pprExpr :: (Outputable id, Outputable pat)
 pprExpr e = pprDeeper (ppr_expr e)
 pprBinds b = pprDeeper (ppr b)
 
-ppr_expr (HsVar v) = ppr v
-ppr_expr (HsIPVar v) = {- char '?' <> -} ppr v
+ppr_expr (HsVar v) 
+       -- Put it in parens if it's an operator
+  | isOperator v = parens (ppr v)
+  | otherwise    = ppr v
 
-ppr_expr (HsLit    lit)   = ppr lit
-ppr_expr (HsLitOut lit _) = ppr lit
+ppr_expr (HsIPVar v)     = {- char '?' <> -} ppr v
+ppr_expr (HsLit lit)     = ppr lit
+ppr_expr (HsOverLit lit) = ppr lit
 
 ppr_expr (HsLam match)
   = hsep [char '\\', nest 2 (pprMatch (True,empty) match)]
@@ -241,16 +246,11 @@ ppr_expr (OpApp e1 op fixity e2)
     pp_infixly v
       = sep [pp_e1, hsep [pp_v_op, pp_e2]]
       where
-       pp_v = ppr v
-        pp_v_op | isLexId (_PK_ (showSDoc pp_v)) = char '`' <> pp_v <> char '`'
-               | otherwise                      = pp_v 
-       -- Put it in backquotes if it's not an operator already
-       -- We use (showSDoc pp_v), rather than isSymOcc (getOccName v) simply so
-       -- that we don't need NamedThing in the context of all these funcions.
-       -- Gruesome, but simple.
+        pp_v_op | isOperator v = ppr v
+               | otherwise    = char '`' <> ppr v <> char '`'
+               -- Put it in backquotes if it's not an operator already
 
-ppr_expr (NegApp e _)
-  = char '-' <+> pprParendExpr e
+ppr_expr (NegApp e _) = char '-' <+> pprParendExpr e
 
 ppr_expr (HsPar e) = parens (ppr_expr e)
 
@@ -305,8 +305,7 @@ ppr_expr (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp stmts
 ppr_expr (ExplicitList exprs)
   = brackets (fsep (punctuate comma (map ppr_expr exprs)))
 ppr_expr (ExplicitListOut ty exprs)
-  = hcat [ brackets (fsep (punctuate comma (map ppr_expr exprs))),
-          ifNotPprForUser ((<>) space (parens (pprType ty))) ]
+  = brackets (fsep (punctuate comma (map ppr_expr exprs)))
 
 ppr_expr (ExplicitTuple exprs boxity)
   = tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
@@ -365,6 +364,8 @@ ppr_expr (DictApp expr dnames)
   = hang (ppr_expr expr)
         4 (brackets (interpp'SP dnames))
 
+ppr_expr (HsType id) = ppr id
+    
 \end{code}
 
 Parenthesize unless very simple:
@@ -378,7 +379,7 @@ pprParendExpr expr
     in
     case expr of
       HsLit l              -> ppr l
-      HsLitOut l _         -> ppr l
+      HsOverLit l          -> ppr l
 
       HsVar _              -> pp_as_was
       HsIPVar _                    -> pp_as_was
@@ -390,6 +391,14 @@ pprParendExpr expr
       _                            -> parens pp_as_was
 \end{code}
 
+\begin{code}
+isOperator :: Outputable a => a -> Bool
+isOperator v = isLexSym (_PK_ (showSDocUnqual (ppr v)))
+       -- We use (showSDoc (ppr v)), rather than isSymOcc (getOccName v) simply so
+       -- that we don't need NamedThing in the context of all these functions.
+       -- Gruesome, but simple.
+\end{code}
+
 %************************************************************************
 %*                                                                     *
 \subsection{Record binds}
@@ -441,7 +450,9 @@ pprDo ListComp stmts
 
 \begin{code}
 data Stmt id pat
-  = BindStmt   pat
+  = ParStmt    [[Stmt id pat]]         -- List comp only: parallel set of quals
+  | ParStmtOut [([id], [Stmt id pat])] -- PLC after renaming
+  | BindStmt   pat
                (HsExpr id pat)
                SrcLoc
 
@@ -465,6 +476,10 @@ instance (Outputable id, Outputable pat) =>
                Outputable (Stmt id pat) where
     ppr stmt = pprStmt stmt
 
+pprStmt (ParStmt stmtss)
+ = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
+pprStmt (ParStmtOut stmtss)
+ = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
 pprStmt (BindStmt pat expr _)
  = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
 pprStmt (LetStmt binds)