[project @ 2002-11-05 09:31:37 by simonmar]

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

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index c02c435..a3d127d 100644 (file)
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -18,14 +18,13 @@ import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr,
 import HsImpExp                ( pprHsVar )
 import HsPat           ( Pat )
 import HsTypes         ( HsType )
-import CoreSyn         ( CoreExpr )
 import PprCore         ( {- instance Outputable (Expr a) -} )
 
 --others:
 import Name            ( Name )
 import PrelNames       ( isUnboundName )
 import NameSet         ( NameSet, elemNameSet, nameSetToList )
-import BasicTypes      ( RecFlag(..), FixitySig(..), Activation(..) )
+import BasicTypes      ( RecFlag(..), FixitySig(..), Activation(..), IPName )
 import Outputable      
 import SrcLoc          ( SrcLoc )
 import Var             ( TyVar )
@@ -49,13 +48,18 @@ Collections of bindings, created by dependency analysis and translation:
 \begin{code}
 data HsBinds id                -- binders and bindees
   = EmptyBinds
-
-  | ThenBinds  (HsBinds id)
-               (HsBinds id)
-
-  | MonoBind   (MonoBinds id)
-               [Sig id]                -- Empty on typechecker output, Type Signatures
-               RecFlag
+  | ThenBinds  (HsBinds id) (HsBinds id)
+
+  | MonoBind                   -- A mutually recursive group
+       (MonoBinds id)
+       [Sig id]                -- Empty on typechecker output, Type Signatures
+       RecFlag
+
+  | IPBinds                    -- Implcit parameters
+                               -- Not allowed at top level
+       [(IPName id, HsExpr id)]
+       Bool            -- True <=> this was a 'with' binding
+                       --  (tmp, until 'with' is removed)
 \end{code}
 
 \begin{code}
@@ -64,10 +68,11 @@ nullBinds :: HsBinds id -> Bool
 nullBinds EmptyBinds           = True
 nullBinds (ThenBinds b1 b2)    = nullBinds b1 && nullBinds b2
 nullBinds (MonoBind b _ _)     = nullMonoBinds b
+nullBinds (IPBinds b _)        = null b
 
-mkMonoBind :: MonoBinds id -> [Sig id] -> RecFlag -> HsBinds id
-mkMonoBind EmptyMonoBinds _ _ = EmptyBinds
-mkMonoBind mbinds sigs is_rec = MonoBind mbinds sigs is_rec
+mkMonoBind :: RecFlag -> MonoBinds id -> HsBinds id
+mkMonoBind _      EmptyMonoBinds  = EmptyBinds
+mkMonoBind is_rec mbinds         = MonoBind mbinds [] is_rec
 \end{code}
 
 \begin{code}
@@ -77,6 +82,12 @@ instance (OutputableBndr id) => Outputable (HsBinds id) where
 ppr_binds EmptyBinds = empty
 ppr_binds (ThenBinds binds1 binds2)
     = ppr_binds binds1 $$ ppr_binds binds2
+
+ppr_binds (IPBinds binds is_with)
+  = sep (punctuate semi (map pp_item binds))
+  where
+    pp_item (id,rhs) = pprBndr LetBind id <+> equals <+> pprExpr rhs
+
 ppr_binds (MonoBind bind sigs is_rec)
      = vcat [ppr_isrec,
             vcat (map ppr sigs),
@@ -125,9 +136,6 @@ data MonoBinds id
   | VarMonoBind            id                  -- TRANSLATION
                    (HsExpr id)
 
-  | CoreMonoBind    id                 -- TRANSLATION
-                   CoreExpr            -- No zonking; this is a final CoreExpr with Ids and Types!
-
   | AbsBinds                           -- Binds abstraction; TRANSLATION
                [TyVar]                 -- Type variables
                [id]                    -- Dicts
@@ -212,9 +220,6 @@ ppr_monobind (FunMonoBind fun inf matches locn) = pprFunBind fun matches
 ppr_monobind (VarMonoBind name expr)
       = sep [pprBndr LetBind name <+> equals, nest 4 (pprExpr expr)]
 
-ppr_monobind (CoreMonoBind name expr)
-      = sep [pprBndr LetBind name <+> equals, nest 4 (ppr expr)]
-
 ppr_monobind (AbsBinds tyvars dictvars exports inlines val_binds)
      = sep [ptext SLIT("AbsBinds"),
            brackets (interpp'SP tyvars),
@@ -269,18 +274,18 @@ data Sig name
 
 \begin{code}
 okBindSig :: NameSet -> Sig Name -> Bool
-okBindSig ns (ClassOpSig _ _ _ _)                              = False
-okBindSig ns sig = sigForThisGroup ns sig
+okBindSig ns (ClassOpSig _ _ _ _) = False
+okBindSig ns sig                 = sigForThisGroup ns sig
 
 okClsDclSig :: NameSet -> Sig Name -> Bool
-okClsDclSig ns (Sig _ _ _)                                       = False
-okClsDclSig ns sig = sigForThisGroup ns sig
+okClsDclSig ns (Sig _ _ _) = False
+okClsDclSig ns sig        = sigForThisGroup ns sig
 
 okInstDclSig :: NameSet -> Sig Name -> Bool
-okInstDclSig ns (Sig _ _ _)                                       = False
-okInstDclSig ns (FixSig _)                                        = False
-okInstDclSig ns (SpecInstSig _ _)                                 = True
-okInstDclSig ns sig = sigForThisGroup ns sig
+okInstDclSig ns (Sig _ _ _)      = False
+okInstDclSig ns (FixSig _)       = False
+okInstDclSig ns (SpecInstSig _ _) = True
+okInstDclSig ns sig              = sigForThisGroup ns sig
 
 sigForThisGroup ns sig 
   = case sigName sig of