[project @ 2001-11-29 13:47:09 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 f072ca3..91ddad3 100644 (file)
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -21,11 +21,11 @@ import Name         ( Name )
 import ForeignCall     ( Safety )
 import Outputable      
 import PprType         ( pprParendType )
-import Type            ( Type )
+import Type            ( Type  )
 import Var             ( TyVar )
 import DataCon         ( DataCon )
 import CStrings                ( CLabelString, pprCLabelString )
-import BasicTypes      ( Boxity, tupleParens )
+import BasicTypes      ( IPName, Boxity, tupleParens )
 import SrcLoc          ( SrcLoc )
 \end{code}
 
@@ -38,7 +38,7 @@ import SrcLoc         ( SrcLoc )
 \begin{code}
 data HsExpr id pat
   = HsVar      id              -- variable
-  | HsIPVar    id              -- implicit parameter
+  | HsIPVar    (IPName id)     -- implicit parameter
   | HsOverLit  HsOverLit       -- Overloaded literals; eliminated by type checker
   | HsLit      HsLit           -- Simple (non-overloaded) literals
 
@@ -83,7 +83,7 @@ data HsExpr id pat
                (HsExpr  id pat)
 
   | HsWith     (HsExpr id pat) -- implicit parameter binding
-               [(id, HsExpr id pat)]
+               [(IPName id, HsExpr id pat)]
 
   | HsDo       HsDoContext
                [Stmt id pat]   -- "do":one or more stmts
@@ -218,7 +218,7 @@ ppr_expr (HsVar v)
   | isOperator v = parens (ppr v)
   | otherwise    = ppr v
 
-ppr_expr (HsIPVar v)     = char '?' <> ppr v
+ppr_expr (HsIPVar v)     = ppr v
 ppr_expr (HsLit lit)     = ppr lit
 ppr_expr (HsOverLit lit) = ppr lit
 
@@ -297,7 +297,7 @@ ppr_expr (HsLet binds expr)
         hang (ptext SLIT("in"))  2 (ppr expr)]
 
 ppr_expr (HsWith expr binds)
-  = hsep [ppr expr, ptext SLIT("with"), ppr binds]
+  = hsep [ppr expr, ptext SLIT("with"), pp_ipbinds binds]
 
 ppr_expr (HsDo do_or_list_comp stmts _)            = pprDo do_or_list_comp stmts
 ppr_expr (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp stmts
@@ -411,6 +411,13 @@ pp_rbinds thing rbinds
           hsep [ppr v, char '=', ppr e]
 \end{code}
 
+\begin{code}
+pp_ipbinds :: (Outputable id, Outputable pat)
+          => [(IPName id, HsExpr id pat)] -> SDoc
+pp_ipbinds pairs = hsep (punctuate semi (map pp_item pairs))
+                where
+                  pp_item (id,rhs) = ppr id <+> equals <+> ppr_expr rhs
+\end{code}
 
 
 %************************************************************************
@@ -436,8 +443,6 @@ patterns in each equation.
 \begin{code}
 data Match id pat
   = Match
-       [id]                    -- Tyvars wrt which this match is universally quantified
-                               -- empty after typechecking
        [pat]                   -- The patterns
        (Maybe (HsType id))     -- A type signature for the result of the match
                                --      Nothing after typechecking
@@ -458,7 +463,7 @@ data GRHS id pat
 
 mkSimpleMatch :: [pat] -> HsExpr id pat -> Type -> SrcLoc -> Match id pat
 mkSimpleMatch pats rhs rhs_ty locn
-  = Match [] pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
+  = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
 
 unguardedRHS :: HsExpr id pat -> SrcLoc -> [GRHS id pat]
 unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc]
@@ -470,7 +475,7 @@ THis is something of a nuisance, but no more.
 
 \begin{code}
 getMatchLoc :: Match id pat -> SrcLoc
-getMatchLoc (Match _ _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
+getMatchLoc (Match _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
 \end{code}
 
 We know the list must have at least one @Match@ in it.
@@ -493,7 +498,7 @@ pprPatBind pat grhss = sep [ppr pat, nest 4 (pprGRHSs PatBindRhs grhss)]
 
 pprMatch :: (Outputable id, Outputable pat)
           => HsMatchContext id -> Match id pat -> SDoc
-pprMatch ctxt (Match _ pats maybe_ty grhss)
+pprMatch ctxt (Match pats maybe_ty grhss)
   = pp_name ctxt <+> sep [sep (map ppr pats), 
                     ppr_maybe_ty,
                     nest 2 (pprGRHSs ctxt grhss)]