[project @ 1999-12-06 15:38:05 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 d1ba901..ef2153f 100644 (file)
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -11,13 +11,13 @@ module HsExpr where
 -- friends:
 import {-# SOURCE #-} HsMatches ( pprMatches, pprMatch, Match )
 
-import HsBinds         ( HsBinds )
+import HsBinds         ( HsBinds(..) )
 import HsBasic         ( HsLit )
 import BasicTypes      ( Fixity(..), FixityDirection(..) )
 import HsTypes         ( HsType )
 
 -- others:
-import Name            ( Name, NamedThing(..), isSymOcc )
+import Name            ( Name, isLexId ) 
 import Outputable      
 import PprType         ( pprType, pprParendType )
 import Type            ( Type )
@@ -153,6 +153,18 @@ data HsExpr id pat
                (HsExpr id pat) -- expr whose cost is to be measured
 \end{code}
 
+These constructors only appear temporarily in the parser.
+The renamer translates them into the Right Thing.
+
+\begin{code}
+  | EWildPat                   -- wildcard
+
+  | EAsPat     id              -- as pattern
+               (HsExpr id pat)
+
+  | ELazyPat   (HsExpr id pat) -- ~ pattern
+\end{code}
+
 Everything from here on appears only in typechecker output.
 
 \begin{code}
@@ -184,13 +196,13 @@ A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 \end{verbatim}
 
 \begin{code}
-instance (NamedThing id, Outputable id, Outputable pat) =>
+instance (Outputable id, Outputable pat) =>
                Outputable (HsExpr id pat) where
     ppr expr = pprExpr expr
 \end{code}
 
 \begin{code}
-pprExpr :: (NamedThing id, Outputable id, Outputable pat)
+pprExpr :: (Outputable id, Outputable pat)
         => HsExpr id pat -> SDoc
 
 pprExpr e = pprDeeper (ppr_expr e)
@@ -223,10 +235,15 @@ ppr_expr (OpApp e1 op fixity e2)
       = hang (pprExpr op) 4 (sep [pp_e1, pp_e2])
 
     pp_infixly v
-      = sep [pp_e1, hsep [pp_v, pp_e2]]
+      = sep [pp_e1, hsep [pp_v_op, pp_e2]]
       where
-        pp_v | isSymOcc (getOccName v) = ppr v
-            | otherwise               = char '`' <> ppr v <> char '`'
+       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.
 
 ppr_expr (NegApp e _)
   = char '-' <+> pprParendExpr e
@@ -313,14 +330,18 @@ ppr_expr (ArithSeqIn info)
 ppr_expr (ArithSeqOut expr info)
   = brackets (ppr info)
 
+ppr_expr EWildPat = char '_'
+ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
+ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
+
 ppr_expr (CCall fun args _ is_asm result_ty)
   = hang (if is_asm
          then ptext SLIT("_casm_ ``") <> ptext fun <> ptext SLIT("''")
          else ptext SLIT("_ccall_") <+> ptext fun)
        4 (sep (map pprParendExpr args))
 
-ppr_expr (HsSCC label expr)
-  = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ptext label), pprParendExpr expr ]
+ppr_expr (HsSCC lbl expr)
+  = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ptext lbl), pprParendExpr expr ]
 
 ppr_expr (TyLam tyvars expr)
   = hang (hsep [ptext SLIT("/\\"), interppSP tyvars, ptext SLIT("->")])
@@ -348,7 +369,7 @@ ppr_expr (DictApp expr dnames)
 
 Parenthesize unless very simple:
 \begin{code}
-pprParendExpr :: (NamedThing id, Outputable id, Outputable pat)
+pprParendExpr :: (Outputable id, Outputable pat)
              => HsExpr id pat -> SDoc
 
 pprParendExpr expr
@@ -375,7 +396,7 @@ pprParendExpr expr
 %************************************************************************
 
 \begin{code}
-pp_rbinds :: (NamedThing id, Outputable id, Outputable pat)
+pp_rbinds :: (Outputable id, Outputable pat)
              => SDoc 
              -> HsRecordBinds id pat -> SDoc
 
@@ -432,10 +453,14 @@ data Stmt id pat
                SrcLoc
 
   | ReturnStmt (HsExpr id pat)         -- List comps only, at the end
+
+consLetStmt :: HsBinds id pat -> [Stmt id pat] -> [Stmt id pat]
+consLetStmt EmptyBinds stmts = stmts
+consLetStmt binds      stmts = LetStmt binds : stmts
 \end{code}
 
 \begin{code}
-instance (NamedThing id, Outputable id, Outputable pat) =>
+instance (Outputable id, Outputable pat) =>
                Outputable (Stmt id pat) where
     ppr stmt = pprStmt stmt
 
@@ -470,7 +495,7 @@ data ArithSeqInfo id pat
 \end{code}
 
 \begin{code}
-instance (NamedThing id, Outputable id, Outputable pat) =>
+instance (Outputable id, Outputable pat) =>
                Outputable (ArithSeqInfo id pat) where
     ppr (From e1)              = hcat [ppr e1, pp_dotdot]
     ppr (FromThen e1 e2)       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]