[project @ 1997-07-05 02:25:45 by sof]

diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
index 22eaf9e..225b4de 100644 (file)
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs
@@ -50,36 +50,34 @@ import Util         ( panic{-, pprTrace-} )
 The main function
 ~~~~~~~~~~~~~~~~~
 \begin{code}
-tcTyAndClassDecls1 :: InstanceMapper
+tcTyAndClassDecls1 :: TcEnv s -> InstanceMapper        -- Knot tying stuff
                   -> [RenamedHsDecl]
                   -> TcM s (TcEnv s)
 
-tcTyAndClassDecls1 inst_mapper decls
+tcTyAndClassDecls1 unf_env inst_mapper decls
   = sortByDependency decls             `thenTc` \ groups ->
-    tcGroups inst_mapper groups
+    tcGroups unf_env inst_mapper groups
 
-tcGroups inst_mapper []
+tcGroups unf_env inst_mapper []
   = tcGetEnv   `thenNF_Tc` \ env ->
     returnTc env
 
-tcGroups inst_mapper (group:groups)
-  = tcGroup inst_mapper group  `thenTc` \ new_env ->
+tcGroups unf_env inst_mapper (group:groups)
+  = tcGroup unf_env inst_mapper group  `thenTc` \ new_env ->
 
        -- Extend the environment using the new tycons and classes
     tcSetEnv new_env $
 
        -- Do the remaining groups
-    tcGroups inst_mapper groups
+    tcGroups unf_env inst_mapper groups
 \end{code}
 
 Dealing with a group
 ~~~~~~~~~~~~~~~~~~~~
 \begin{code}
-tcGroup :: InstanceMapper -> Bag RenamedHsDecl -> TcM s (TcEnv s)
-tcGroup inst_mapper decls
-  = -- pprTrace "tcGroup: " (hsep (map (fst.fmt_decl) (bagToList decls))) $
-
-       -- TIE THE KNOT
+tcGroup :: TcEnv s -> InstanceMapper -> Bag RenamedHsDecl -> TcM s (TcEnv s)
+tcGroup unf_env inst_mapper decls
+  =    -- TIE THE KNOT
     fixTc ( \ ~(tycons,classes,_) ->
 
                -- EXTEND TYPE AND CLASS ENVIRONMENTS
@@ -93,7 +91,7 @@ tcGroup inst_mapper decls
       tcTyVarScope tyvar_names                         ( \ tyvars ->
 
                -- DEAL WITH THE DEFINITIONS THEMSELVES
-       foldBag combine (tcDecl inst_mapper)
+       foldBag combine (tcDecl unf_env inst_mapper)
                (returnTc (emptyBag, emptyBag))
                decls
       )                                                `thenTc` \ (tycon_bag,class_bag) ->
@@ -122,16 +120,16 @@ tcGroup inst_mapper decls
 Dealing with one decl
 ~~~~~~~~~~~~~~~~~~~~~
 \begin{code}
-tcDecl  :: InstanceMapper
+tcDecl  :: TcEnv s -> InstanceMapper
        -> RenamedHsDecl
        -> TcM s (Bag TyCon, Bag Class)
 
-tcDecl inst_mapper (TyD decl)
+tcDecl unf_env inst_mapper (TyD decl)
   = tcTyDecl decl      `thenTc` \ tycon ->
     returnTc (unitBag tycon, emptyBag)
 
-tcDecl inst_mapper (ClD decl)
-  = tcClassDecl1 inst_mapper decl   `thenTc` \ clas ->
+tcDecl unf_env inst_mapper (ClD decl)
+  = tcClassDecl1 unf_env inst_mapper decl   `thenTc` \ clas ->
     returnTc (emptyBag, unitBag clas)
 \end{code}
 

diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index 8cbcf52..83e0f7a 100644 (file)
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -17,14 +17,14 @@ IMP_Ubiq(){-uitous-}
 import HsSyn           ( TyDecl(..), ConDecl(..), ConDetails(..), BangType(..), HsExpr(..), 
                          Match(..), GRHSsAndBinds(..), GRHS(..), OutPat(..), 
                          HsBinds(..), HsLit, Stmt, DoOrListComp, ArithSeqInfo,
-                         SYN_IE(RecFlag), nonRecursive,
+                         SYN_IE(RecFlag), nonRecursive, andMonoBinds, 
                          HsType, Fake, InPat, HsTyVar, Fixity,
                          MonoBinds(..), Sig 
                        )
 import HsTypes         ( getTyVarName )
 import RnHsSyn         ( RenamedTyDecl(..), RenamedConDecl(..) )
 import TcHsSyn         ( mkHsTyLam, mkHsDictLam, tcIdType,
-                         SYN_IE(TcHsBinds), TcIdOcc(..)
+                         SYN_IE(TcHsBinds), TcIdOcc(..), SYN_IE(TcMonoBinds)
                        )
 import Inst            ( newDicts, InstOrigin(..), Inst )
 import TcMonoType      ( tcHsTypeKind, tcHsType, tcContext )
@@ -168,13 +168,13 @@ Generating constructor/selector bindings for data declarations
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 \begin{code}
-mkDataBinds :: [TyCon] -> TcM s ([Id], TcHsBinds s)
-mkDataBinds [] = returnTc ([], EmptyBinds)
+mkDataBinds :: [TyCon] -> TcM s ([Id], TcMonoBinds s)
+mkDataBinds [] = returnTc ([], EmptyMonoBinds)
 mkDataBinds (tycon : tycons) 
   | isSynTyCon tycon = mkDataBinds tycons
   | otherwise       = mkDataBinds_one tycon    `thenTc` \ (ids1, b1) ->
                       mkDataBinds tycons       `thenTc` \ (ids2, b2) ->
-                      returnTc (ids1++ids2, b1 `ThenBinds` b2)
+                      returnTc (ids1++ids2, b1 `AndMonoBinds` b2)
 
 mkDataBinds_one tycon
   = ASSERT( isAlgTyCon tycon )
@@ -189,9 +189,7 @@ mkDataBinds_one tycon
                | data_id <- data_ids, isLocallyDefined data_id
                ]
     in 
-    returnTc (data_ids,
-             MonoBind (foldr AndMonoBinds EmptyMonoBinds binds) [] nonRecursive
-            )
+    returnTc (data_ids, andMonoBinds binds)
   where
     data_cons = tyConDataCons tycon
     fields = [ (con, field) | con   <- data_cons,