[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 d431859..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, 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.
@@ -216,10 +218,9 @@ ppr_expr (HsVar v)
   | isOperator v = parens (ppr v)
   | otherwise    = ppr v
 
-ppr_expr (HsIPVar v) = {- char '?' <> -} 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)]
@@ -249,8 +250,7 @@ ppr_expr (OpApp e1 op fixity e2)
                | 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
@@ -392,7 +393,7 @@ pprParendExpr expr
 
 \begin{code}
 isOperator :: Outputable a => a -> Bool
-isOperator v = isLexSym (_PK_ (showSDoc (ppr v)))
+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.
@@ -449,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
 
@@ -473,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)