module TcHsSyn (
        mkHsConApp, mkHsDictLet, mkHsApp,
        hsLitType, hsLPatType, hsPatType,
        mkHsAppTy, mkSimpleHsAlt,
        nlHsIntLit,
        shortCutLit, hsOverLitName,

        -- re-exported from TcMonad
        TcId, TcIdSet,

        zonkTopDecls, zonkTopExpr, zonkTopLExpr,
        zonkTopBndrs, zonkTyBndrsX,
        emptyZonkEnv, mkEmptyZonkEnv, mkTyVarZonkEnv,
        zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
  ) where

#include "HsVersions.h"

import HsSyn
import Id
import TcRnMonad
import PrelNames
import TypeRep     -- We can see the representation of types
import TcType
import TcMType ( defaultKindVarToStar, zonkQuantifiedTyVar, writeMetaTyVar )
import TcEvidence
import TysPrim
import TysWiredIn
import Type
import DataCon
import Name
import NameSet
import Var
import VarSet
import VarEnv
import DynFlags
import Literal
import BasicTypes
import Maybes
import SrcLoc
import Bag
import FastString
import Outputable
import Util

hsLPatType :: OutPat Id -> Type
hsLPatType (L _ pat) = hsPatType pat

hsPatType :: Pat Id -> Type
hsPatType (ParPat pat)                = hsLPatType pat
hsPatType (WildPat ty)                = ty
hsPatType (VarPat var)                = idType var
hsPatType (BangPat pat)               = hsLPatType pat
hsPatType (LazyPat pat)               = hsLPatType pat
hsPatType (LitPat lit)                = hsLitType lit
hsPatType (AsPat var _)               = idType (unLoc var)
hsPatType (ViewPat _ _ ty)            = ty
hsPatType (ListPat _ ty Nothing)      = mkListTy ty
hsPatType (ListPat _ _ (Just (ty,_))) = ty
hsPatType (PArrPat _ ty)              = mkPArrTy ty
hsPatType (TuplePat _ _ ty)           = ty
hsPatType (ConPatOut { pat_ty = ty }) = ty
hsPatType (SigPatOut _ ty)            = ty
hsPatType (NPat lit _ _)              = overLitType lit
hsPatType (NPlusKPat id _ _ _)        = idType (unLoc id)
hsPatType (CoPat _ _ ty)              = ty
hsPatType p                           = pprPanic "hsPatType" (ppr p)

hsLitType :: HsLit -> TcType
hsLitType (HsChar _)       = charTy
hsLitType (HsCharPrim _)   = charPrimTy
hsLitType (HsString _)     = stringTy
hsLitType (HsStringPrim _) = addrPrimTy
hsLitType (HsInt _)        = intTy
hsLitType (HsIntPrim _)    = intPrimTy
hsLitType (HsWordPrim _)   = wordPrimTy
hsLitType (HsInt64Prim _)  = int64PrimTy
hsLitType (HsWord64Prim _) = word64PrimTy
hsLitType (HsInteger _ ty) = ty
hsLitType (HsRat _ ty)     = ty
hsLitType (HsFloatPrim _)  = floatPrimTy
hsLitType (HsDoublePrim _) = doublePrimTy

shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr TcId)
shortCutLit dflags (HsIntegral i) ty
  | isIntTy ty  && inIntRange  dflags i = Just (HsLit (HsInt i))
  | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim i))
  | isIntegerTy ty = Just (HsLit (HsInteger i ty))
  | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit i)) ty
        -- The 'otherwise' case is important
        -- Consider (3 :: Float).  Syntactically it looks like an IntLit,
        -- so we'll call shortCutIntLit, but of course it's a float
        -- This can make a big difference for programs with a lot of
        -- literals, compiled without -O

shortCutLit _ (HsFractional f) ty
  | isFloatTy ty  = Just (mkLit floatDataCon  (HsFloatPrim f))
  | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim f))
  | otherwise     = Nothing

shortCutLit _ (HsIsString s) ty
  | isStringTy ty = Just (HsLit (HsString s))
  | otherwise     = Nothing

mkLit :: DataCon -> HsLit -> HsExpr Id
mkLit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit)

------------------------------
hsOverLitName :: OverLitVal -> Name
-- Get the canonical 'fromX' name for a particular OverLitVal
hsOverLitName (HsIntegral {})   = fromIntegerName
hsOverLitName (HsFractional {}) = fromRationalName
hsOverLitName (HsIsString {})   = fromStringName

type UnboundTyVarZonker = TcTyVar-> TcM Type
        -- How to zonk an unbound type variable
        -- Note [Zonking the LHS of a RULE]

data ZonkEnv
  = ZonkEnv
      UnboundTyVarZonker
      (TyVarEnv TyVar)          --
      (IdEnv    Var)            -- What variables are in scope
        -- Maps an Id or EvVar to its zonked version; both have the same Name
        -- Note that all evidence (coercion variables as well as dictionaries)
        --      are kept in the ZonkEnv
        -- Only *type* abstraction is done by side effect
        -- Is only consulted lazily; hence knot-tying

instance Outputable ZonkEnv where
  ppr (ZonkEnv _ _ty_env var_env) = vcat (map ppr (varEnvElts var_env))


emptyZonkEnv :: ZonkEnv
emptyZonkEnv = mkEmptyZonkEnv zonkTypeZapping

mkEmptyZonkEnv :: UnboundTyVarZonker -> ZonkEnv
mkEmptyZonkEnv zonker = ZonkEnv zonker emptyVarEnv emptyVarEnv

extendIdZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv
extendIdZonkEnv (ZonkEnv zonk_ty ty_env id_env) ids
  = ZonkEnv zonk_ty ty_env (extendVarEnvList id_env [(id,id) | id <- ids])

extendIdZonkEnv1 :: ZonkEnv -> Var -> ZonkEnv
extendIdZonkEnv1 (ZonkEnv zonk_ty ty_env id_env) id
  = ZonkEnv zonk_ty ty_env (extendVarEnv id_env id id)

extendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv
extendTyZonkEnv1 (ZonkEnv zonk_ty ty_env id_env) ty
  = ZonkEnv zonk_ty (extendVarEnv ty_env ty ty) id_env

mkTyVarZonkEnv :: [TyVar] -> ZonkEnv
mkTyVarZonkEnv tvs = ZonkEnv zonkTypeZapping (mkVarEnv [(tv,tv) | tv <- tvs]) emptyVarEnv

setZonkType :: ZonkEnv -> UnboundTyVarZonker -> ZonkEnv
setZonkType (ZonkEnv _ ty_env id_env) zonk_ty = ZonkEnv zonk_ty ty_env id_env

zonkEnvIds :: ZonkEnv -> [Id]
zonkEnvIds (ZonkEnv _ _ id_env) = varEnvElts id_env

zonkIdOcc :: ZonkEnv -> TcId -> Id
-- Ids defined in this module should be in the envt;
-- ignore others.  (Actually, data constructors are also
-- not LocalVars, even when locally defined, but that is fine.)
-- (Also foreign-imported things aren't currently in the ZonkEnv;
--  that's ok because they don't need zonking.)
--
-- Actually, Template Haskell works in 'chunks' of declarations, and
-- an earlier chunk won't be in the 'env' that the zonking phase
-- carries around.  Instead it'll be in the tcg_gbl_env, already fully
-- zonked.  There's no point in looking it up there (except for error
-- checking), and it's not conveniently to hand; hence the simple
-- 'orElse' case in the LocalVar branch.
--
-- Even without template splices, in module Main, the checking of
-- 'main' is done as a separate chunk.
zonkIdOcc (ZonkEnv _zonk_ty _ty_env env) id
  | isLocalVar id = lookupVarEnv env id `orElse` id
  | otherwise     = id

zonkIdOccs :: ZonkEnv -> [TcId] -> [Id]
zonkIdOccs env ids = map (zonkIdOcc env) ids

-- zonkIdBndr is used *after* typechecking to get the Id's type
-- to its final form.  The TyVarEnv give
zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
zonkIdBndr env id
  = do ty' <- zonkTcTypeToType env (idType id)
       return (Id.setIdType id ty')

zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
zonkIdBndrs env ids = mapM (zonkIdBndr env) ids

zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs ids = zonkIdBndrs emptyZonkEnv ids

zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
zonkEvBndrsX = mapAccumLM zonkEvBndrX

zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar)
-- Works for dictionaries and coercions
zonkEvBndrX env var
  = do { var' <- zonkEvBndr env var
       ; return (extendIdZonkEnv1 env var', var') }

zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar
-- Works for dictionaries and coercions
-- Does not extend the ZonkEnv
zonkEvBndr env var
  = do { let var_ty = varType var
       ; ty <-
           {-# SCC "zonkEvBndr_zonkTcTypeToType" #-}
           zonkTcTypeToType env var_ty
       ; return (setVarType var ty) }

zonkEvVarOcc :: ZonkEnv -> EvVar -> EvVar
zonkEvVarOcc env v = zonkIdOcc env v

zonkTyBndrsX :: ZonkEnv -> [TyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX = mapAccumLM zonkTyBndrX

zonkTyBndrX :: ZonkEnv -> TyVar -> TcM (ZonkEnv, TyVar)
-- This guarantees to return a TyVar (not a TcTyVar)
-- then we add it to the envt, so all occurrences are replaced
zonkTyBndrX env tv
  = do { ki <- zonkTcTypeToType env (tyVarKind tv)
       ; let tv' = mkTyVar (tyVarName tv) ki
       ; return (extendTyZonkEnv1 env tv', tv') }

zonkTopExpr :: HsExpr TcId -> TcM (HsExpr Id)
zonkTopExpr e = zonkExpr emptyZonkEnv e

zonkTopLExpr :: LHsExpr TcId -> TcM (LHsExpr Id)
zonkTopLExpr e = zonkLExpr emptyZonkEnv e

zonkTopDecls :: Bag EvBind
             -> LHsBinds TcId -> NameSet
             -> [LRuleDecl TcId] -> [LVectDecl TcId] -> [LTcSpecPrag] -> [LForeignDecl TcId]
             -> TcM ([Id],
                     Bag EvBind,
                     Bag (LHsBind  Id),
                     [LForeignDecl Id],
                     [LTcSpecPrag],
                     [LRuleDecl    Id],
                     [LVectDecl    Id])
zonkTopDecls ev_binds binds sig_ns rules vects imp_specs fords
  = do  { (env1, ev_binds') <- zonkEvBinds emptyZonkEnv ev_binds

         -- Warn about missing signatures
         -- Do this only when we we have a type to offer
        ; warn_missing_sigs <- woptM Opt_WarnMissingSigs
        ; let sig_warn | warn_missing_sigs = topSigWarn sig_ns
                       | otherwise         = noSigWarn

        ; (env2, binds') <- zonkRecMonoBinds env1 sig_warn binds
                        -- Top level is implicitly recursive
        ; rules' <- zonkRules env2 rules
        ; vects' <- zonkVects env2 vects
        ; specs' <- zonkLTcSpecPrags env2 imp_specs
        ; fords' <- zonkForeignExports env2 fords
        ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules', vects') }

---------------------------------------------
zonkLocalBinds :: ZonkEnv -> HsLocalBinds TcId -> TcM (ZonkEnv, HsLocalBinds Id)
zonkLocalBinds env EmptyLocalBinds
  = return (env, EmptyLocalBinds)

zonkLocalBinds _ (HsValBinds (ValBindsIn {}))
  = panic "zonkLocalBinds" -- Not in typechecker output

zonkLocalBinds env (HsValBinds vb@(ValBindsOut binds sigs))
  = do  { warn_missing_sigs <- woptM Opt_WarnMissingLocalSigs
        ; let sig_warn | not warn_missing_sigs = noSigWarn
                       | otherwise             = localSigWarn sig_ns
              sig_ns = getTypeSigNames vb
        ; (env1, new_binds) <- go env sig_warn binds
        ; return (env1, HsValBinds (ValBindsOut new_binds sigs)) }
  where
    go env _ []
      = return (env, [])
    go env sig_warn ((r,b):bs)
      = do { (env1, b')  <- zonkRecMonoBinds env sig_warn b
           ; (env2, bs') <- go env1 sig_warn bs
           ; return (env2, (r,b'):bs') }

zonkLocalBinds env (HsIPBinds (IPBinds binds dict_binds)) = do
    new_binds <- mapM (wrapLocM zonk_ip_bind) binds
    let
        env1 = extendIdZonkEnv env [ n | L _ (IPBind (Right n) _) <- new_binds]
    (env2, new_dict_binds) <- zonkTcEvBinds env1 dict_binds
    return (env2, HsIPBinds (IPBinds new_binds new_dict_binds))
  where
    zonk_ip_bind (IPBind n e)
        = do n' <- mapIPNameTc (zonkIdBndr env) n
             e' <- zonkLExpr env e
             return (IPBind n' e')

---------------------------------------------
zonkRecMonoBinds :: ZonkEnv -> SigWarn -> LHsBinds TcId -> TcM (ZonkEnv, LHsBinds Id)
zonkRecMonoBinds env sig_warn binds
 = fixM (\ ~(_, new_binds) -> do
        { let env1 = extendIdZonkEnv env (collectHsBindsBinders new_binds)
        ; binds' <- zonkMonoBinds env1 sig_warn binds
        ; return (env1, binds') })

---------------------------------------------
type SigWarn = Bool -> [Id] -> TcM ()
     -- Missing-signature warning
     -- The Bool is True for an AbsBinds, False otherwise

noSigWarn :: SigWarn
noSigWarn _ _ = return ()

topSigWarn :: NameSet -> SigWarn
topSigWarn sig_ns _ ids = mapM_ (topSigWarnId sig_ns) ids

topSigWarnId :: NameSet -> Id -> TcM ()
-- The NameSet is the Ids that *lack* a signature
-- We have to do it this way round because there are
-- lots of top-level bindings that are generated by GHC
-- and that don't have signatures
topSigWarnId sig_ns id
  | idName id `elemNameSet` sig_ns = warnMissingSig msg id
  | otherwise                      = return ()
  where
    msg = ptext (sLit "Top-level binding with no type signature:")

localSigWarn :: NameSet -> SigWarn
localSigWarn sig_ns is_abs_bind ids
  | not is_abs_bind = return ()
  | otherwise       = mapM_ (localSigWarnId sig_ns) ids

localSigWarnId :: NameSet -> Id -> TcM ()
-- NameSet are the Ids that *have* type signatures
localSigWarnId sig_ns id
  | not (isSigmaTy (idType id))    = return ()
  | idName id `elemNameSet` sig_ns = return ()
  | otherwise                      = warnMissingSig msg id
  where
    msg = ptext (sLit "Polymorphic local binding with no type signature:")

warnMissingSig :: SDoc -> Id -> TcM ()
warnMissingSig msg id
  = do  { env0 <- tcInitTidyEnv
        ; let (env1, tidy_ty) = tidyOpenType env0 (idType id)
        ; addWarnTcM (env1, mk_msg tidy_ty) }
  where
    mk_msg ty = sep [ msg, nest 2 $ pprPrefixName (idName id) <+> dcolon <+> ppr ty ]

---------------------------------------------
zonkMonoBinds :: ZonkEnv -> SigWarn -> LHsBinds TcId -> TcM (LHsBinds Id)
zonkMonoBinds env sig_warn binds = mapBagM (wrapLocM (zonk_bind env sig_warn)) binds

zonk_bind :: ZonkEnv -> SigWarn -> HsBind TcId -> TcM (HsBind Id)
zonk_bind env sig_warn bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty})
  = do  { (_env, new_pat) <- zonkPat env pat            -- Env already extended
        ; sig_warn False (collectPatBinders new_pat)
        ; new_grhss <- zonkGRHSs env zonkLExpr grhss
        ; new_ty    <- zonkTcTypeToType env ty
        ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss, pat_rhs_ty = new_ty }) }

zonk_bind env sig_warn (VarBind { var_id = var, var_rhs = expr, var_inline = inl })
  = do { new_var  <- zonkIdBndr env var
       ; sig_warn False [new_var]
       ; new_expr <- zonkLExpr env expr
       ; return (VarBind { var_id = new_var, var_rhs = new_expr, var_inline = inl }) }

zonk_bind env sig_warn bind@(FunBind { fun_id = L loc var, fun_matches = ms
                                     , fun_co_fn = co_fn })
  = do { new_var <- zonkIdBndr env var
       ; sig_warn False [new_var]
       ; (env1, new_co_fn) <- zonkCoFn env co_fn
       ; new_ms <- zonkMatchGroup env1 zonkLExpr ms
       ; return (bind { fun_id = L loc new_var, fun_matches = new_ms
                      , fun_co_fn = new_co_fn }) }

zonk_bind env sig_warn (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
                                 , abs_ev_binds = ev_binds
                                 , abs_exports = exports
                                 , abs_binds = val_binds })
  = ASSERT( all isImmutableTyVar tyvars )
    do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars
       ; (env1, new_evs) <- zonkEvBndrsX env0 evs
       ; (env2, new_ev_binds) <- zonkTcEvBinds env1 ev_binds
       ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) ->
         do { let env3 = extendIdZonkEnv env2 (collectHsBindsBinders new_val_binds)
            ; new_val_binds <- zonkMonoBinds env3 noSigWarn val_binds
            ; new_exports   <- mapM (zonkExport env3) exports
            ; return (new_val_binds, new_exports) }
       ; sig_warn True (map abe_poly new_exports)
       ; return (AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs
                          , abs_ev_binds = new_ev_binds
                          , abs_exports = new_exports, abs_binds = new_val_bind }) }
  where
    zonkExport env (ABE{ abe_wrap = wrap, abe_poly = poly_id
                       , abe_mono = mono_id, abe_prags = prags })
        = do new_poly_id <- zonkIdBndr env poly_id
             (_, new_wrap) <- zonkCoFn env wrap
             new_prags <- zonkSpecPrags env prags
             return (ABE{ abe_wrap = new_wrap, abe_poly = new_poly_id
                        , abe_mono = zonkIdOcc env mono_id
                        , abe_prags = new_prags })

zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags _   IsDefaultMethod = return IsDefaultMethod
zonkSpecPrags env (SpecPrags ps)  = do { ps' <- zonkLTcSpecPrags env ps
                                       ; return (SpecPrags ps') }

zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags env ps
  = mapM zonk_prag ps
  where
    zonk_prag (L loc (SpecPrag id co_fn inl))
        = do { (_, co_fn') <- zonkCoFn env co_fn
             ; return (L loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) }

zonkMatchGroup :: ZonkEnv
               -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
               -> MatchGroup TcId (Located (body TcId)) -> TcM (MatchGroup Id (Located (body Id)))
zonkMatchGroup env zBody (MG { mg_alts = ms, mg_arg_tys = arg_tys, mg_res_ty = res_ty })
  = do  { ms' <- mapM (zonkMatch env zBody) ms
        ; arg_tys' <- zonkTcTypeToTypes env arg_tys
        ; res_ty'  <- zonkTcTypeToType env res_ty
        ; return (MG { mg_alts = ms', mg_arg_tys = arg_tys', mg_res_ty = res_ty' }) }

zonkMatch :: ZonkEnv
          -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
          -> LMatch TcId (Located (body TcId)) -> TcM (LMatch Id (Located (body Id)))
zonkMatch env zBody (L loc (Match pats _ grhss))
  = do  { (env1, new_pats) <- zonkPats env pats
        ; new_grhss <- zonkGRHSs env1 zBody grhss
        ; return (L loc (Match new_pats Nothing new_grhss)) }

-------------------------------------------------------------------------
zonkGRHSs :: ZonkEnv
          -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
          -> GRHSs TcId (Located (body TcId)) -> TcM (GRHSs Id (Located (body Id)))

zonkGRHSs env zBody (GRHSs grhss binds) = do
    (new_env, new_binds) <- zonkLocalBinds env binds
    let
        zonk_grhs (GRHS guarded rhs)
          = do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded
               new_rhs <- zBody env2 rhs
               return (GRHS new_guarded new_rhs)
    new_grhss <- mapM (wrapLocM zonk_grhs) grhss
    return (GRHSs new_grhss new_binds)

zonkLExprs :: ZonkEnv -> [LHsExpr TcId] -> TcM [LHsExpr Id]
zonkLExpr  :: ZonkEnv -> LHsExpr TcId   -> TcM (LHsExpr Id)
zonkExpr   :: ZonkEnv -> HsExpr TcId    -> TcM (HsExpr Id)

zonkLExprs env exprs = mapM (zonkLExpr env) exprs
zonkLExpr  env expr  = wrapLocM (zonkExpr env) expr

zonkExpr env (HsVar id)
  = return (HsVar (zonkIdOcc env id))

zonkExpr _ (HsIPVar id)
  = return (HsIPVar id)

zonkExpr env (HsLit (HsRat f ty))
  = do new_ty <- zonkTcTypeToType env ty
       return (HsLit (HsRat f new_ty))

zonkExpr _ (HsLit lit)
  = return (HsLit lit)

zonkExpr env (HsOverLit lit)
  = do  { lit' <- zonkOverLit env lit
        ; return (HsOverLit lit') }

zonkExpr env (HsLam matches)
  = do new_matches <- zonkMatchGroup env zonkLExpr matches
       return (HsLam new_matches)

zonkExpr env (HsLamCase arg matches)
  = do new_arg <- zonkTcTypeToType env arg
       new_matches <- zonkMatchGroup env zonkLExpr matches
       return (HsLamCase new_arg new_matches)

zonkExpr env (HsApp e1 e2)
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
       return (HsApp new_e1 new_e2)

zonkExpr env (HsBracketOut body bs)
  = do bs' <- mapM zonk_b bs
       return (HsBracketOut body bs')
  where
    zonk_b (n,e) = do e' <- zonkLExpr env e
                      return (n,e')

zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
                           return (HsSpliceE s)

zonkExpr env (OpApp e1 op fixity e2)
  = do new_e1 <- zonkLExpr env e1
       new_op <- zonkLExpr env op
       new_e2 <- zonkLExpr env e2
       return (OpApp new_e1 new_op fixity new_e2)

zonkExpr env (NegApp expr op)
  = do new_expr <- zonkLExpr env expr
       new_op <- zonkExpr env op
       return (NegApp new_expr new_op)

zonkExpr env (HsPar e)
  = do new_e <- zonkLExpr env e
       return (HsPar new_e)

zonkExpr env (SectionL expr op)
  = do new_expr <- zonkLExpr env expr
       new_op   <- zonkLExpr env op
       return (SectionL new_expr new_op)

zonkExpr env (SectionR op expr)
  = do new_op   <- zonkLExpr env op
       new_expr <- zonkLExpr env expr
       return (SectionR new_op new_expr)

zonkExpr env (ExplicitTuple tup_args boxed)
  = do { new_tup_args <- mapM zonk_tup_arg tup_args
       ; return (ExplicitTuple new_tup_args boxed) }
  where
    zonk_tup_arg (Present e) = do { e' <- zonkLExpr env e; return (Present e') }
    zonk_tup_arg (Missing t) = do { t' <- zonkTcTypeToType env t; return (Missing t') }

zonkExpr env (HsCase expr ms)
  = do new_expr <- zonkLExpr env expr
       new_ms <- zonkMatchGroup env zonkLExpr ms
       return (HsCase new_expr new_ms)

zonkExpr env (HsIf e0 e1 e2 e3)
  = do { new_e0 <- fmapMaybeM (zonkExpr env) e0
       ; new_e1 <- zonkLExpr env e1
       ; new_e2 <- zonkLExpr env e2
       ; new_e3 <- zonkLExpr env e3
       ; return (HsIf new_e0 new_e1 new_e2 new_e3) }

zonkExpr env (HsMultiIf ty alts)
  = do { alts' <- mapM (wrapLocM zonk_alt) alts
       ; ty'   <- zonkTcTypeToType env ty
       ; return $ HsMultiIf ty' alts' }
  where zonk_alt (GRHS guard expr)
          = do { (env', guard') <- zonkStmts env zonkLExpr guard
               ; expr'          <- zonkLExpr env' expr
               ; return $ GRHS guard' expr' }

zonkExpr env (HsLet binds expr)
  = do (new_env, new_binds) <- zonkLocalBinds env binds
       new_expr <- zonkLExpr new_env expr
       return (HsLet new_binds new_expr)

zonkExpr env (HsDo do_or_lc stmts ty)
  = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts
       new_ty <- zonkTcTypeToType env ty
       return (HsDo do_or_lc new_stmts new_ty)

zonkExpr env (ExplicitList ty wit exprs)
  = do new_ty <- zonkTcTypeToType env ty
       new_wit <- zonkWit env wit
       new_exprs <- zonkLExprs env exprs
       return (ExplicitList new_ty new_wit new_exprs)
   where zonkWit _ Nothing = return Nothing
         zonkWit env (Just fln) = do new_fln <- zonkExpr env fln
                                     return (Just new_fln)

zonkExpr env (ExplicitPArr ty exprs)
  = do new_ty <- zonkTcTypeToType env ty
       new_exprs <- zonkLExprs env exprs
       return (ExplicitPArr new_ty new_exprs)

zonkExpr env (RecordCon data_con con_expr rbinds)
  = do  { new_con_expr <- zonkExpr env con_expr
        ; new_rbinds   <- zonkRecFields env rbinds
        ; return (RecordCon data_con new_con_expr new_rbinds) }

zonkExpr env (RecordUpd expr rbinds cons in_tys out_tys)
  = do  { new_expr    <- zonkLExpr env expr
        ; new_in_tys  <- mapM (zonkTcTypeToType env) in_tys
        ; new_out_tys <- mapM (zonkTcTypeToType env) out_tys
        ; new_rbinds  <- zonkRecFields env rbinds
        ; return (RecordUpd new_expr new_rbinds cons new_in_tys new_out_tys) }

zonkExpr env (ExprWithTySigOut e ty)
  = do { e' <- zonkLExpr env e
       ; return (ExprWithTySigOut e' ty) }

zonkExpr _ (ExprWithTySig _ _) = panic "zonkExpr env:ExprWithTySig"

zonkExpr env (ArithSeq expr wit info)
  = do new_expr <- zonkExpr env expr
       new_wit <- zonkWit env wit
       new_info <- zonkArithSeq env info
       return (ArithSeq new_expr new_wit new_info)
   where zonkWit _ Nothing = return Nothing
         zonkWit env (Just fln) = do new_fln <- zonkExpr env fln
                                     return (Just new_fln)

zonkExpr env (PArrSeq expr info)
  = do new_expr <- zonkExpr env expr
       new_info <- zonkArithSeq env info
       return (PArrSeq new_expr new_info)

zonkExpr env (HsSCC lbl expr)
  = do new_expr <- zonkLExpr env expr
       return (HsSCC lbl new_expr)

zonkExpr env (HsTickPragma info expr)
  = do new_expr <- zonkLExpr env expr
       return (HsTickPragma info new_expr)

-- hdaume: core annotations
zonkExpr env (HsCoreAnn lbl expr)
  = do new_expr <- zonkLExpr env expr
       return (HsCoreAnn lbl new_expr)

-- arrow notation extensions
zonkExpr env (HsProc pat body)
  = do  { (env1, new_pat) <- zonkPat env pat
        ; new_body <- zonkCmdTop env1 body
        ; return (HsProc new_pat new_body) }

zonkExpr env (HsWrap co_fn expr)
  = do (env1, new_co_fn) <- zonkCoFn env co_fn
       new_expr <- zonkExpr env1 expr
       return (HsWrap new_co_fn new_expr)

zonkExpr _ (HsUnboundVar v)
  = return (HsUnboundVar v)

zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr)

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

zonkLCmd  :: ZonkEnv -> LHsCmd TcId   -> TcM (LHsCmd Id)
zonkCmd   :: ZonkEnv -> HsCmd TcId    -> TcM (HsCmd Id)

zonkLCmd  env cmd  = wrapLocM (zonkCmd env) cmd

zonkCmd env (HsCmdCast co cmd)
  = do { co' <- zonkTcLCoToLCo env co
       ; cmd' <- zonkCmd env cmd
       ; return (HsCmdCast co' cmd') }
zonkCmd env (HsCmdArrApp e1 e2 ty ho rl)
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
       new_ty <- zonkTcTypeToType env ty
       return (HsCmdArrApp new_e1 new_e2 new_ty ho rl)

zonkCmd env (HsCmdArrForm op fixity args)
  = do new_op <- zonkLExpr env op
       new_args <- mapM (zonkCmdTop env) args
       return (HsCmdArrForm new_op fixity new_args)

zonkCmd env (HsCmdApp c e)
  = do new_c <- zonkLCmd env c
       new_e <- zonkLExpr env e
       return (HsCmdApp new_c new_e)

zonkCmd env (HsCmdLam matches)
  = do new_matches <- zonkMatchGroup env zonkLCmd matches
       return (HsCmdLam new_matches)

zonkCmd env (HsCmdPar c)
  = do new_c <- zonkLCmd env c
       return (HsCmdPar new_c)

zonkCmd env (HsCmdCase expr ms)
  = do new_expr <- zonkLExpr env expr
       new_ms <- zonkMatchGroup env zonkLCmd ms
       return (HsCmdCase new_expr new_ms)

zonkCmd env (HsCmdIf eCond ePred cThen cElse)
  = do { new_eCond <- fmapMaybeM (zonkExpr env) eCond
       ; new_ePred <- zonkLExpr env ePred
       ; new_cThen <- zonkLCmd env cThen
       ; new_cElse <- zonkLCmd env cElse
       ; return (HsCmdIf new_eCond new_ePred new_cThen new_cElse) }

zonkCmd env (HsCmdLet binds cmd)
  = do (new_env, new_binds) <- zonkLocalBinds env binds
       new_cmd <- zonkLCmd new_env cmd
       return (HsCmdLet new_binds new_cmd)

zonkCmd env (HsCmdDo stmts ty)
  = do (_, new_stmts) <- zonkStmts env zonkLCmd stmts
       new_ty <- zonkTcTypeToType env ty
       return (HsCmdDo new_stmts new_ty)





zonkCmdTop :: ZonkEnv -> LHsCmdTop TcId -> TcM (LHsCmdTop Id)
zonkCmdTop env cmd = wrapLocM (zonk_cmd_top env) cmd

zonk_cmd_top :: ZonkEnv -> HsCmdTop TcId -> TcM (HsCmdTop Id)
zonk_cmd_top env (HsCmdTop cmd stack_tys ty ids)
  = do new_cmd <- zonkLCmd env cmd
       new_stack_tys <- zonkTcTypeToType env stack_tys
       new_ty <- zonkTcTypeToType env ty
       new_ids <- mapSndM (zonkExpr env) ids
       return (HsCmdTop new_cmd new_stack_tys new_ty new_ids)

-------------------------------------------------------------------------
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn env WpHole   = return (env, WpHole)
zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1
                                    ; (env2, c2') <- zonkCoFn env1 c2
                                    ; return (env2, WpCompose c1' c2') }
zonkCoFn env (WpCast co) = do { co' <- zonkTcLCoToLCo env co
                              ; return (env, WpCast co') }
zonkCoFn env (WpEvLam ev)   = do { (env', ev') <- zonkEvBndrX env ev
                                 ; return (env', WpEvLam ev') }
zonkCoFn env (WpEvApp arg)  = do { arg' <- zonkEvTerm env arg
                                 ; return (env, WpEvApp arg') }
zonkCoFn env (WpTyLam tv)   = ASSERT( isImmutableTyVar tv )
                              do { (env', tv') <- zonkTyBndrX env tv
                                 ; return (env', WpTyLam tv') }
zonkCoFn env (WpTyApp ty)   = do { ty' <- zonkTcTypeToType env ty
                                 ; return (env, WpTyApp ty') }
zonkCoFn env (WpLet bs)     = do { (env1, bs') <- zonkTcEvBinds env bs
                                 ; return (env1, WpLet bs') }

-------------------------------------------------------------------------
zonkOverLit :: ZonkEnv -> HsOverLit TcId -> TcM (HsOverLit Id)
zonkOverLit env lit@(OverLit { ol_witness = e, ol_type = ty })
  = do  { ty' <- zonkTcTypeToType env ty
        ; e' <- zonkExpr env e
        ; return (lit { ol_witness = e', ol_type = ty' }) }

-------------------------------------------------------------------------
zonkArithSeq :: ZonkEnv -> ArithSeqInfo TcId -> TcM (ArithSeqInfo Id)

zonkArithSeq env (From e)
  = do new_e <- zonkLExpr env e
       return (From new_e)

zonkArithSeq env (FromThen e1 e2)
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
       return (FromThen new_e1 new_e2)

zonkArithSeq env (FromTo e1 e2)
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
       return (FromTo new_e1 new_e2)

zonkArithSeq env (FromThenTo e1 e2 e3)
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
       new_e3 <- zonkLExpr env e3
       return (FromThenTo new_e1 new_e2 new_e3)


-------------------------------------------------------------------------
zonkStmts :: ZonkEnv
          -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
          -> [LStmt TcId (Located (body TcId))] -> TcM (ZonkEnv, [LStmt Id (Located (body Id))])
zonkStmts env _ []     = return (env, [])
zonkStmts env zBody (s:ss) = do { (env1, s')  <- wrapLocSndM (zonkStmt env zBody) s
                                ; (env2, ss') <- zonkStmts env1 zBody ss
                                ; return (env2, s' : ss') }

zonkStmt :: ZonkEnv
         -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
         -> Stmt TcId (Located (body TcId)) -> TcM (ZonkEnv, Stmt Id (Located (body Id)))
zonkStmt env _ (ParStmt stmts_w_bndrs mzip_op bind_op)
  = do { new_stmts_w_bndrs <- mapM zonk_branch stmts_w_bndrs
       ; let new_binders = [b | ParStmtBlock _ bs _ <- new_stmts_w_bndrs, b <- bs]
             env1 = extendIdZonkEnv env new_binders
       ; new_mzip <- zonkExpr env1 mzip_op
       ; new_bind <- zonkExpr env1 bind_op
       ; return (env1, ParStmt new_stmts_w_bndrs new_mzip new_bind) }
  where
    zonk_branch (ParStmtBlock stmts bndrs return_op)
       = do { (env1, new_stmts) <- zonkStmts env zonkLExpr stmts
            ; new_return <- zonkExpr env1 return_op
            ; return (ParStmtBlock new_stmts (zonkIdOccs env1 bndrs) new_return) }

zonkStmt env zBody (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_ids = rvs
                            , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id, recS_bind_fn = bind_id
                            , recS_later_rets = later_rets, recS_rec_rets = rec_rets
                            , recS_ret_ty = ret_ty })
  = do { new_rvs <- zonkIdBndrs env rvs
       ; new_lvs <- zonkIdBndrs env lvs
       ; new_ret_ty  <- zonkTcTypeToType env ret_ty
       ; new_ret_id  <- zonkExpr env ret_id
       ; new_mfix_id <- zonkExpr env mfix_id
       ; new_bind_id <- zonkExpr env bind_id
       ; let env1 = extendIdZonkEnv env new_rvs
       ; (env2, new_segStmts) <- zonkStmts env1 zBody segStmts
        -- Zonk the ret-expressions in an envt that
        -- has the polymorphic bindings in the envt
       ; new_later_rets <- mapM (zonkExpr env2) later_rets
       ; new_rec_rets <- mapM (zonkExpr env2) rec_rets
       ; return (extendIdZonkEnv env new_lvs,     -- Only the lvs are needed
                 RecStmt { recS_stmts = new_segStmts, recS_later_ids = new_lvs
                         , recS_rec_ids = new_rvs, recS_ret_fn = new_ret_id
                         , recS_mfix_fn = new_mfix_id, recS_bind_fn = new_bind_id
                         , recS_later_rets = new_later_rets
                         , recS_rec_rets = new_rec_rets, recS_ret_ty = new_ret_ty }) }

zonkStmt env zBody (BodyStmt body then_op guard_op ty)
  = do new_body <- zBody env body
       new_then <- zonkExpr env then_op
       new_guard <- zonkExpr env guard_op
       new_ty <- zonkTcTypeToType env ty
       return (env, BodyStmt new_body new_then new_guard new_ty)

zonkStmt env zBody (LastStmt body ret_op)
  = do new_body <- zBody env body
       new_ret <- zonkExpr env ret_op
       return (env, LastStmt new_body new_ret)

zonkStmt env _ (TransStmt { trS_stmts = stmts, trS_bndrs = binderMap
                              , trS_by = by, trS_form = form, trS_using = using
                              , trS_ret = return_op, trS_bind = bind_op, trS_fmap = liftM_op })
  = do { (env', stmts') <- zonkStmts env zonkLExpr stmts
    ; binderMap' <- mapM (zonkBinderMapEntry env') binderMap
    ; by'        <- fmapMaybeM (zonkLExpr env') by
    ; using'     <- zonkLExpr env using
    ; return_op' <- zonkExpr env' return_op
    ; bind_op'   <- zonkExpr env' bind_op
    ; liftM_op'  <- zonkExpr env' liftM_op
    ; let env'' = extendIdZonkEnv env' (map snd binderMap')
    ; return (env'', TransStmt { trS_stmts = stmts', trS_bndrs = binderMap'
                               , trS_by = by', trS_form = form, trS_using = using'
                               , trS_ret = return_op', trS_bind = bind_op', trS_fmap = liftM_op' }) }
  where
    zonkBinderMapEntry env (oldBinder, newBinder) = do
        let oldBinder' = zonkIdOcc env oldBinder
        newBinder' <- zonkIdBndr env newBinder
        return (oldBinder', newBinder')

zonkStmt env _ (LetStmt binds)
  = do (env1, new_binds) <- zonkLocalBinds env binds
       return (env1, LetStmt new_binds)

zonkStmt env zBody (BindStmt pat body bind_op fail_op)
  = do  { new_body <- zBody env body
        ; (env1, new_pat) <- zonkPat env pat
        ; new_bind <- zonkExpr env bind_op
        ; new_fail <- zonkExpr env fail_op
        ; return (env1, BindStmt new_pat new_body new_bind new_fail) }

-------------------------------------------------------------------------
zonkRecFields :: ZonkEnv -> HsRecordBinds TcId -> TcM (HsRecordBinds TcId)
zonkRecFields env (HsRecFields flds dd)
  = do  { flds' <- mapM zonk_rbind flds
        ; return (HsRecFields flds' dd) }
  where
    zonk_rbind fld
      = do { new_id   <- wrapLocM (zonkIdBndr env) (hsRecFieldId fld)
           ; new_expr <- zonkLExpr env (hsRecFieldArg fld)
           ; return (fld { hsRecFieldId = new_id, hsRecFieldArg = new_expr }) }

-------------------------------------------------------------------------
mapIPNameTc :: (a -> TcM b) -> Either HsIPName a -> TcM (Either HsIPName b)
mapIPNameTc _ (Left x)  = return (Left x)
mapIPNameTc f (Right x) = do r <- f x
                             return (Right r)

zonkPat :: ZonkEnv -> OutPat TcId -> TcM (ZonkEnv, OutPat Id)
-- Extend the environment as we go, because it's possible for one
-- pattern to bind something that is used in another (inside or
-- to the right)
zonkPat env pat = wrapLocSndM (zonk_pat env) pat

zonk_pat :: ZonkEnv -> Pat TcId -> TcM (ZonkEnv, Pat Id)
zonk_pat env (ParPat p)
  = do  { (env', p') <- zonkPat env p
        ; return (env', ParPat p') }

zonk_pat env (WildPat ty)
  = do  { ty' <- zonkTcTypeToType env ty
        ; return (env, WildPat ty') }

zonk_pat env (VarPat v)
  = do  { v' <- zonkIdBndr env v
        ; return (extendIdZonkEnv1 env v', VarPat v') }

zonk_pat env (LazyPat pat)
  = do  { (env', pat') <- zonkPat env pat
        ; return (env',  LazyPat pat') }

zonk_pat env (BangPat pat)
  = do  { (env', pat') <- zonkPat env pat
        ; return (env',  BangPat pat') }

zonk_pat env (AsPat (L loc v) pat)
  = do  { v' <- zonkIdBndr env v
        ; (env', pat') <- zonkPat (extendIdZonkEnv1 env v') pat
        ; return (env', AsPat (L loc v') pat') }

zonk_pat env (ViewPat expr pat ty)
  = do  { expr' <- zonkLExpr env expr
        ; (env', pat') <- zonkPat env pat
        ; ty' <- zonkTcTypeToType env ty
        ; return (env', ViewPat expr' pat' ty') }

zonk_pat env (ListPat pats ty Nothing)
  = do  { ty' <- zonkTcTypeToType env ty
        ; (env', pats') <- zonkPats env pats
        ; return (env', ListPat pats' ty' Nothing) }

zonk_pat env (ListPat pats ty (Just (ty2,wit)))
  = do  { wit' <- zonkExpr env wit
        ; ty2' <- zonkTcTypeToType env ty2
        ; ty' <- zonkTcTypeToType env ty
        ; (env', pats') <- zonkPats env pats
        ; return (env', ListPat pats' ty' (Just (ty2',wit'))) }

zonk_pat env (PArrPat pats ty)
  = do  { ty' <- zonkTcTypeToType env ty
        ; (env', pats') <- zonkPats env pats
        ; return (env', PArrPat pats' ty') }

zonk_pat env (TuplePat pats boxed ty)
  = do  { ty' <- zonkTcTypeToType env ty
        ; (env', pats') <- zonkPats env pats
        ; return (env', TuplePat pats' boxed ty') }

zonk_pat env p@(ConPatOut { pat_ty = ty, pat_tvs = tyvars
                          , pat_dicts = evs, pat_binds = binds
                          , pat_args = args })
  = ASSERT( all isImmutableTyVar tyvars )
    do  { new_ty <- zonkTcTypeToType env ty
        ; (env0, new_tyvars) <- zonkTyBndrsX env tyvars
          -- Must zonk the existential variables, because their
          -- /kind/ need potential zonking.
          -- cf typecheck/should_compile/tc221.hs
        ; (env1, new_evs) <- zonkEvBndrsX env0 evs
        ; (env2, new_binds) <- zonkTcEvBinds env1 binds
        ; (env', new_args) <- zonkConStuff env2 args
        ; return (env', p { pat_ty = new_ty,
                            pat_tvs = new_tyvars,
                            pat_dicts = new_evs,
                            pat_binds = new_binds,
                            pat_args = new_args }) }

zonk_pat env (LitPat lit) = return (env, LitPat lit)

zonk_pat env (SigPatOut pat ty)
  = do  { ty' <- zonkTcTypeToType env ty
        ; (env', pat') <- zonkPat env pat
        ; return (env', SigPatOut pat' ty') }

zonk_pat env (NPat lit mb_neg eq_expr)
  = do  { lit' <- zonkOverLit env lit
        ; mb_neg' <- fmapMaybeM (zonkExpr env) mb_neg
        ; eq_expr' <- zonkExpr env eq_expr
        ; return (env, NPat lit' mb_neg' eq_expr') }

zonk_pat env (NPlusKPat (L loc n) lit e1 e2)
  = do  { n' <- zonkIdBndr env n
        ; lit' <- zonkOverLit env lit
        ; e1' <- zonkExpr env e1
        ; e2' <- zonkExpr env e2
        ; return (extendIdZonkEnv1 env n', NPlusKPat (L loc n') lit' e1' e2') }

zonk_pat env (CoPat co_fn pat ty)
  = do { (env', co_fn') <- zonkCoFn env co_fn
       ; (env'', pat') <- zonkPat env' (noLoc pat)
       ; ty' <- zonkTcTypeToType env'' ty
       ; return (env'', CoPat co_fn' (unLoc pat') ty') }

zonk_pat _ pat = pprPanic "zonk_pat" (ppr pat)

---------------------------
zonkConStuff :: ZonkEnv
             -> HsConDetails (OutPat TcId) (HsRecFields id (OutPat TcId))
             -> TcM (ZonkEnv,
                     HsConDetails (OutPat Id) (HsRecFields id (OutPat Id)))
zonkConStuff env (PrefixCon pats)
  = do  { (env', pats') <- zonkPats env pats
        ; return (env', PrefixCon pats') }

zonkConStuff env (InfixCon p1 p2)
  = do  { (env1, p1') <- zonkPat env  p1
        ; (env', p2') <- zonkPat env1 p2
        ; return (env', InfixCon p1' p2') }

zonkConStuff env (RecCon (HsRecFields rpats dd))
  = do  { (env', pats') <- zonkPats env (map hsRecFieldArg rpats)
        ; let rpats' = zipWith (\rp p' -> rp { hsRecFieldArg = p' }) rpats pats'
        ; return (env', RecCon (HsRecFields rpats' dd)) }
        -- Field selectors have declared types; hence no zonking

---------------------------
zonkPats :: ZonkEnv -> [OutPat TcId] -> TcM (ZonkEnv, [OutPat Id])
zonkPats env []         = return (env, [])
zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat
                             ; (env', pats') <- zonkPats env1 pats
                             ; return (env', pat':pats') }

zonkForeignExports :: ZonkEnv -> [LForeignDecl TcId] -> TcM [LForeignDecl Id]
zonkForeignExports env ls = mapM (wrapLocM (zonkForeignExport env)) ls

zonkForeignExport :: ZonkEnv -> ForeignDecl TcId -> TcM (ForeignDecl Id)
zonkForeignExport env (ForeignExport i _hs_ty co spec) =
   return (ForeignExport (fmap (zonkIdOcc env) i) undefined co spec)
zonkForeignExport _ for_imp
  = return for_imp     -- Foreign imports don't need zonking

zonkRules :: ZonkEnv -> [LRuleDecl TcId] -> TcM [LRuleDecl Id]
zonkRules env rs = mapM (wrapLocM (zonkRule env)) rs

zonkRule :: ZonkEnv -> RuleDecl TcId -> TcM (RuleDecl Id)
zonkRule env (HsRule name act (vars{-::[RuleBndr TcId]-}) lhs fv_lhs rhs fv_rhs)
  = do { unbound_tkv_set <- newMutVar emptyVarSet
       ; let env_rule = setZonkType env (zonkTvCollecting unbound_tkv_set)
              -- See Note [Zonking the LHS of a RULE]

       ; (env_inside, new_bndrs) <- mapAccumLM zonk_bndr env_rule vars

       ; new_lhs <- zonkLExpr env_inside lhs
       ; new_rhs <- zonkLExpr env_inside rhs

       ; unbound_tkvs <- readMutVar unbound_tkv_set

       ; let final_bndrs :: [RuleBndr Var]
             final_bndrs = map (RuleBndr . noLoc)
                               (varSetElemsKvsFirst unbound_tkvs)
                           ++ new_bndrs

       ; return $
         HsRule name act final_bndrs new_lhs fv_lhs new_rhs fv_rhs }
  where
   zonk_bndr env (RuleBndr (L loc v))
      = do { (env', v') <- zonk_it env v
           ; return (env', RuleBndr (L loc v')) }
   zonk_bndr _ (RuleBndrSig {}) = panic "zonk_bndr RuleBndrSig"

   zonk_it env v
     | isId v     = do { v' <- zonkIdBndr env v
                       ; return (extendIdZonkEnv1 env v', v') }
     | otherwise  = ASSERT( isImmutableTyVar v)
                    zonkTyBndrX env v
                    -- DV: used to be return (env,v) but that is plain
                    -- wrong because we may need to go inside the kind
                    -- of v and zonk there!

zonkVects :: ZonkEnv -> [LVectDecl TcId] -> TcM [LVectDecl Id]
zonkVects env = mapM (wrapLocM (zonkVect env))

zonkVect :: ZonkEnv -> VectDecl TcId -> TcM (VectDecl Id)
zonkVect env (HsVect v e)
  = do { v' <- wrapLocM (zonkIdBndr env) v
       ; e' <- zonkLExpr env e
       ; return $ HsVect v' e'
       }
zonkVect env (HsNoVect v)
  = do { v' <- wrapLocM (zonkIdBndr env) v
       ; return $ HsNoVect v'
       }
zonkVect _env (HsVectTypeOut s t rt)
  = return $ HsVectTypeOut s t rt
zonkVect _ (HsVectTypeIn _ _ _) = panic "TcHsSyn.zonkVect: HsVectTypeIn"
zonkVect _env (HsVectClassOut c)
  = return $ HsVectClassOut c
zonkVect _ (HsVectClassIn _) = panic "TcHsSyn.zonkVect: HsVectClassIn"
zonkVect _env (HsVectInstOut i)
  = return $ HsVectInstOut i
zonkVect _ (HsVectInstIn _) = panic "TcHsSyn.zonkVect: HsVectInstIn"