[project @ 2000-11-14 10:46:39 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcHsSyn.lhs

diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 00eb754..6acef37 100644 (file)
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -1,5 +1,5 @@
 %
 %

-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998

 %
 \section[TcHsSyn]{Specialisations of the @HsSyn@ syntax for the typechecker}
 
 %
 \section[TcHsSyn]{Specialisations of the @HsSyn@ syntax for the typechecker}
 

@@ -7,59 +7,53 @@ This module is an extension of @HsSyn@ syntax, for use in the type
 checker.
 
 \begin{code}
 checker.
 
 \begin{code}

-#include "HsVersions.h"
-

 module TcHsSyn (
 module TcHsSyn (

-       SYN_IE(TcIdBndr), TcIdOcc(..),
-       
-       SYN_IE(TcMonoBinds), SYN_IE(TcHsBinds), SYN_IE(TcBind), SYN_IE(TcPat),
-       SYN_IE(TcExpr), SYN_IE(TcGRHSsAndBinds), SYN_IE(TcGRHS), SYN_IE(TcMatch),
-       SYN_IE(TcQual), SYN_IE(TcStmt), SYN_IE(TcArithSeqInfo), SYN_IE(TcRecordBinds),
-       SYN_IE(TcHsModule),
+       TcMonoBinds, TcHsBinds, TcPat,
+       TcExpr, TcGRHSs, TcGRHS, TcMatch,
+       TcStmt, TcArithSeqInfo, TcRecordBinds,
+       TcHsModule, TcCoreExpr, TcDictBinds,
+       TcForeignExportDecl,

        
        

-       SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedBind),
-       SYN_IE(TypecheckedMonoBinds), SYN_IE(TypecheckedPat),
-       SYN_IE(TypecheckedHsExpr), SYN_IE(TypecheckedArithSeqInfo),
-       SYN_IE(TypecheckedQual), SYN_IE(TypecheckedStmt),
-       SYN_IE(TypecheckedMatch), SYN_IE(TypecheckedHsModule),
-       SYN_IE(TypecheckedGRHSsAndBinds), SYN_IE(TypecheckedGRHS),
-       SYN_IE(TypecheckedRecordBinds),
-
-       mkHsTyApp, mkHsDictApp,
-       mkHsTyLam, mkHsDictLam,
-       tcIdType, tcIdTyVars,
-
-       zonkBinds,
-       zonkDictBinds
+       TypecheckedHsBinds, TypecheckedRuleDecl,
+       TypecheckedMonoBinds, TypecheckedPat,
+       TypecheckedHsExpr, TypecheckedArithSeqInfo,
+       TypecheckedStmt, TypecheckedForeignDecl,
+       TypecheckedMatch, TypecheckedHsModule,
+       TypecheckedGRHSs, TypecheckedGRHS,
+       TypecheckedRecordBinds, TypecheckedDictBinds,
+
+       mkHsTyApp, mkHsDictApp, mkHsConApp,
+       mkHsTyLam, mkHsDictLam, mkHsLet,
+       idsToMonoBinds,
+
+       -- re-exported from TcEnv
+       TcId, tcInstId,
+
+       zonkTopBinds, zonkId, zonkIdOcc,
+       zonkForeignExports, zonkRules

   ) where
 
   ) where
 

-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"

 
 -- friends:
 import HsSyn   -- oodles of it
 
 -- friends:
 import HsSyn   -- oodles of it

-import Id      ( GenId(..), IdDetails, -- Can meddle modestly with Ids
-                 SYN_IE(DictVar), idType,
-                 SYN_IE(IdEnv), growIdEnvList, lookupIdEnv
-               )

 
 -- others:
 
 -- others:

-import Name    ( Name{--O only-} )
-import TcMonad hiding ( rnMtoTcM )
-import TcType  ( SYN_IE(TcType), TcMaybe, SYN_IE(TcTyVar),
-                 zonkTcTypeToType, zonkTcTyVarToTyVar
+import Id      ( idName, idType, isLocalId, idUnfolding, setIdType, isIP, Id )
+import DataCon ( dataConWrapId )       
+import TcEnv   ( tcLookupGlobal_maybe, tcExtendGlobalValEnv,
+                 TcEnv, TcId, tcInstId

                )
                )

-import Usage   ( SYN_IE(UVar) )
-import Util    ( zipEqual, panic, pprPanic, pprTrace )
-
-import PprType  ( GenType, GenTyVar )  -- instances
-import Type    ( mkTyVarTy, tyVarsOfType )
-import TyVar   ( GenTyVar {- instances -},
-                 SYN_IE(TyVarEnv), growTyVarEnvList, emptyTyVarSet )
-import TysPrim ( voidTy )
-import Unique  ( Unique )              -- instances
-import UniqFM
-import PprStyle
-import Pretty
+
+import TcMonad
+import TcType  ( zonkTcTypeToType, zonkTcTyVarToTyVar, zonkTcType, zonkTcSigTyVars
+               )
+import CoreSyn  ( Expr )
+import CoreUnfold( unfoldingTemplate )
+import BasicTypes ( RecFlag(..) )
+import Bag
+import Outputable
+import HscTypes        ( TyThing(..) )

 \end{code}
 
 
 \end{code}
 
 

@@ -74,37 +68,37 @@ At the end of type checking we zonk everything to @Typechecked...@ datatypes,
 which have immutable type variables in them.
 
 \begin{code}
 which have immutable type variables in them.
 
 \begin{code}

-type TcIdBndr s = GenId  (TcType s)    -- Binders are all TcTypes
-data TcIdOcc  s = TcId   (TcIdBndr s)  -- Bindees may be either
-               | RealId Id
-
-type TcHsBinds s       = HsBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcBind s          = Bind (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcMonoBinds s     = MonoBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcPat s           = OutPat (TcTyVar s) UVar (TcIdOcc s)
-type TcExpr s          = HsExpr (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcGRHSsAndBinds s = GRHSsAndBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcGRHS s          = GRHS (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcMatch s         = Match (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcQual s          = Qualifier (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcStmt s          = Stmt (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcArithSeqInfo s  = ArithSeqInfo (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcRecordBinds s   = HsRecordBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-type TcHsModule s      = HsModule (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
-
-type TypecheckedPat            = OutPat        TyVar UVar Id
-type TypecheckedMonoBinds      = MonoBinds     TyVar UVar Id TypecheckedPat
-type TypecheckedHsBinds                = HsBinds       TyVar UVar Id TypecheckedPat
-type TypecheckedBind           = Bind          TyVar UVar Id TypecheckedPat
-type TypecheckedHsExpr         = HsExpr        TyVar UVar Id TypecheckedPat
-type TypecheckedArithSeqInfo   = ArithSeqInfo  TyVar UVar Id TypecheckedPat
-type TypecheckedQual           = Qualifier     TyVar UVar Id TypecheckedPat
-type TypecheckedStmt           = Stmt          TyVar UVar Id TypecheckedPat
-type TypecheckedMatch          = Match         TyVar UVar Id TypecheckedPat
-type TypecheckedGRHSsAndBinds  = GRHSsAndBinds TyVar UVar Id TypecheckedPat
-type TypecheckedGRHS           = GRHS          TyVar UVar Id TypecheckedPat
-type TypecheckedRecordBinds    = HsRecordBinds TyVar UVar Id TypecheckedPat
-type TypecheckedHsModule       = HsModule      TyVar UVar Id TypecheckedPat
+type TcHsBinds         = HsBinds TcId TcPat
+type TcMonoBinds       = MonoBinds TcId TcPat
+type TcDictBinds       = TcMonoBinds
+type TcPat             = OutPat TcId
+type TcExpr            = HsExpr TcId TcPat
+type TcGRHSs           = GRHSs TcId TcPat
+type TcGRHS            = GRHS TcId TcPat
+type TcMatch           = Match TcId TcPat
+type TcStmt            = Stmt TcId TcPat
+type TcArithSeqInfo    = ArithSeqInfo TcId TcPat
+type TcRecordBinds     = HsRecordBinds TcId TcPat
+type TcHsModule        = HsModule TcId TcPat
+
+type TcCoreExpr        = Expr TcId
+type TcForeignExportDecl = ForeignDecl TcId
+type TcRuleDecl         = RuleDecl    TcId TcPat
+
+type TypecheckedPat            = OutPat        Id
+type TypecheckedMonoBinds      = MonoBinds     Id TypecheckedPat
+type TypecheckedDictBinds      = TypecheckedMonoBinds
+type TypecheckedHsBinds                = HsBinds       Id TypecheckedPat
+type TypecheckedHsExpr         = HsExpr        Id TypecheckedPat
+type TypecheckedArithSeqInfo   = ArithSeqInfo  Id TypecheckedPat
+type TypecheckedStmt           = Stmt          Id TypecheckedPat
+type TypecheckedMatch          = Match         Id TypecheckedPat
+type TypecheckedGRHSs          = GRHSs         Id TypecheckedPat
+type TypecheckedGRHS           = GRHS          Id TypecheckedPat
+type TypecheckedRecordBinds    = HsRecordBinds Id TypecheckedPat
+type TypecheckedHsModule       = HsModule      Id TypecheckedPat
+type TypecheckedForeignDecl     = ForeignDecl Id
+type TypecheckedRuleDecl       = RuleDecl      Id TypecheckedPat

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -120,30 +114,18 @@ mkHsTyLam tyvars expr = TyLam tyvars expr
 mkHsDictLam []    expr = expr
 mkHsDictLam dicts expr = DictLam dicts expr
 
 mkHsDictLam []    expr = expr
 mkHsDictLam dicts expr = DictLam dicts expr
 

-tcIdType :: TcIdOcc s -> TcType s
-tcIdType (TcId   id) = idType id
-tcIdType (RealId id) = pprPanic "tcIdType:" (ppr PprDebug id)
+mkHsLet EmptyMonoBinds expr = expr
+mkHsLet mbinds        expr = HsLet (MonoBind mbinds [] Recursive) expr

 
 

-tcIdTyVars (TcId id)  = tyVarsOfType (idType id)
-tcIdTyVars (RealId _) = emptyTyVarSet          -- Top level Ids have no free type variables
-\end{code}
+mkHsConApp data_con tys args = foldl HsApp (HsVar (dataConWrapId data_con) `mkHsTyApp` tys) args

 
 

-\begin{code}
-instance Eq (TcIdOcc s) where
-  (TcId id1)   == (TcId id2)   = id1 == id2
-  (RealId id1) == (RealId id2) = id1 == id2
-  _           == _            = False
-
-instance Outputable (TcIdOcc s) where
-  ppr sty (TcId id)   = ppr sty id
-  ppr sty (RealId id) = ppr sty id
-
-instance NamedThing (TcIdOcc s) where
-  getName (TcId id)   = getName id
-  getName (RealId id) = getName id
+idsToMonoBinds :: [Id] -> TcMonoBinds 
+idsToMonoBinds ids
+  = andMonoBindList [ CoreMonoBind id (unfoldingTemplate (idUnfolding id))
+                   | id <- ids
+                   ]

 \end{code}
 
 \end{code}
 

-

 %************************************************************************
 %*                                                                     *
 \subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
 %************************************************************************
 %*                                                                     *
 \subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}

@@ -154,188 +136,182 @@ This zonking pass runs over the bindings
 
  a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
  b) convert unbound TcTyVar to Void
 
  a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
  b) convert unbound TcTyVar to Void

+ c) convert each TcId to an Id by zonking its type
+
+The type variables are converted by binding mutable tyvars to immutable ones
+and then zonking as normal.

 
 

-We pass an environment around so that
- a) we know which TyVars are unbound
- b) we maintain sharing; eg an Id is zonked at its binding site and they
-    all occurrences of that Id point to the common zonked copy
+The Ids are converted by binding them in the normal Tc envt; that
+way we maintain sharing; eg an Id is zonked at its binding site and they
+all occurrences of that Id point to the common zonked copy

 
 It's all pretty boring stuff, because HsSyn is such a large type, and 
 the environment manipulation is tiresome.
 
 
 It's all pretty boring stuff, because HsSyn is such a large type, and 
 the environment manipulation is tiresome.
 

-

 \begin{code}
 \begin{code}

-zonkIdBndr :: TyVarEnv Type -> TcIdOcc s -> NF_TcM s Id
-zonkIdBndr te (TcId (Id u n ty details prags info))
-  = zonkTcTypeToType te ty     `thenNF_Tc` \ ty' ->
-    returnNF_Tc (Id u n ty' details prags info)
-
-zonkIdBndr te (RealId id) = returnNF_Tc id
-
-zonkIdOcc :: IdEnv Id -> TcIdOcc s -> Id
-zonkIdOcc ve (RealId id) = id
-zonkIdOcc ve (TcId id)   = case (lookupIdEnv ve id) of
-                               Just id' -> id'
-                               Nothing  -> pprTrace "zonkIdOcc: " (ppr PprDebug id) $
-                                           Id u n voidTy details prags info
-                                        where
-                                           Id u n _ details prags info = id
-
-extend_ve ve ids    = growIdEnvList ve [(id,id) | id <- ids]
-extend_te te tyvars = growTyVarEnvList te [(tyvar, mkTyVarTy tyvar) | tyvar <- tyvars]
+-- zonkId is used *during* typechecking just to zonk the Id's type
+zonkId :: TcId -> NF_TcM TcId
+zonkId id
+  = zonkTcType (idType id) `thenNF_Tc` \ ty' ->
+    returnNF_Tc (setIdType id ty')
+
+-- zonkIdBndr is used *after* typechecking to get the Id's type
+-- to its final form.  The TyVarEnv give 
+zonkIdBndr :: TcId -> NF_TcM Id
+zonkIdBndr id
+  = zonkTcTypeToType (idType id)       `thenNF_Tc` \ ty' ->
+    returnNF_Tc (setIdType id ty')
+
+zonkIdOcc :: TcId -> NF_TcM Id
+zonkIdOcc id 
+  | not (isLocalId id) || isIP id
+       -- We're avoiding looking up superclass selectors
+       -- and constructors; zonking them is a no-op anyway, and the
+       -- superclass selectors aren't in the environment anyway.
+  = returnNF_Tc id
+  | otherwise 
+  = tcLookupGlobal_maybe (idName id)   `thenNF_Tc` \ maybe_id' ->
+    let
+       new_id = case maybe_id' of
+                   Just (AnId id') -> id'
+                   other  -> pprTrace "zonkIdOcc:" (ppr id) id
+    in
+    returnNF_Tc new_id

 \end{code}
 
 \end{code}
 

+

 \begin{code}
 \begin{code}

-       -- Implicitly mutually recursive, which is overkill,
-       -- but it means that later ones see earlier ones
-zonkDictBinds te ve dbs 
-  = fixNF_Tc (\ ~(_,new_ve) ->
-       zonkDictBindsLocal te new_ve dbs        `thenNF_Tc` \ (new_binds, dict_ids) ->
-        returnNF_Tc (new_binds, extend_ve ve dict_ids)
-    )
-
-       -- The ..Local version assumes the caller has set up
-       -- a ve that contains all the things bound here
-zonkDictBindsLocal te ve [] = returnNF_Tc ([], [])
-
-zonkDictBindsLocal te ve ((dict,rhs) : binds)
-  = zonkIdBndr te dict                 `thenNF_Tc` \ new_dict ->
-    zonkExpr te ve rhs                 `thenNF_Tc` \ new_rhs ->
-    zonkDictBindsLocal te ve binds     `thenNF_Tc` \ (new_binds, dict_ids) ->
-    returnNF_Tc ((new_dict,new_rhs) : new_binds, 
-                new_dict:dict_ids)
+zonkTopBinds :: TcMonoBinds -> NF_TcM (TypecheckedMonoBinds, TcEnv)
+zonkTopBinds binds     -- Top level is implicitly recursive
+  = fixNF_Tc (\ ~(_, new_ids) ->
+       tcExtendGlobalValEnv (bagToList new_ids)        $
+       zonkMonoBinds binds                     `thenNF_Tc` \ (binds', new_ids) ->
+       tcGetEnv                                `thenNF_Tc` \ env ->
+       returnNF_Tc ((binds', env), new_ids)
+    )                                  `thenNF_Tc` \ (stuff, _) ->
+    returnNF_Tc stuff
+
+zonkBinds :: TcHsBinds -> NF_TcM (TypecheckedHsBinds, TcEnv)
+
+zonkBinds binds 
+  = go binds (\ binds' -> tcGetEnv `thenNF_Tc` \ env -> 
+                         returnNF_Tc (binds', env))
+  where
+    -- go :: TcHsBinds
+    --    -> (TypecheckedHsBinds
+    --       -> NF_TcM (TypecheckedHsBinds, TcEnv)
+    --       ) 
+    --   -> NF_TcM (TypecheckedHsBinds, TcEnv)
+
+    go (ThenBinds b1 b2) thing_inside = go b1  $ \ b1' -> 
+                                       go b2   $ \ b2' ->
+                                       thing_inside (b1' `ThenBinds` b2')
+
+    go EmptyBinds thing_inside = thing_inside EmptyBinds
+
+    go (MonoBind bind sigs is_rec) thing_inside
+         = ASSERT( null sigs )
+           fixNF_Tc (\ ~(_, new_ids) ->
+               tcExtendGlobalValEnv (bagToList new_ids)        $
+               zonkMonoBinds bind                              `thenNF_Tc` \ (new_bind, new_ids) ->
+               thing_inside (mkMonoBind new_bind [] is_rec)    `thenNF_Tc` \ stuff ->
+               returnNF_Tc (stuff, new_ids)
+           )                                                   `thenNF_Tc` \ (stuff, _) ->
+          returnNF_Tc stuff

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

-zonkBinds :: TyVarEnv Type -> IdEnv Id 
-         -> TcHsBinds s -> NF_TcM s (TypecheckedHsBinds, IdEnv Id)
+-------------------------------------------------------------------------
+zonkMonoBinds :: TcMonoBinds
+             -> NF_TcM (TypecheckedMonoBinds, Bag Id)

 
 

-zonkBinds te ve EmptyBinds = returnNF_Tc (EmptyBinds, ve)
+zonkMonoBinds EmptyMonoBinds = returnNF_Tc (EmptyMonoBinds, emptyBag)

 
 

-zonkBinds te ve (ThenBinds binds1 binds2)
-  = zonkBinds te ve binds1   `thenNF_Tc` \ (new_binds1, ve1) ->
-    zonkBinds te ve1 binds2  `thenNF_Tc` \ (new_binds2, ve2) ->
-    returnNF_Tc (ThenBinds new_binds1 new_binds2, ve2)
+zonkMonoBinds (AndMonoBinds mbinds1 mbinds2)
+  = zonkMonoBinds mbinds1              `thenNF_Tc` \ (b1', ids1) ->
+    zonkMonoBinds mbinds2              `thenNF_Tc` \ (b2', ids2) ->
+    returnNF_Tc (b1' `AndMonoBinds` b2', 
+                ids1 `unionBags` ids2)

 
 

-zonkBinds te ve (SingleBind bind)
-  = fixNF_Tc (\ ~(_,new_ve) ->
-       zonkBind te new_ve bind  `thenNF_Tc` \ (new_bind, new_ids) ->
-       returnNF_Tc (SingleBind new_bind, extend_ve ve new_ids)
-    )
+zonkMonoBinds (PatMonoBind pat grhss locn)
+  = zonkPat pat                `thenNF_Tc` \ (new_pat, ids) ->
+    zonkGRHSs grhss    `thenNF_Tc` \ new_grhss ->
+    returnNF_Tc (PatMonoBind new_pat new_grhss locn, ids)

 
 

-zonkBinds te ve (AbsBinds tyvars dicts locprs dict_binds val_bind)
-  = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
-    let
-       new_te = extend_te te new_tyvars
-    in
-    mapNF_Tc (zonkIdBndr new_te) dicts         `thenNF_Tc` \ new_dicts ->
-    mapNF_Tc (zonkIdBndr new_te) globals       `thenNF_Tc` \ new_globals ->
-    let
-       ve1 = extend_ve ve  new_globals
-        ve2 = extend_ve ve1 new_dicts
-    in
-    fixNF_Tc (\ ~(_, ve3) ->
-       zonkDictBindsLocal new_te ve3 dict_binds  `thenNF_Tc` \ (new_dict_binds, ds) ->
-       zonkBind new_te ve3 val_bind              `thenNF_Tc` \ (new_val_bind, ls) ->
-       let
-           new_locprs = zipEqual "zonkBinds" (map (zonkIdOcc ve3) locals) new_globals
-        in
-        returnNF_Tc (AbsBinds new_tyvars new_dicts new_locprs new_dict_binds new_val_bind,
-                    extend_ve ve2 (ds++ls))
-    )                                          `thenNF_Tc` \ (binds, _) ->
-    returnNF_Tc (binds, ve1)   -- Yes, the "ve1" is right (SLPJ)
-  where
-    (locals, globals) = unzip locprs
-\end{code}
-
-\begin{code}
--------------------------------------------------------------------------
-zonkBind :: TyVarEnv Type -> IdEnv Id 
-        -> TcBind s -> NF_TcM s (TypecheckedBind, [Id])
+zonkMonoBinds (VarMonoBind var expr)
+  = zonkIdBndr var     `thenNF_Tc` \ new_var ->
+    zonkExpr expr      `thenNF_Tc` \ new_expr ->
+    returnNF_Tc (VarMonoBind new_var new_expr, unitBag new_var)

 
 

-zonkBind te ve EmptyBind = returnNF_Tc (EmptyBind, [])
+zonkMonoBinds (CoreMonoBind var core_expr)
+  = zonkIdBndr var     `thenNF_Tc` \ new_var ->
+    returnNF_Tc (CoreMonoBind new_var core_expr, unitBag new_var)

 
 

-zonkBind te ve (NonRecBind mbinds)
-  = zonkMonoBinds te ve mbinds `thenNF_Tc` \ (new_mbinds, new_ids) ->
-    returnNF_Tc (NonRecBind new_mbinds, new_ids)
+zonkMonoBinds (FunMonoBind var inf ms locn)
+  = zonkIdBndr var                     `thenNF_Tc` \ new_var ->
+    mapNF_Tc zonkMatch ms              `thenNF_Tc` \ new_ms ->
+    returnNF_Tc (FunMonoBind new_var inf new_ms locn, unitBag new_var)

 
 

-zonkBind te ve (RecBind mbinds)
-  = zonkMonoBinds te ve mbinds `thenNF_Tc` \ (new_mbinds, new_ids) ->
-    returnNF_Tc (RecBind new_mbinds, new_ids)

 
 

--------------------------------------------------------------------------
-zonkMonoBinds :: TyVarEnv Type -> IdEnv Id 
-             -> TcMonoBinds s -> NF_TcM s (TypecheckedMonoBinds, [Id])
-
-zonkMonoBinds te ve EmptyMonoBinds = returnNF_Tc (EmptyMonoBinds, [])
-
-zonkMonoBinds te ve (AndMonoBinds mbinds1 mbinds2)
-  = zonkMonoBinds te ve mbinds1  `thenNF_Tc` \ (new_mbinds1, ids1) ->
-    zonkMonoBinds te ve mbinds2  `thenNF_Tc` \ (new_mbinds2, ids2) ->
-    returnNF_Tc (AndMonoBinds new_mbinds1 new_mbinds2, ids1 ++ ids2)
-
-zonkMonoBinds te ve (PatMonoBind pat grhss_w_binds locn)
-  = zonkPat te ve pat                          `thenNF_Tc` \ (new_pat, ids) ->
-    zonkGRHSsAndBinds te ve grhss_w_binds      `thenNF_Tc` \ new_grhss_w_binds ->
-    returnNF_Tc (PatMonoBind new_pat new_grhss_w_binds locn, ids)
-
-zonkMonoBinds te ve (VarMonoBind var expr)
-  = zonkIdBndr te var          `thenNF_Tc` \ new_var ->
-    zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
-    returnNF_Tc (VarMonoBind new_var new_expr, [new_var])
-
-zonkMonoBinds te ve (FunMonoBind var inf ms locn)
-  = zonkIdBndr te var                  `thenNF_Tc` \ new_var ->
-    mapNF_Tc (zonkMatch te ve) ms      `thenNF_Tc` \ new_ms ->
-    returnNF_Tc (FunMonoBind new_var inf new_ms locn, [new_var])
+zonkMonoBinds (AbsBinds tyvars dicts exports inlines val_bind)
+  = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
+       -- No need to extend tyvar env: the effects are
+       -- propagated through binding the tyvars themselves
+
+    mapNF_Tc zonkIdBndr  dicts         `thenNF_Tc` \ new_dicts ->
+    tcExtendGlobalValEnv new_dicts                     $
+
+    fixNF_Tc (\ ~(_, _, val_bind_ids) ->
+       tcExtendGlobalValEnv (bagToList val_bind_ids)   $
+       zonkMonoBinds val_bind                          `thenNF_Tc` \ (new_val_bind, val_bind_ids) ->
+        mapNF_Tc zonkExport exports                    `thenNF_Tc` \ new_exports ->
+       returnNF_Tc (new_val_bind, new_exports,  val_bind_ids)
+    )                                          `thenNF_Tc ` \ (new_val_bind, new_exports, _) ->
+    let
+           new_globals = listToBag [global | (_, global, local) <- new_exports]
+    in
+    returnNF_Tc (AbsBinds new_tyvars new_dicts new_exports inlines new_val_bind,
+                new_globals)
+  where
+    zonkExport (tyvars, global, local)
+       = zonkTcSigTyVars tyvars        `thenNF_Tc` \ new_tyvars ->
+               -- This isn't the binding occurrence of these tyvars
+               -- but they should *be* tyvars.  Hence zonkTcSigTyVars.
+         zonkIdBndr global             `thenNF_Tc` \ new_global ->
+         zonkIdOcc local               `thenNF_Tc` \ new_local -> 
+         returnNF_Tc (new_tyvars, new_global, new_local)

 \end{code}
 
 %************************************************************************
 %*                                                                     *
 \end{code}
 
 %************************************************************************
 %*                                                                     *

-\subsection[BackSubst-Match-GRHSs]{Match and GRHSsAndBinds}
+\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}

 %*                                                                     *
 %************************************************************************
 
 \begin{code}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}

-zonkMatch :: TyVarEnv Type -> IdEnv Id 
-         -> TcMatch s -> NF_TcM s TypecheckedMatch
-
-zonkMatch te ve (PatMatch pat match)
-  = zonkPat te ve pat          `thenNF_Tc` \ (new_pat, ids) ->
-    let
-       new_ve = extend_ve ve ids
-    in
-    zonkMatch te new_ve match          `thenNF_Tc` \ new_match ->
-    returnNF_Tc (PatMatch new_pat new_match)
-
-zonkMatch te ve (GRHSMatch grhss_w_binds)
-  = zonkGRHSsAndBinds te ve grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
-    returnNF_Tc (GRHSMatch new_grhss_w_binds)
+zonkMatch :: TcMatch -> NF_TcM TypecheckedMatch

 
 

-zonkMatch te ve (SimpleMatch expr)
-  = zonkExpr te ve expr   `thenNF_Tc` \ new_expr ->
-    returnNF_Tc (SimpleMatch new_expr)
+zonkMatch (Match _ pats _ grhss)
+  = zonkPats pats                              `thenNF_Tc` \ (new_pats, new_ids) ->
+    tcExtendGlobalValEnv (bagToList new_ids)   $
+    zonkGRHSs grhss                            `thenNF_Tc` \ new_grhss ->
+    returnNF_Tc (Match [] new_pats Nothing new_grhss)

 
 -------------------------------------------------------------------------
 
 -------------------------------------------------------------------------

-zonkGRHSsAndBinds :: TyVarEnv Type -> IdEnv Id 
-                 -> TcGRHSsAndBinds s
-                 -> NF_TcM s TypecheckedGRHSsAndBinds
+zonkGRHSs :: TcGRHSs
+         -> NF_TcM TypecheckedGRHSs

 
 

-zonkGRHSsAndBinds te ve (GRHSsAndBindsOut grhss binds ty)
-  = zonkBinds te ve binds              `thenNF_Tc` \ (new_binds, new_ve) ->
+zonkGRHSs (GRHSs grhss binds (Just ty))
+  = zonkBinds binds            `thenNF_Tc` \ (new_binds, new_env) ->
+    tcSetEnv new_env $

     let
     let

-       zonk_grhs (GRHS guard expr locn)
-         = zonkExpr te new_ve guard  `thenNF_Tc` \ new_guard ->
-           zonkExpr te new_ve expr   `thenNF_Tc` \ new_expr  ->
-           returnNF_Tc (GRHS new_guard new_expr locn)
-
-        zonk_grhs (OtherwiseGRHS expr locn)
-          = zonkExpr te new_ve expr   `thenNF_Tc` \ new_expr  ->
-           returnNF_Tc (OtherwiseGRHS new_expr locn)
+       zonk_grhs (GRHS guarded locn)
+         = zonkStmts guarded  `thenNF_Tc` \ new_guarded ->
+           returnNF_Tc (GRHS new_guarded locn)

     in
     mapNF_Tc zonk_grhs grhss   `thenNF_Tc` \ new_grhss ->
     in
     mapNF_Tc zonk_grhs grhss   `thenNF_Tc` \ new_grhss ->

-    zonkTcTypeToType te ty     `thenNF_Tc` \ new_ty ->
-    returnNF_Tc (GRHSsAndBindsOut new_grhss new_binds new_ty)
+    zonkTcTypeToType ty        `thenNF_Tc` \ new_ty ->
+    returnNF_Tc (GRHSs new_grhss new_binds (Just new_ty))

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -345,259 +321,241 @@ zonkGRHSsAndBinds te ve (GRHSsAndBindsOut grhss binds ty)
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-zonkExpr :: TyVarEnv Type -> IdEnv Id 
-        -> TcExpr s -> NF_TcM s TypecheckedHsExpr
+zonkExpr :: TcExpr -> NF_TcM TypecheckedHsExpr

 
 

-zonkExpr te ve (HsVar name)
-  = returnNF_Tc (HsVar (zonkIdOcc ve name))
+zonkExpr (HsVar id)
+  = zonkIdOcc id       `thenNF_Tc` \ id' ->
+    returnNF_Tc (HsVar id')

 
 

-zonkExpr te ve (HsLit _) = panic "zonkExpr te ve:HsLit"
+zonkExpr (HsIPVar id)
+  = zonkIdOcc id       `thenNF_Tc` \ id' ->
+    returnNF_Tc (HsIPVar id')

 
 

-zonkExpr te ve (HsLitOut lit ty)
-  = zonkTcTypeToType te ty         `thenNF_Tc` \ new_ty  ->
-    returnNF_Tc (HsLitOut lit new_ty)
+zonkExpr (HsLit (HsRat f ty))
+  = zonkTcTypeToType ty            `thenNF_Tc` \ new_ty  ->
+    returnNF_Tc (HsLit (HsRat f new_ty))

 
 

-zonkExpr te ve (HsLam match)
-  = zonkMatch te ve match      `thenNF_Tc` \ new_match ->
+zonkExpr (HsLit (HsLitLit lit ty))
+  = zonkTcTypeToType ty            `thenNF_Tc` \ new_ty  ->
+    returnNF_Tc (HsLit (HsLitLit lit new_ty))
+
+zonkExpr (HsLit lit)
+  = returnNF_Tc (HsLit lit)
+
+-- HsOverLit doesn't appear in typechecker output
+
+zonkExpr (HsLam match)
+  = zonkMatch match    `thenNF_Tc` \ new_match ->

     returnNF_Tc (HsLam new_match)
 
     returnNF_Tc (HsLam new_match)
 

-zonkExpr te ve (HsApp e1 e2)
-  = zonkExpr te ve e1  `thenNF_Tc` \ new_e1 ->
-    zonkExpr te ve e2  `thenNF_Tc` \ new_e2 ->
+zonkExpr (HsApp e1 e2)
+  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
+    zonkExpr e2        `thenNF_Tc` \ new_e2 ->

     returnNF_Tc (HsApp new_e1 new_e2)
 
     returnNF_Tc (HsApp new_e1 new_e2)
 

-zonkExpr te ve (OpApp e1 op e2)
-  = zonkExpr te ve e1  `thenNF_Tc` \ new_e1 ->
-    zonkExpr te ve op  `thenNF_Tc` \ new_op ->
-    zonkExpr te ve e2  `thenNF_Tc` \ new_e2 ->
-    returnNF_Tc (OpApp new_e1 new_op new_e2)
+zonkExpr (OpApp e1 op fixity e2)
+  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
+    zonkExpr op        `thenNF_Tc` \ new_op ->
+    zonkExpr e2        `thenNF_Tc` \ new_e2 ->
+    returnNF_Tc (OpApp new_e1 new_op fixity new_e2)

 
 

-zonkExpr te ve (NegApp _ _) = panic "zonkExpr te ve:NegApp"
-zonkExpr te ve (HsPar _)    = panic "zonkExpr te ve:HsPar"
+zonkExpr (NegApp _ _) = panic "zonkExpr: NegApp"
+zonkExpr (HsPar _)    = panic "zonkExpr: HsPar"

 
 

-zonkExpr te ve (SectionL expr op)
-  = zonkExpr te ve expr        `thenNF_Tc` \ new_expr ->
-    zonkExpr te ve op          `thenNF_Tc` \ new_op ->
+zonkExpr (SectionL expr op)
+  = zonkExpr expr      `thenNF_Tc` \ new_expr ->
+    zonkExpr op                `thenNF_Tc` \ new_op ->

     returnNF_Tc (SectionL new_expr new_op)
 
     returnNF_Tc (SectionL new_expr new_op)
 

-zonkExpr te ve (SectionR op expr)
-  = zonkExpr te ve op          `thenNF_Tc` \ new_op ->
-    zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
+zonkExpr (SectionR op expr)
+  = zonkExpr op                `thenNF_Tc` \ new_op ->
+    zonkExpr expr              `thenNF_Tc` \ new_expr ->

     returnNF_Tc (SectionR new_op new_expr)
 
     returnNF_Tc (SectionR new_op new_expr)
 

-zonkExpr te ve (HsCase expr ms src_loc)
-  = zonkExpr te ve expr            `thenNF_Tc` \ new_expr ->
-    mapNF_Tc (zonkMatch te ve) ms   `thenNF_Tc` \ new_ms ->
+zonkExpr (HsCase expr ms src_loc)
+  = zonkExpr expr          `thenNF_Tc` \ new_expr ->
+    mapNF_Tc zonkMatch ms   `thenNF_Tc` \ new_ms ->

     returnNF_Tc (HsCase new_expr new_ms src_loc)
 
     returnNF_Tc (HsCase new_expr new_ms src_loc)
 

-zonkExpr te ve (HsIf e1 e2 e3 src_loc)
-  = zonkExpr te ve e1  `thenNF_Tc` \ new_e1 ->
-    zonkExpr te ve e2  `thenNF_Tc` \ new_e2 ->
-    zonkExpr te ve e3  `thenNF_Tc` \ new_e3 ->
+zonkExpr (HsIf e1 e2 e3 src_loc)
+  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
+    zonkExpr e2        `thenNF_Tc` \ new_e2 ->
+    zonkExpr e3        `thenNF_Tc` \ new_e3 ->

     returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
 
     returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
 

-zonkExpr te ve (HsLet binds expr)
-  = zonkBinds te ve binds      `thenNF_Tc` \ (new_binds, new_ve) ->
-    zonkExpr  te new_ve expr   `thenNF_Tc` \ new_expr ->
+zonkExpr (HsLet binds expr)
+  = zonkBinds binds            `thenNF_Tc` \ (new_binds, new_env) ->
+    tcSetEnv new_env           $
+    zonkExpr expr      `thenNF_Tc` \ new_expr ->

     returnNF_Tc (HsLet new_binds new_expr)
 
     returnNF_Tc (HsLet new_binds new_expr)
 

-zonkExpr te ve (HsDo _ _) = panic "zonkExpr te ve:HsDo"
-
-zonkExpr te ve (HsDoOut stmts then_id zero_id src_loc)
-  = zonkStmts te ve stmts      `thenNF_Tc` \ new_stmts ->
-    returnNF_Tc (HsDoOut new_stmts (zonkIdOcc ve then_id) (zonkIdOcc ve zero_id) src_loc)
-
-zonkExpr te ve (ListComp expr quals)
-  = zonkQuals te ve quals      `thenNF_Tc` \ (new_quals, new_ve) ->
-    zonkExpr te new_ve expr    `thenNF_Tc` \ new_expr ->
-    returnNF_Tc (ListComp new_expr new_quals)
-
-zonkExpr te ve (ExplicitList _) = panic "zonkExpr te ve:ExplicitList"
-
-zonkExpr te ve (ExplicitListOut ty exprs)
-  = zonkTcTypeToType te ty             `thenNF_Tc` \ new_ty ->
-    mapNF_Tc (zonkExpr te ve) exprs    `thenNF_Tc` \ new_exprs ->
+zonkExpr (HsWith expr binds)
+  = zonkIPBinds binds                          `thenNF_Tc` \ new_binds ->
+    tcExtendGlobalValEnv (map fst new_binds)   $
+    zonkExpr expr                              `thenNF_Tc` \ new_expr ->
+    returnNF_Tc (HsWith new_expr new_binds)
+    where
+       zonkIPBinds = mapNF_Tc zonkIPBind
+       zonkIPBind (n, e) =
+           zonkIdBndr n        `thenNF_Tc` \ n' ->
+           zonkExpr e          `thenNF_Tc` \ e' ->
+           returnNF_Tc (n', e')
+
+zonkExpr (HsDo _ _ _) = panic "zonkExpr:HsDo"
+
+zonkExpr (HsDoOut do_or_lc stmts return_id then_id zero_id ty src_loc)
+  = zonkStmts stmts            `thenNF_Tc` \ new_stmts ->
+    zonkTcTypeToType ty        `thenNF_Tc` \ new_ty   ->
+    zonkIdOcc return_id                `thenNF_Tc` \ new_return_id ->
+    zonkIdOcc then_id          `thenNF_Tc` \ new_then_id ->
+    zonkIdOcc zero_id          `thenNF_Tc` \ new_zero_id ->
+    returnNF_Tc (HsDoOut do_or_lc new_stmts new_return_id new_then_id new_zero_id
+                        new_ty src_loc)
+
+zonkExpr (ExplicitList _) = panic "zonkExpr:ExplicitList"
+
+zonkExpr (ExplicitListOut ty exprs)
+  = zonkTcTypeToType ty                `thenNF_Tc` \ new_ty ->
+    mapNF_Tc zonkExpr exprs    `thenNF_Tc` \ new_exprs ->

     returnNF_Tc (ExplicitListOut new_ty new_exprs)
 
     returnNF_Tc (ExplicitListOut new_ty new_exprs)
 

-zonkExpr te ve (ExplicitTuple exprs)
-  = mapNF_Tc (zonkExpr te ve) exprs  `thenNF_Tc` \ new_exprs ->
-    returnNF_Tc (ExplicitTuple new_exprs)
+zonkExpr (ExplicitTuple exprs boxed)
+  = mapNF_Tc zonkExpr exprs    `thenNF_Tc` \ new_exprs ->
+    returnNF_Tc (ExplicitTuple new_exprs boxed)

 
 

-zonkExpr te ve (RecordCon con rbinds)
-  = zonkExpr te ve con         `thenNF_Tc` \ new_con ->
-    zonkRbinds te ve rbinds    `thenNF_Tc` \ new_rbinds ->
-    returnNF_Tc (RecordCon new_con new_rbinds)
+zonkExpr (RecordConOut data_con con_expr rbinds)
+  = zonkExpr con_expr  `thenNF_Tc` \ new_con_expr ->
+    zonkRbinds rbinds  `thenNF_Tc` \ new_rbinds ->
+    returnNF_Tc (RecordConOut data_con new_con_expr new_rbinds)

 
 

-zonkExpr te ve (RecordUpd _ _) = panic "zonkExpr te ve:RecordUpd"
+zonkExpr (RecordUpd _ _) = panic "zonkExpr:RecordUpd"

 
 

-zonkExpr te ve (RecordUpdOut expr dicts rbinds)
-  = zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
-    zonkRbinds te ve rbinds    `thenNF_Tc` \ new_rbinds ->
-    returnNF_Tc (RecordUpdOut new_expr new_dicts new_rbinds)
-  where
-    new_dicts = map (zonkIdOcc ve) dicts
+zonkExpr (RecordUpdOut expr ty dicts rbinds)
+  = zonkExpr expr              `thenNF_Tc` \ new_expr ->
+    zonkTcTypeToType ty        `thenNF_Tc` \ new_ty ->
+    mapNF_Tc zonkIdOcc dicts   `thenNF_Tc` \ new_dicts ->
+    zonkRbinds rbinds  `thenNF_Tc` \ new_rbinds ->
+    returnNF_Tc (RecordUpdOut new_expr new_ty new_dicts new_rbinds)

 
 

-zonkExpr te ve (ExprWithTySig _ _) = panic "zonkExpr te ve:ExprWithTySig"
-zonkExpr te ve (ArithSeqIn _) = panic "zonkExpr te ve:ArithSeqIn"
+zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
+zonkExpr (ArithSeqIn _)      = panic "zonkExpr:ArithSeqIn"

 
 

-zonkExpr te ve (ArithSeqOut expr info)
-  = zonkExpr te ve expr        `thenNF_Tc` \ new_expr ->
-    zonkArithSeq te ve info    `thenNF_Tc` \ new_info ->
+zonkExpr (ArithSeqOut expr info)
+  = zonkExpr expr      `thenNF_Tc` \ new_expr ->
+    zonkArithSeq info  `thenNF_Tc` \ new_info ->

     returnNF_Tc (ArithSeqOut new_expr new_info)
 
     returnNF_Tc (ArithSeqOut new_expr new_info)
 

-zonkExpr te ve (CCall fun args may_gc is_casm result_ty)
-  = mapNF_Tc (zonkExpr te ve) args     `thenNF_Tc` \ new_args ->
-    zonkTcTypeToType te result_ty      `thenNF_Tc` \ new_result_ty ->
-    returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
+zonkExpr (HsCCall fun args may_gc is_casm result_ty)
+  = mapNF_Tc zonkExpr args     `thenNF_Tc` \ new_args ->
+    zonkTcTypeToType result_ty `thenNF_Tc` \ new_result_ty ->
+    returnNF_Tc (HsCCall fun new_args may_gc is_casm new_result_ty)

 
 

-zonkExpr te ve (HsSCC label expr)
-  = zonkExpr te ve expr        `thenNF_Tc` \ new_expr ->
-    returnNF_Tc (HsSCC label new_expr)
+zonkExpr (HsSCC lbl expr)
+  = zonkExpr expr      `thenNF_Tc` \ new_expr ->
+    returnNF_Tc (HsSCC lbl new_expr)

 
 

-zonkExpr te ve (TyLam tyvars expr)
+zonkExpr (TyLam tyvars expr)

   = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
   = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->

-    let
-       new_te = extend_te te new_tyvars
-    in
-    zonkExpr new_te ve expr            `thenNF_Tc` \ new_expr ->
+       -- No need to extend tyvar env; see AbsBinds
+
+    zonkExpr expr                      `thenNF_Tc` \ new_expr ->

     returnNF_Tc (TyLam new_tyvars new_expr)
 
     returnNF_Tc (TyLam new_tyvars new_expr)
 

-zonkExpr te ve (TyApp expr tys)
-  = zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
-    mapNF_Tc (zonkTcTypeToType te) tys `thenNF_Tc` \ new_tys ->
+zonkExpr (TyApp expr tys)
+  = zonkExpr expr                      `thenNF_Tc` \ new_expr ->
+    mapNF_Tc zonkTcTypeToType tys      `thenNF_Tc` \ new_tys ->

     returnNF_Tc (TyApp new_expr new_tys)
 
     returnNF_Tc (TyApp new_expr new_tys)
 

-zonkExpr te ve (DictLam dicts expr)
-  = mapNF_Tc (zonkIdBndr te) dicts     `thenNF_Tc` \ new_dicts ->
-    let
-       new_ve = extend_ve ve new_dicts
-    in
-    zonkExpr te new_ve expr                    `thenNF_Tc` \ new_expr ->
+zonkExpr (DictLam dicts expr)
+  = mapNF_Tc zonkIdBndr dicts          `thenNF_Tc` \ new_dicts ->
+    tcExtendGlobalValEnv new_dicts     $
+    zonkExpr expr                      `thenNF_Tc` \ new_expr ->

     returnNF_Tc (DictLam new_dicts new_expr)
 
     returnNF_Tc (DictLam new_dicts new_expr)
 

-zonkExpr te ve (DictApp expr dicts)
-  = zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
+zonkExpr (DictApp expr dicts)
+  = zonkExpr expr              `thenNF_Tc` \ new_expr ->
+    mapNF_Tc zonkIdOcc dicts   `thenNF_Tc` \ new_dicts ->

     returnNF_Tc (DictApp new_expr new_dicts)
     returnNF_Tc (DictApp new_expr new_dicts)

-  where
-    new_dicts = map (zonkIdOcc ve) dicts

 
 

-zonkExpr te ve (ClassDictLam dicts methods expr)
-  = zonkExpr te ve expr            `thenNF_Tc` \ new_expr ->
-    returnNF_Tc (ClassDictLam new_dicts new_methods new_expr)
-  where
-    new_dicts   = map (zonkIdOcc ve) dicts
-    new_methods = map (zonkIdOcc ve) methods
-    

 
 

-zonkExpr te ve (Dictionary dicts methods)
-  = returnNF_Tc (Dictionary new_dicts new_methods)
-  where
-    new_dicts   = map (zonkIdOcc ve) dicts
-    new_methods = map (zonkIdOcc ve) methods
-
-zonkExpr te ve (SingleDict name)
-  = returnNF_Tc (SingleDict (zonkIdOcc ve name))
-
-zonkExpr te ve (HsCon con tys vargs)
-  = mapNF_Tc (zonkTcTypeToType te) tys `thenNF_Tc` \ new_tys   ->
-    mapNF_Tc (zonkExpr te ve) vargs    `thenNF_Tc` \ new_vargs ->
-    returnNF_Tc (HsCon con new_tys new_vargs)

 
 -------------------------------------------------------------------------
 
 -------------------------------------------------------------------------

-zonkArithSeq :: TyVarEnv Type -> IdEnv Id 
-            -> TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
+zonkArithSeq :: TcArithSeqInfo -> NF_TcM TypecheckedArithSeqInfo

 
 

-zonkArithSeq te ve (From e)
-  = zonkExpr te ve e           `thenNF_Tc` \ new_e ->
+zonkArithSeq (From e)
+  = zonkExpr e         `thenNF_Tc` \ new_e ->

     returnNF_Tc (From new_e)
 
     returnNF_Tc (From new_e)
 

-zonkArithSeq te ve (FromThen e1 e2)
-  = zonkExpr te ve e1  `thenNF_Tc` \ new_e1 ->
-    zonkExpr te ve e2  `thenNF_Tc` \ new_e2 ->
+zonkArithSeq (FromThen e1 e2)
+  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
+    zonkExpr e2        `thenNF_Tc` \ new_e2 ->

     returnNF_Tc (FromThen new_e1 new_e2)
 
     returnNF_Tc (FromThen new_e1 new_e2)
 

-zonkArithSeq te ve (FromTo e1 e2)
-  = zonkExpr te ve e1  `thenNF_Tc` \ new_e1 ->
-    zonkExpr te ve e2  `thenNF_Tc` \ new_e2 ->
+zonkArithSeq (FromTo e1 e2)
+  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
+    zonkExpr e2        `thenNF_Tc` \ new_e2 ->

     returnNF_Tc (FromTo new_e1 new_e2)
 
     returnNF_Tc (FromTo new_e1 new_e2)
 

-zonkArithSeq te ve (FromThenTo e1 e2 e3)
-  = zonkExpr te ve e1  `thenNF_Tc` \ new_e1 ->
-    zonkExpr te ve e2  `thenNF_Tc` \ new_e2 ->
-    zonkExpr te ve e3  `thenNF_Tc` \ new_e3 ->
+zonkArithSeq (FromThenTo e1 e2 e3)
+  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
+    zonkExpr e2        `thenNF_Tc` \ new_e2 ->
+    zonkExpr e3        `thenNF_Tc` \ new_e3 ->

     returnNF_Tc (FromThenTo new_e1 new_e2 new_e3)
 
 -------------------------------------------------------------------------
     returnNF_Tc (FromThenTo new_e1 new_e2 new_e3)
 
 -------------------------------------------------------------------------

-zonkQuals :: TyVarEnv Type -> IdEnv Id 
-         -> [TcQual s] -> NF_TcM s ([TypecheckedQual], IdEnv Id)
-
-zonkQuals te ve [] 
-  = returnNF_Tc ([], ve)
-
-zonkQuals te ve (GeneratorQual pat expr : quals)
-  = zonkPat te ve pat  `thenNF_Tc` \ (new_pat, ids) ->
-    zonkExpr te ve expr        `thenNF_Tc` \ new_expr ->
-    let
-       new_ve = extend_ve ve ids
-    in
-    zonkQuals te new_ve quals  `thenNF_Tc` \ (new_quals, final_ve) ->
-    returnNF_Tc (GeneratorQual new_pat new_expr : new_quals, final_ve)
-
-zonkQuals te ve (FilterQual expr : quals)
-  = zonkExpr te ve expr        `thenNF_Tc` \ new_expr ->
-    zonkQuals te ve quals      `thenNF_Tc` \ (new_quals, final_ve) ->
-    returnNF_Tc (FilterQual new_expr : new_quals, final_ve)
-
-zonkQuals te ve (LetQual binds : quals)
-  = zonkBinds te ve binds      `thenNF_Tc` \ (new_binds, new_ve) ->
-    zonkQuals te new_ve quals  `thenNF_Tc` \ (new_quals, final_ve) ->
-    returnNF_Tc (LetQual new_binds : new_quals, final_ve)
-
--------------------------------------------------------------------------
-zonkStmts :: TyVarEnv Type -> IdEnv Id 
-         -> [TcStmt s] -> NF_TcM s [TypecheckedStmt]
-
-zonkStmts te ve [] = returnNF_Tc []
-
-zonkStmts te ve [ExprStmt expr locn]
-  = zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
-    returnNF_Tc [ExprStmt new_expr locn]
-
-zonkStmts te ve (ExprStmtOut expr locn a b : stmts)
-  = zonkExpr te ve      expr   `thenNF_Tc` \ new_expr  ->
-    zonkTcTypeToType te a      `thenNF_Tc` \ new_a     ->
-    zonkTcTypeToType te b      `thenNF_Tc` \ new_b     ->
-    zonkStmts te ve    stmts   `thenNF_Tc` \ new_stmts ->
-    returnNF_Tc (ExprStmtOut new_expr locn new_a new_b : new_stmts)
-
-zonkStmts te ve (LetStmt binds : stmts)
-  = zonkBinds te ve     binds  `thenNF_Tc` \ (new_binds, new_ve) ->
-    zonkStmts te new_ve stmts  `thenNF_Tc` \ new_stmts ->
+zonkStmts :: [TcStmt]
+         -> NF_TcM [TypecheckedStmt]
+
+zonkStmts [] = returnNF_Tc []
+
+zonkStmts (ParStmtOut bndrstmtss : stmts)
+  = mapNF_Tc (mapNF_Tc zonkId) bndrss  `thenNF_Tc` \ new_bndrss ->
+    let new_binders = concat new_bndrss in
+    mapNF_Tc zonkStmts stmtss          `thenNF_Tc` \ new_stmtss ->
+    tcExtendGlobalValEnv new_binders   $ 
+    zonkStmts stmts                    `thenNF_Tc` \ new_stmts ->
+    returnNF_Tc (ParStmtOut (zip new_bndrss new_stmtss) : new_stmts)
+  where (bndrss, stmtss) = unzip bndrstmtss
+
+zonkStmts [ReturnStmt expr]
+  = zonkExpr expr              `thenNF_Tc` \ new_expr ->
+    returnNF_Tc [ReturnStmt new_expr]
+
+zonkStmts (ExprStmt expr locn : stmts)
+  = zonkExpr expr      `thenNF_Tc` \ new_expr ->
+    zonkStmts stmts    `thenNF_Tc` \ new_stmts ->
+    returnNF_Tc (ExprStmt new_expr locn : new_stmts)
+
+zonkStmts (GuardStmt expr locn : stmts)
+  = zonkExpr expr      `thenNF_Tc` \ new_expr ->
+    zonkStmts stmts    `thenNF_Tc` \ new_stmts ->
+    returnNF_Tc (GuardStmt new_expr locn : new_stmts)
+
+zonkStmts (LetStmt binds : stmts)
+  = zonkBinds binds            `thenNF_Tc` \ (new_binds, new_env) ->
+    tcSetEnv new_env           $
+    zonkStmts stmts            `thenNF_Tc` \ new_stmts ->

     returnNF_Tc (LetStmt new_binds : new_stmts)
 
     returnNF_Tc (LetStmt new_binds : new_stmts)
 

-zonkStmts te ve (BindStmtOut pat expr locn a b : stmts)
-  = zonkPat te ve pat          `thenNF_Tc` \ (new_pat, ids) ->
-    zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
-    zonkTcTypeToType te a      `thenNF_Tc` \ new_a     ->
-    zonkTcTypeToType te b      `thenNF_Tc` \ new_b     ->
-    let
-       new_ve = extend_ve ve ids
-    in
-    zonkStmts te new_ve stmts  `thenNF_Tc` \ new_stmts ->
-    returnNF_Tc (BindStmtOut new_pat new_expr locn new_a new_b : new_stmts)
+zonkStmts (BindStmt pat expr locn : stmts)
+  = zonkExpr expr                              `thenNF_Tc` \ new_expr ->
+    zonkPat pat                                        `thenNF_Tc` \ (new_pat, new_ids) ->
+    tcExtendGlobalValEnv (bagToList new_ids)   $ 
+    zonkStmts stmts                            `thenNF_Tc` \ new_stmts ->
+    returnNF_Tc (BindStmt new_pat new_expr locn : new_stmts)

 
 
 
 -------------------------------------------------------------------------
 
 
 
 -------------------------------------------------------------------------

-zonkRbinds :: TyVarEnv Type -> IdEnv Id 
-          -> TcRecordBinds s -> NF_TcM s TypecheckedRecordBinds
+zonkRbinds :: TcRecordBinds -> NF_TcM TypecheckedRecordBinds

 
 

-zonkRbinds te ve rbinds
+zonkRbinds rbinds

   = mapNF_Tc zonk_rbind rbinds
   where
     zonk_rbind (field, expr, pun)
   = mapNF_Tc zonk_rbind rbinds
   where
     zonk_rbind (field, expr, pun)

-      = zonkExpr te ve expr    `thenNF_Tc` \ new_expr ->
-       returnNF_Tc (zonkIdOcc ve field, new_expr, pun)
+      = zonkExpr expr          `thenNF_Tc` \ new_expr ->
+       zonkIdOcc field         `thenNF_Tc` \ new_field ->
+       returnNF_Tc (new_field, new_expr, pun)

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -607,77 +565,119 @@ zonkRbinds te ve rbinds
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-zonkPat :: TyVarEnv Type -> IdEnv Id 
-       -> TcPat s -> NF_TcM s (TypecheckedPat, [Id])
+zonkPat :: TcPat -> NF_TcM (TypecheckedPat, Bag Id)

 
 

-zonkPat te ve (WildPat ty)
-  = zonkTcTypeToType te ty         `thenNF_Tc` \ new_ty ->
-    returnNF_Tc (WildPat new_ty, [])
+zonkPat (WildPat ty)
+  = zonkTcTypeToType ty            `thenNF_Tc` \ new_ty ->
+    returnNF_Tc (WildPat new_ty, emptyBag)

 
 

-zonkPat te ve (VarPat v)
-  = zonkIdBndr te v        `thenNF_Tc` \ new_v ->
-    returnNF_Tc (VarPat new_v, [new_v])
+zonkPat (VarPat v)
+  = zonkIdBndr v           `thenNF_Tc` \ new_v ->
+    returnNF_Tc (VarPat new_v, unitBag new_v)

 
 

-zonkPat te ve (LazyPat pat)
-  = zonkPat te ve pat      `thenNF_Tc` \ (new_pat, ids) ->
+zonkPat (LazyPat pat)
+  = zonkPat pat            `thenNF_Tc` \ (new_pat, ids) ->

     returnNF_Tc (LazyPat new_pat, ids)
 
     returnNF_Tc (LazyPat new_pat, ids)
 

-zonkPat te ve (AsPat n pat)
-  = zonkIdBndr te n        `thenNF_Tc` \ new_n ->
-    zonkPat te ve pat      `thenNF_Tc` \ (new_pat, ids) ->
-    returnNF_Tc (AsPat new_n new_pat, new_n:ids)
-
-zonkPat te ve (ConPat n ty pats)
-  = zonkTcTypeToType te ty     `thenNF_Tc` \ new_ty ->
-    zonkPats te ve pats                `thenNF_Tc` \ (new_pats, ids) ->
-    returnNF_Tc (ConPat n new_ty new_pats, ids)
-
-zonkPat te ve (ConOpPat pat1 op pat2 ty)
-  = zonkPat te ve pat1     `thenNF_Tc` \ (new_pat1, ids1) ->
-    zonkPat te ve pat2     `thenNF_Tc` \ (new_pat2, ids2) ->
-    zonkTcTypeToType te ty  `thenNF_Tc` \ new_ty ->
-    returnNF_Tc (ConOpPat new_pat1 op new_pat2 new_ty, ids1 ++ ids2)
-
-zonkPat te ve (ListPat ty pats)
-  = zonkTcTypeToType te ty     `thenNF_Tc` \ new_ty ->
-    zonkPats te ve pats                `thenNF_Tc` \ (new_pats, ids) ->
-    returnNF_Tc (ListPat new_ty new_pats, ids)
+zonkPat (AsPat n pat)
+  = zonkIdBndr n           `thenNF_Tc` \ new_n ->
+    zonkPat pat            `thenNF_Tc` \ (new_pat, ids) ->
+    returnNF_Tc (AsPat new_n new_pat, new_n `consBag` ids)

 
 

-zonkPat te ve (TuplePat pats)
-  = zonkPats te ve pats                `thenNF_Tc` \ (new_pats, ids) ->
-    returnNF_Tc (TuplePat new_pats, ids)
+zonkPat (ListPat ty pats)
+  = zonkTcTypeToType ty        `thenNF_Tc` \ new_ty ->
+    zonkPats pats              `thenNF_Tc` \ (new_pats, ids) ->
+    returnNF_Tc (ListPat new_ty new_pats, ids)

 
 

-zonkPat te ve (RecPat n ty rpats)
-  = zonkTcTypeToType te ty             `thenNF_Tc` \ new_ty ->
+zonkPat (TuplePat pats boxed)
+  = zonkPats pats              `thenNF_Tc` \ (new_pats, ids) ->
+    returnNF_Tc (TuplePat new_pats boxed, ids)
+
+zonkPat (ConPat n ty tvs dicts pats)
+  = zonkTcTypeToType ty                `thenNF_Tc` \ new_ty ->
+    mapNF_Tc zonkTcTyVarToTyVar tvs    `thenNF_Tc` \ new_tvs ->
+    mapNF_Tc zonkIdBndr dicts          `thenNF_Tc` \ new_dicts ->
+    tcExtendGlobalValEnv new_dicts     $
+    zonkPats pats                      `thenNF_Tc` \ (new_pats, ids) ->
+    returnNF_Tc (ConPat n new_ty new_tvs new_dicts new_pats, 
+                listToBag new_dicts `unionBags` ids)
+
+zonkPat (RecPat n ty tvs dicts rpats)
+  = zonkTcTypeToType ty                        `thenNF_Tc` \ new_ty ->
+    mapNF_Tc zonkTcTyVarToTyVar tvs    `thenNF_Tc` \ new_tvs ->
+    mapNF_Tc zonkIdBndr dicts          `thenNF_Tc` \ new_dicts ->
+    tcExtendGlobalValEnv new_dicts     $

     mapAndUnzipNF_Tc zonk_rpat rpats   `thenNF_Tc` \ (new_rpats, ids_s) ->
     mapAndUnzipNF_Tc zonk_rpat rpats   `thenNF_Tc` \ (new_rpats, ids_s) ->

-    returnNF_Tc (RecPat n new_ty new_rpats, concat ids_s)
+    returnNF_Tc (RecPat n new_ty new_tvs new_dicts new_rpats, 
+                listToBag new_dicts `unionBags` unionManyBags ids_s)

   where
     zonk_rpat (f, pat, pun)
   where
     zonk_rpat (f, pat, pun)

-      = zonkPat te ve pat           `thenNF_Tc` \ (new_pat, ids) ->
+      = zonkPat pat            `thenNF_Tc` \ (new_pat, ids) ->

        returnNF_Tc ((f, new_pat, pun), ids)
 
        returnNF_Tc ((f, new_pat, pun), ids)
 

-zonkPat te ve (LitPat lit ty)
-  = zonkTcTypeToType te ty         `thenNF_Tc` \ new_ty  ->
-    returnNF_Tc (LitPat lit new_ty, [])
+zonkPat (LitPat lit ty)
+  = zonkTcTypeToType ty            `thenNF_Tc` \ new_ty  ->
+    returnNF_Tc (LitPat lit new_ty, emptyBag)

 
 

-zonkPat te ve (NPat lit ty expr)
-  = zonkTcTypeToType te ty     `thenNF_Tc` \ new_ty   ->
-    zonkExpr te ve expr                `thenNF_Tc` \ new_expr ->
-    returnNF_Tc (NPat lit new_ty new_expr, [])
+zonkPat (NPat lit ty expr)
+  = zonkTcTypeToType ty                `thenNF_Tc` \ new_ty   ->
+    zonkExpr expr              `thenNF_Tc` \ new_expr ->
+    returnNF_Tc (NPat lit new_ty new_expr, emptyBag)

 
 

-zonkPat te ve (DictPat ds ms)
-  = mapNF_Tc (zonkIdBndr te) ds    `thenNF_Tc` \ new_ds ->
-    mapNF_Tc (zonkIdBndr te) ms    `thenNF_Tc` \ new_ms ->
-    returnNF_Tc (DictPat new_ds new_ms, new_ds ++ new_ms)
+zonkPat (NPlusKPat n k ty e1 e2)
+  = zonkIdBndr n               `thenNF_Tc` \ new_n ->
+    zonkTcTypeToType ty        `thenNF_Tc` \ new_ty ->
+    zonkExpr e1                `thenNF_Tc` \ new_e1 ->
+    zonkExpr e2                `thenNF_Tc` \ new_e2 ->
+    returnNF_Tc (NPlusKPat new_n k new_ty new_e1 new_e2, unitBag new_n)

 
 

+zonkPat (DictPat ds ms)
+  = mapNF_Tc zonkIdBndr ds    `thenNF_Tc` \ new_ds ->
+    mapNF_Tc zonkIdBndr ms    `thenNF_Tc` \ new_ms ->
+    returnNF_Tc (DictPat new_ds new_ms,
+                listToBag new_ds `unionBags` listToBag new_ms)

 
 

-zonkPats te ve [] 
-  = returnNF_Tc ([], [])
-zonkPats te ve (pat:pats) 
-  = zonkPat te ve pat  `thenNF_Tc` \ (pat', ids1) ->
-    zonkPats te ve pats        `thenNF_Tc` \ (pats', ids2) ->
-    returnNF_Tc (pat':pats', ids1 ++ ids2)

 
 

+zonkPats []
+  = returnNF_Tc ([], emptyBag)
+
+zonkPats (pat:pats) 
+  = zonkPat pat                `thenNF_Tc` \ (pat',  ids1) ->
+    zonkPats pats      `thenNF_Tc` \ (pats', ids2) ->
+    returnNF_Tc (pat':pats', ids1 `unionBags` ids2)

 \end{code}
 
 \end{code}
 

+%************************************************************************
+%*                                                                     *
+\subsection[BackSubst-Foreign]{Foreign exports}
+%*                                                                     *
+%************************************************************************
+
+
+\begin{code}
+zonkForeignExports :: [TcForeignExportDecl] -> NF_TcM [TypecheckedForeignDecl]
+zonkForeignExports ls = mapNF_Tc zonkForeignExport ls
+
+zonkForeignExport :: TcForeignExportDecl -> NF_TcM (TypecheckedForeignDecl)
+zonkForeignExport (ForeignDecl i imp_exp hs_ty ext_nm cconv src_loc) =
+   zonkIdOcc i `thenNF_Tc` \ i' ->
+   returnNF_Tc (ForeignDecl i' imp_exp undefined ext_nm cconv src_loc)
+\end{code}

 
 

+\begin{code}
+zonkRules :: [TcRuleDecl] -> NF_TcM [TypecheckedRuleDecl]
+zonkRules rs = mapNF_Tc zonkRule rs
+
+zonkRule (HsRule name tyvars vars lhs rhs loc)
+  = mapNF_Tc zonkTcTyVarToTyVar tyvars                 `thenNF_Tc` \ new_tyvars ->
+    mapNF_Tc zonkIdBndr [v | RuleBndr v <- vars]       `thenNF_Tc` \ new_bndrs ->
+    tcExtendGlobalValEnv new_bndrs                     $
+    zonkExpr lhs                                       `thenNF_Tc` \ new_lhs ->
+    zonkExpr rhs                                       `thenNF_Tc` \ new_rhs ->
+    returnNF_Tc (HsRule name new_tyvars (map RuleBndr new_bndrs) new_lhs new_rhs loc)
+       -- I hate this map RuleBndr stuff
+
+zonkRule (IfaceRuleOut fun rule)
+  = zonkIdOcc fun      `thenNF_Tc` \ fun' ->
+    returnNF_Tc (IfaceRuleOut fun' rule)
+\end{code}