{-# LANGUAGE GADTs #-}

{-
(c) The University of Glasgow 2006
(c) The AQUA Project, Glasgow University, 1996-1998
-}

-- | Final zonking to 'Type'. See Note [Zonking to Type].
--
-- Distinct from the intra-typechecker zonking in "GHC.Tc.Zonk.TcType";
-- see Note [Module structure for zonking].
module GHC.Tc.Zonk.Type (
        -- * Zonking
        -- | For a description of "zonking", see Note [What is zonking?].
        ZonkTcM,
        zonkTopDecls, zonkTopExpr, zonkTopLExpr,
        zonkTopBndrs,
        zonkTyVarBindersX, zonkTyVarBinderX,
        zonkTyBndrX, zonkTyBndrsX,
        zonkTcTypeToType,  zonkTcTypeToTypeX,
        zonkTcTypesToTypesX, zonkScaledTcTypesToTypesX,
        zonkTyVarOcc,
        zonkCoToCo,
        zonkEvBinds, zonkTcEvBinds,
        zonkTcMethInfoToMethInfoX,
        lookupTyVarX,

        -- ** 'ZonkEnv', and the 'ZonkT' and 'ZonkBndrT' monad transformers
        module GHC.Tc.Zonk.Env,

        -- * Coercion holes
        isFilledCoercionHole, unpackCoercionHole, unpackCoercionHole_maybe,

        -- * Rewriter sets
        zonkRewriterSet, zonkCtRewriterSet, zonkCtEvRewriterSet,

        -- * Tidying
        tcInitTidyEnv, tcInitOpenTidyEnv,


  ) where

import GHC.Prelude

import GHC.Builtin.Types

import GHC.Core.TyCo.Ppr ( pprTyVar )

import GHC.Hs

import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice)
import GHC.Tc.Types ( TcM )
import GHC.Tc.Types.TcRef
import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo )
import GHC.Tc.Utils.Env ( tcLookupGlobalOnly )
import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr )
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Evidence
import GHC.Tc.Errors.Types
import GHC.Tc.Zonk.Env
-- Very little shared code between GHC.Tc.Zonk.TcType and GHC.Tc.Zonk.Type.
-- See Note [Module structure for zonking]
import GHC.Tc.Zonk.TcType
    ( tcInitTidyEnv, tcInitOpenTidyEnv
    , writeMetaTyVarRef
    , checkCoercionHole
    , zonkCoVar )

import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.TyCon

import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Monad
import GHC.Utils.Panic

import GHC.Core.Multiplicity
import GHC.Core
import GHC.Core.Predicate

import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Id
import GHC.Types.TypeEnv
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Types.Unique.Set
import GHC.Types.Unique.FM
import GHC.Types.TyThing

import GHC.Tc.Types.BasicTypes

import GHC.Data.Maybe
import GHC.Data.Bag

import Control.Monad
import Control.Monad.Trans.Class ( lift )
import Data.Semigroup
import Data.List.NonEmpty ( NonEmpty )

{- Note [What is zonking?]
~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC relies heavily on mutability in the typechecker for efficient operation.
For this reason, throughout much of the type checking process, meta type
variables (the MetaTv constructor of TcTyVarDetails) are represented by mutable
variables (known as TcRefs).

Zonking is the process of replacing each such mutable variable with a Type.
This involves traversing the entire type expression, but the interesting part,
replacing the mutable variables, occurs in zonkTyVarOcc.

There are two ways to zonk a Type, using one of two entirely separate zonkers,
that share essentially no code:

*  GHC.Tc.Zonk.TcType.zonkTcType, which is used /during/ type checking:
   * It leaves unfilled metavars untouched, so the resulting Type can contain TcTyVars
   * It is only defined for Type and Coercion, not for HsExpr
   * It works in a very stripped-down monad, ZonkM, make it clear that it uses
     very few effects (for example, it can't throw errors).

* GHC.Tc.Zonk.Type.zonkTcTypeToType, is used /after/ typechecking is complete:
  * It always returns a Type with no remaining TcTyVars; no meta-tyvars remain.
  * It does defaulting, replacing an unconstrained TcTyVar with Any, or failing
     (determined by the ZonkFlexi parameter used; see GHC.Tc.Zonk.Type.commitFlexi).
  * It works over HsExpr and HsBinds as well as Type and Coercion. As part of this,
    it also removes the mutable variables in evidence bindings.
  * It works in the full TcM monad, augmented with an environment.
    More precisely, it uses ZonkTcM and ZonkBndrTcM, which augment TcM with a
    ZonkEnv environment using the zonking monad transformers ZonkT and ZonkBndrT
    (see Note [The ZonkEnv] in GHC.Tc.Zonk.Env).

    Why TcM rather than a smaller monad? See Note [Using TcM for zonking to Type].

Note [Module structure for zonking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As remarked in Note [What is zonking?], there are really two different zonkers;
we have GHC.Tc.Zonk.TcType for zonking within the typechecker and
GHC.Tc.Zonk.Type for the final zonking pass.

The code relating to zonking is thus split up across the following modules:

  I. Zonking within the typechecker
    1. GHC.Tc.Zonk.Monad
    2. GHC.Tc.Zonk.TcType

  II. Final zonking to Type
    1. GHC.Tc.Zonk.Env
    2. GHC.Tc.Zonk.Type

I.1. GHC.Tc.Zonk.Monad - the ZonkM monad

  GHC.Tc.Zonk.Monad defines the ZonkM monad, which is a stripped down version
  of TcM which has just enough information to be able to zonk types.

  This is the monad used for zonking inside the typechecker,
  as used in GHC.Tc.Zonk.TcType.

  Crucially, it never errors. It is the monad we use when reporting errors
  (see ErrCtxt), and it would be quite bad if we could error in the middle
  of reporting an error!

I.2. GHC.Tc.Zonk.TcType - zonking types in the typechecker

  GHC.Tc.Zonk.TcType contains code for zonking types and constraints, for use
  within the typechecker. It uses the ZonkM monad.
  For example, it defines:

    zonkTcType :: TcType -> ZonkM TcType
    zonkCt     :: Ct     -> ZonkM Ct

II.1. GHC.Tc.Zonk.Env - the ZonkEnv and ZonkT/ZonkBndrT monad transformers

   GHC.Tc.Zonk.Env defines the the ZonkT and ZonkBndrT monad transformers.
   These are essentially "ReaderT ZonkEnv" and "StateT ZonkEnv", except
   that ZonkBndrT use continuation-passing style instead of an explicit state.
   See Note [The ZonkEnv] in GHC.Tc.Zonk.Env.

   These are used for the final zonking to type, in GHC.Tc.Zonk.Type.

II.2. GHC.Tc.Zonk.Type - final zonking to type

  GHC.Tc.Zonk.Type is concerned with the "final zonking" pass, after we finish
  typechecking. It zonks not only types, but terms. It uses the monads

    type ZonkTcM     = ZonkT     TcM
    type ZonkBndrTcM = ZonkBndrTcM

  for example:

    zonkTyBndrX       :: TcTyVar  -> ZonkBndrTcM TyVar
    zonkTcTypeToTypeX :: TcType   -> ZonkT     TcM Type

Note that ZonkTcM does a lot more things than ZonkM:

  - it uses a separate ZonkEnv state to accumulate zonked type
      (see Note [The ZonkEnv] in GHC.Tc.Zonk.Env)
  - it defaults type variables,
      (see Note [Un-unified unification variables] in GHC.Tc.Zonk.Env)
  - turns TcTyVars into TyVars,
  - ...

This means that there is essentially no code shared between "GHC.Tc.Zonk.TcType"
and "GHC.Tc.Zonk.Type'; they're really two different zonkers.

Note [Zonking to Type]
~~~~~~~~~~~~~~~~~~~~~~
Zonking to Type is a final zonking pass done *after* typechecking.
It runs over the bindings

 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.

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.

Note [Sharing when zonking to Type]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Problem:

    In GHC.Tc.Zonk.TcType.zonkTcTyVar, we short-circuit (Indirect ty) to
    (Indirect zty), see Note [Sharing in zonking] in GHC.Tc.Zonk.TcType.
    But we /can't/ do this when zonking a TcType to a Type (#15552, esp comment:3).
    Suppose we have

       alpha -> alpha
         where
            alpha is already unified:
             alpha := T{tc-tycon} Int -> Int
         and T is knot-tied

    By "knot-tied" I mean that the occurrence of T is currently a TcTyCon,
    but the global env contains a mapping "T" :-> T{knot-tied-tc}. See
    Note [Type checking recursive type and class declarations] in
    GHC.Tc.TyCl.

    Now we call zonkTcTypeToType on that (alpha -> alpha). If we follow
    the same path as Note [Sharing in zonking] in GHC.Tc.Zonk.TcType, we'll
    update alpha to
       alpha := T{knot-tied-tc} Int -> Int

    But alas, if we encounter alpha for a /second/ time, we end up
    looking at T{knot-tied-tc} and fall into a black hole. The whole
    point of zonkTcTypeToType is that it produces a type full of
    knot-tied tycons, and you must not look at the result!!

    To put it another way (zonkTcTypeToType . zonkTcTypeToType) is not
    the same as zonkTcTypeToType. (If we distinguished TcType from
    Type, this issue would have been a type error!)

Solutions: (see #15552 for other variants)

One possible solution is simply not to do the short-circuiting.
That has less sharing, but maybe sharing is rare. And indeed,
that usually turns out to be viable from a perf point of view

But zonkTyVarOcc implements something a bit better

* ZonkEnv contains ze_meta_tv_env, which maps
      from a MetaTyVar (unification variable)
      to a Type (not a TcType)

* In zonkTyVarOcc, we check this map to see if we have zonked
  this variable before. If so, use the previous answer; if not
  zonk it, and extend the map.

* The map is of course stateful, held in a TcRef. (That is unlike
  the treatment of lexically-scoped variables in ze_tv_env and
  ze_id_env.)

* In zonkTyVarOcc we read the TcRef to look up the unification
  variable:
    - if we get a hit we use the zonked result;
    - if not, in zonk_meta we see if the variable is `Indirect ty`,
      zonk that, and update the map (in finish_meta)
  But Nota Bene that the "update map" step must re-read the TcRef
  (or, more precisely, use updTcRef) because the zonking of the
  `Indirect ty` may have added lots of stuff to the map.  See
  #19668 for an example where this made an asymptotic difference!

Is it worth the extra work of carrying ze_meta_tv_env? Some
non-systematic perf measurements suggest that compiler allocation is
reduced overall (by 0.5% or so) but compile time really doesn't
change.  But in some cases it makes a HUGE difference: see test
T9198 and #19668.  So yes, it seems worth it.

Note [Using TcM for zonking to Type]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The main zonking monads currently wrap TcM, because we need access to
the full TcM monad in order to expand typed TH splices.
See zonkExpr (HsTypedSplice s _) = ...

After the Typed TH plan has been implemented, this should no longer be necessary,
and we should be able to use a stripped down monad, similar to the ZonkM monad
which we use for zonking within the typechecker (but we will need a place to
accumulate errors).

Note [Inlining ZonkBndrT computations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Computations that use the ZonkBndrT monad transformer must be inlined:
ZonkBndrT uses continuation-passing style; failing to inline means applying
an unknown continuation (unknown function call), which prevents many
optimisations from taking place.

See test cases T14683, which regresses without these changes.
-}

-- Why do we use TcM below? See Note [Using TcM for zonking to Type]

-- | Zonking monad for a computation that zonks to Type, reading from a 'ZonkEnv'
-- but not extending or modifying it.
--
-- See Note [Zonking to Type].
type ZonkTcM = ZonkT TcM

-- | Zonking monad for a computation that zonks to Type, reading from
-- and extending or modifying a 'ZonkEnv'.
--
-- See Note [Zonking to Type].
type ZonkBndrTcM = ZonkBndrT TcM

wrapLocZonkMA :: (a -> ZonkTcM b) -> GenLocated (EpAnn ann) a
              -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA :: forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA a -> ZonkTcM b
fn (L EpAnn ann
loc a
a) = (ZonkEnv -> TcM (GenLocated (EpAnn ann) b))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (EpAnn ann) b)
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM (GenLocated (EpAnn ann) b))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (EpAnn ann) b))
-> (ZonkEnv -> TcM (GenLocated (EpAnn ann) b))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (EpAnn ann) b)
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze ->
  EpAnn ann
-> TcM (GenLocated (EpAnn ann) b) -> TcM (GenLocated (EpAnn ann) b)
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA EpAnn ann
loc (TcM (GenLocated (EpAnn ann) b) -> TcM (GenLocated (EpAnn ann) b))
-> TcM (GenLocated (EpAnn ann) b) -> TcM (GenLocated (EpAnn ann) b)
forall a b. (a -> b) -> a -> b
$
  do { b <- ZonkTcM b -> ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a. ZonkT m a -> ZonkEnv -> m a
runZonkT (a -> ZonkTcM b
fn a
a) ZonkEnv
ze
     ; return (L loc b) }

wrapLocZonkBndrMA :: (a -> ZonkBndrTcM b) -> GenLocated (EpAnn ann) a
                  -> ZonkBndrTcM (GenLocated (EpAnn ann) b)
wrapLocZonkBndrMA :: forall a b ann.
(a -> ZonkBndrTcM b)
-> GenLocated (EpAnn ann) a
-> ZonkBndrTcM (GenLocated (EpAnn ann) b)
wrapLocZonkBndrMA a -> ZonkBndrTcM b
fn (L EpAnn ann
loc a
a) = (forall r.
 (GenLocated (EpAnn ann) b
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (EpAnn ann) b)
forall (m :: * -> *) a.
(forall r. (a -> ZonkT m r) -> ZonkT m r) -> ZonkBndrT m a
ZonkBndrT ((forall r.
  (GenLocated (EpAnn ann) b
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (EpAnn ann) b))
-> (forall r.
    (GenLocated (EpAnn ann) b
     -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (EpAnn ann) b)
forall a b. (a -> b) -> a -> b
$ \ GenLocated (EpAnn ann) b -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
k -> (ZonkEnv -> TcM r) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM r) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> (ZonkEnv -> TcM r) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze ->
  EpAnn ann -> TcM r -> TcM r
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA EpAnn ann
loc (TcM r -> TcM r) -> TcM r -> TcM r
forall a b. (a -> b) -> a -> b
$
  ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r -> ZonkEnv -> TcM r
forall (m :: * -> *) a. ZonkT m a -> ZonkEnv -> m a
runZonkT ( ZonkBndrTcM b
-> forall r.
   (b -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (a -> ZonkBndrTcM b
fn a
a) ((b -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> (b -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall a b. (a -> b) -> a -> b
$ \ b
b -> GenLocated (EpAnn ann) b -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
k (EpAnn ann -> b -> GenLocated (EpAnn ann) b
forall l e. l -> e -> GenLocated l e
L EpAnn ann
loc b
b) ) ZonkEnv
ze

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

zonkTyBndrsX :: [TcTyVar] -> ZonkBndrTcM [TcTyVar]
zonkTyBndrsX :: [Id] -> ZonkBndrTcM [Id]
zonkTyBndrsX = (Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> [Id] -> ZonkBndrTcM [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX
{-# INLINE zonkTyBndrsX #-} -- See Note [Inlining ZonkBndrT computations]

zonkTyBndrX :: TcTyVar -> ZonkBndrTcM TyVar
-- This guarantees to return a TyVar (not a TcTyVar)
-- then we add it to the envt, so all occurrences are replaced
--
-- It does not clone: the new TyVar has the sane Name
-- as the old one.  This important when zonking the
-- TyVarBndrs of a TyCon, whose Names may scope.
zonkTyBndrX :: Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX Id
tv
  = Bool
-> SDoc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Id -> Bool
isImmutableTyVar Id
tv) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
tv SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Id -> Kind
tyVarKind Id
tv)) (ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$
    do { ki <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX (Id -> Kind
tyVarKind Id
tv)
               -- Internal names tidy up better, for iface files.
       ; let tv' = Name -> Kind -> Id
mkTyVar (Id -> Name
tyVarName Id
tv) Kind
ki
       ; extendTyZonkEnv tv'
       ; return tv' }
{-# INLINE zonkTyBndrX #-} -- See Note [Inlining ZonkBndrT computations]

zonkTyVarBindersX :: [VarBndr TcTyVar vis]
                  -> ZonkBndrTcM [VarBndr TyVar vis]
zonkTyVarBindersX :: forall vis. [VarBndr Id vis] -> ZonkBndrTcM [VarBndr Id vis]
zonkTyVarBindersX = (VarBndr Id vis
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (VarBndr Id vis))
-> [VarBndr Id vis]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [VarBndr Id vis]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse VarBndr Id vis
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (VarBndr Id vis)
forall vis. VarBndr Id vis -> ZonkBndrTcM (VarBndr Id vis)
zonkTyVarBinderX
{-# INLINE zonkTyVarBindersX #-} -- See Note [Inlining ZonkBndrT computations]

zonkTyVarBinderX :: VarBndr TcTyVar vis
                 -> ZonkBndrTcM (VarBndr TyVar vis)
-- Takes a TcTyVar and guarantees to return a TyVar
zonkTyVarBinderX :: forall vis. VarBndr Id vis -> ZonkBndrTcM (VarBndr Id vis)
zonkTyVarBinderX (Bndr Id
tv vis
vis)
  = do { tv' <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX Id
tv
       ; return (Bndr tv' vis) }
{-# INLINE zonkTyVarBinderX #-} -- See Note [Inlining ZonkBndrT computations]

zonkTyVarOcc :: HasDebugCallStack => TcTyVar -> ZonkTcM Type
zonkTyVarOcc :: HasDebugCallStack =>
Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTyVarOcc Id
tv
  = do { ZonkEnv { ze_tv_env = tv_env } <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv

       ; let lookup_in_tv_env    -- Look up in the env just as we do for Ids
               = case TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
tv_env Id
tv of
                   Maybe Id
Nothing  -> -- TyVar/SkolemTv/RuntimeUnk that isn't in the ZonkEnv
                               -- This can happen for RuntimeUnk variables (which
                               -- should stay as RuntimeUnk), but I think it should
                               -- not happen for SkolemTv.
                               Id -> Kind
mkTyVarTy (Id -> Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *). Monad m => (Kind -> m Kind) -> Id -> m Id
updateTyVarKindM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Id
tv

                   Just Id
tv' -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Kind
mkTyVarTy Id
tv')

             zonk_meta TcRef MetaDetails
ref MetaDetails
Flexi
               = do { kind <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX (Id -> Kind
tyVarKind Id
tv)
                    ; ty <- commitFlexi tv kind

                    ; lift $ liftZonkM $ writeMetaTyVarRef tv ref ty  -- Belt and braces
                    ; finish_meta ty }

             zonk_meta TcRef MetaDetails
_ (Indirect Kind
ty)
               = do { zty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
                    ; finish_meta zty }

             finish_meta Kind
ty
               = do { Id -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
extendMetaEnv Id
tv Kind
ty
                    ; Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Kind
ty }

       ; if isTcTyVar tv
         then case tcTyVarDetails tv of
           SkolemTv {}    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
lookup_in_tv_env
           RuntimeUnk {}  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
lookup_in_tv_env
           MetaTv { mtv_ref :: TcTyVarDetails -> TcRef MetaDetails
mtv_ref = TcRef MetaDetails
ref }
             -> do { mb_ty <- Id -> ZonkTcM (Maybe Kind)
lookupMetaTv Id
tv
                     -- See Note [Sharing when zonking to Type]
                   ; case mb_ty of
                       Just Kind
ty -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Kind
ty
                       Maybe Kind
Nothing -> do { mtv_details <- TcRef MetaDetails
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) MetaDetails
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef TcRef MetaDetails
ref
                                     ; zonk_meta ref mtv_details } }

         -- This should never really happen;
         -- TyVars should not occur in the typechecker
         else lookup_in_tv_env }

extendMetaEnv :: TcTyVar -> Type -> ZonkTcM ()
extendMetaEnv :: Id -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
extendMetaEnv Id
tv Kind
ty =
  (ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) ())
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ())
-> (ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall a b. (a -> b) -> a -> b
$ \ ( ZonkEnv { ze_meta_tv_env :: ZonkEnv -> IORef (TyVarEnv Kind)
ze_meta_tv_env = IORef (TyVarEnv Kind)
mtv_env_ref } ) ->
    IORef (TyVarEnv Kind)
-> (TyVarEnv Kind -> TyVarEnv Kind)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => TcRef a -> (a -> a) -> m ()
updTcRef IORef (TyVarEnv Kind)
mtv_env_ref (\TyVarEnv Kind
env -> TyVarEnv Kind -> Id -> Kind -> TyVarEnv Kind
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv TyVarEnv Kind
env Id
tv Kind
ty)

lookupMetaTv :: TcTyVar -> ZonkTcM (Maybe Type)
lookupMetaTv :: Id -> ZonkTcM (Maybe Kind)
lookupMetaTv Id
tv =
  (ZonkEnv -> TcM (Maybe Kind)) -> ZonkTcM (Maybe Kind)
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM (Maybe Kind)) -> ZonkTcM (Maybe Kind))
-> (ZonkEnv -> TcM (Maybe Kind)) -> ZonkTcM (Maybe Kind)
forall a b. (a -> b) -> a -> b
$ \ ( ZonkEnv { ze_meta_tv_env :: ZonkEnv -> IORef (TyVarEnv Kind)
ze_meta_tv_env = IORef (TyVarEnv Kind)
mtv_env_ref } ) ->
    do { mtv_env <- IORef (TyVarEnv Kind)
-> IOEnv (Env TcGblEnv TcLclEnv) (TyVarEnv Kind)
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef IORef (TyVarEnv Kind)
mtv_env_ref
       ; return $ lookupVarEnv mtv_env tv }

lookupTyVarX :: TcTyVar -> ZonkTcM TyVar
lookupTyVarX :: Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
lookupTyVarX Id
tv
  = do { ZonkEnv { ze_tv_env = tv_env } <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv
       ; let !res = case TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
tv_env Id
tv of
                      Just Id
tv -> Id
tv
                      Maybe Id
Nothing -> String -> SDoc -> Id
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupTyVarOcc" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
tv SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ TyCoVarEnv Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv Id
tv_env)
       ; return res }

commitFlexi :: TcTyVar -> Kind -> ZonkTcM Type
commitFlexi :: Id -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
commitFlexi Id
tv Kind
zonked_kind
  = do { flexi <- ZonkEnv -> ZonkFlexi
ze_flexi (ZonkEnv -> ZonkFlexi)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkFlexi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv
       ; lift $ case flexi of
         ZonkFlexi
SkolemiseFlexi  -> Kind -> TcM Kind
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Kind
mkTyVarTy (Name -> Kind -> Id
mkTyVar Name
name Kind
zonked_kind))

         ZonkFlexi
DefaultFlexi
             -- Normally, RuntimeRep variables are defaulted in GHC.Tc.Utils.TcMType.defaultTyVar
             -- But that sees only type variables that appear in, say, an inferred type.
             -- Defaulting here, in the zonker, is needed to catch e.g.
             --    y :: Bool
             --    y = (\x -> True) undefined
             -- We need *some* known RuntimeRep for the x and undefined, but no one
             -- will choose it until we get here, in the zonker.
           | Kind -> Bool
isRuntimeRepTy Kind
zonked_kind
           -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to LiftedRep:" (Id -> SDoc
pprTyVar Id
tv)
                 ; Kind -> TcM Kind
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Kind
liftedRepTy }
           | Kind -> Bool
isLevityTy Kind
zonked_kind
           -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to Lifted:" (Id -> SDoc
pprTyVar Id
tv)
                 ; Kind -> TcM Kind
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Kind
liftedDataConTy }
           | Kind -> Bool
isMultiplicityTy Kind
zonked_kind
           -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to Many:" (Id -> SDoc
pprTyVar Id
tv)
                 ; Kind -> TcM Kind
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Kind
manyDataConTy }
           | Just (ConcreteFRR FixedRuntimeRepOrigin
origin) <- Id -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe Id
tv
           -> do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ ZonkerMessage -> TcRnMessage
TcRnZonkerMessage (FixedRuntimeRepOrigin -> ZonkerMessage
ZonkerCannotDefaultConcrete FixedRuntimeRepOrigin
origin)
                 ; Kind -> TcM Kind
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Kind -> Kind
anyTypeOfKind Kind
zonked_kind) }
           | Bool
otherwise
           -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to ZonkAny:" (Id -> SDoc
pprTyVar Id
tv)
                   -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4)
                 ; Kind -> TcM Kind
newZonkAnyType Kind
zonked_kind }

         ZonkFlexi
RuntimeUnkFlexi
           -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to RuntimeUnk:" (Id -> SDoc
pprTyVar Id
tv)
                 ; Kind -> TcM Kind
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Kind
mkTyVarTy (Name -> Kind -> TcTyVarDetails -> Id
mkTcTyVar Name
name Kind
zonked_kind TcTyVarDetails
RuntimeUnk)) }
                           -- This is where RuntimeUnks are born:
                           -- otherwise-unconstrained unification variables are
                           -- turned into RuntimeUnks as they leave the
                           -- typechecker's monad

         ZonkFlexi
NoFlexi -> String -> SDoc -> TcM Kind
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"NoFlexi" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
tv SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr Kind
zonked_kind) }

  where
     name :: Name
name = Id -> Name
tyVarName Id
tv


zonkCoVarOcc :: CoVar -> ZonkTcM Coercion
zonkCoVarOcc :: Id -> ZonkTcM Coercion
zonkCoVarOcc Id
cv
  = do { ZonkEnv { ze_tv_env = tyco_env } <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv
         -- don't look in the knot-tied env
       ; case lookupVarEnv tyco_env cv of
          Just Id
cv' -> Coercion -> ZonkTcM Coercion
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coercion -> ZonkTcM Coercion) -> Coercion -> ZonkTcM Coercion
forall a b. (a -> b) -> a -> b
$ Id -> Coercion
mkCoVarCo Id
cv'
          Maybe Id
_        -> Id -> Coercion
mkCoVarCo (Id -> Coercion)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id -> ZonkTcM Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IOEnv (Env TcGblEnv TcLclEnv) Id
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *) a. Monad m => m a -> ZonkT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env TcGblEnv TcLclEnv) Id
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> IOEnv (Env TcGblEnv TcLclEnv) Id
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ ZonkM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id
forall a. ZonkM a -> TcM a
liftZonkM (ZonkM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id)
-> ZonkM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id
forall a b. (a -> b) -> a -> b
$ Id -> ZonkM Id
zonkCoVar Id
cv) }

zonkCoHole :: CoercionHole -> ZonkTcM Coercion
zonkCoHole :: CoercionHole -> ZonkTcM Coercion
zonkCoHole hole :: CoercionHole
hole@(CoercionHole { ch_ref :: CoercionHole -> IORef (Maybe Coercion)
ch_ref = IORef (Maybe Coercion)
ref, ch_co_var :: CoercionHole -> Id
ch_co_var = Id
cv })
  = do { contents <- IORef (Maybe Coercion)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe Coercion)
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef IORef (Maybe Coercion)
ref
       ; case contents of
           Just Coercion
co -> do { co' <- Coercion -> ZonkTcM Coercion
zonkCoToCo Coercion
co
                         ; lift $ liftZonkM $ checkCoercionHole cv co' }

              -- This next case should happen only in the presence of
              -- (undeferred) type errors. Originally, I put in a panic
              -- here, but that caused too many uses of `failIfErrsM`.
           Maybe Coercion
Nothing -> do { IOEnv (Env TcGblEnv TcLclEnv) ()
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *) a. Monad m => m a -> ZonkT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Zonking unfilled coercion hole" (CoercionHole -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoercionHole
hole)
                         ; cv' <- IOEnv (Env TcGblEnv TcLclEnv) Id
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *) a. Monad m => m a -> ZonkT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env TcGblEnv TcLclEnv) Id
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> IOEnv (Env TcGblEnv TcLclEnv) Id
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ ZonkM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id
forall a. ZonkM a -> TcM a
liftZonkM (ZonkM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id)
-> ZonkM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id
forall a b. (a -> b) -> a -> b
$ Id -> ZonkM Id
zonkCoVar Id
cv
                         ; return $ mkCoVarCo cv' } }
                             -- This will be an out-of-scope variable, but keeping
                             -- this as a coercion hole led to #15787

zonk_tycomapper :: TyCoMapper ZonkEnv TcM
zonk_tycomapper :: TyCoMapper ZonkEnv (IOEnv (Env TcGblEnv TcLclEnv))
zonk_tycomapper = TyCoMapper
  { tcm_tyvar :: ZonkEnv -> Id -> TcM Kind
tcm_tyvar      = \ ZonkEnv
env Id
tv -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind -> ZonkEnv -> TcM Kind
forall (m :: * -> *) a. ZonkT m a -> ZonkEnv -> m a
runZonkT (HasDebugCallStack =>
Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTyVarOcc Id
tv) ZonkEnv
env
  , tcm_covar :: ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
tcm_covar      = \ ZonkEnv
env Id
cv -> ZonkTcM Coercion
-> ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
forall (m :: * -> *) a. ZonkT m a -> ZonkEnv -> m a
runZonkT (Id -> ZonkTcM Coercion
zonkCoVarOcc Id
cv) ZonkEnv
env
  , tcm_hole :: ZonkEnv -> CoercionHole -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
tcm_hole       = \ ZonkEnv
env CoercionHole
co -> ZonkTcM Coercion
-> ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
forall (m :: * -> *) a. ZonkT m a -> ZonkEnv -> m a
runZonkT (CoercionHole -> ZonkTcM Coercion
zonkCoHole   CoercionHole
co) ZonkEnv
env
  , tcm_tycobinder :: forall r.
ZonkEnv -> Id -> ForAllTyFlag -> (ZonkEnv -> Id -> TcM r) -> TcM r
tcm_tycobinder = \ ZonkEnv
env Id
tcv ForAllTyFlag
_vis ZonkEnv -> Id -> TcM r
k -> (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r -> ZonkEnv -> TcM r)
-> ZonkEnv -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r -> TcM r
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r -> ZonkEnv -> TcM r
forall (m :: * -> *) a. ZonkT m a -> ZonkEnv -> m a
runZonkT ZonkEnv
env (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r -> TcM r)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r -> TcM r
forall a b. (a -> b) -> a -> b
$
                     ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> forall r.
   (Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX Id
tcv) ((Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> (Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall a b. (a -> b) -> a -> b
$
                     \ Id
tcv' -> (ZonkEnv -> TcM r) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM r) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> (ZonkEnv -> TcM r) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
env' -> (ZonkEnv -> Id -> TcM r
k ZonkEnv
env' Id
tcv')
  , tcm_tycon :: TcTyCon -> TcM TcTyCon
tcm_tycon      = \ TcTyCon
tc -> TcTyCon -> TcM TcTyCon
zonkTcTyConToTyCon TcTyCon
tc
  }

-- Zonk a TyCon by changing a TcTyCon to a regular TyCon
zonkTcTyConToTyCon :: TcTyCon -> TcM TyCon
zonkTcTyConToTyCon :: TcTyCon -> TcM TcTyCon
zonkTcTyConToTyCon TcTyCon
tc
  | TcTyCon -> Bool
isTcTyCon TcTyCon
tc = do { thing <- Name -> TcM TyThing
tcLookupGlobalOnly (TcTyCon -> Name
forall a. NamedThing a => a -> Name
getName TcTyCon
tc)
                      ; case thing of
                          ATyCon TcTyCon
real_tc -> TcTyCon -> TcM TcTyCon
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return TcTyCon
real_tc
                          TyThing
_              -> String -> SDoc -> TcM TcTyCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkTcTyCon" (TcTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing) }
  | Bool
otherwise    = TcTyCon -> TcM TcTyCon
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return TcTyCon
tc -- it's already zonked

-- | Confused by zonking? See Note [What is zonking?] in "GHC.Tc.Zonk.Type".
zonkTcTypeToType :: TcType -> TcM Type
zonkTcTypeToType :: Kind -> TcM Kind
zonkTcTypeToType Kind
ty = ZonkFlexi -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind -> TcM Kind
forall (m :: * -> *) b. MonadIO m => ZonkFlexi -> ZonkT m b -> m b
initZonkEnv ZonkFlexi
DefaultFlexi (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind -> TcM Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind -> TcM Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty

zonkScaledTcTypeToTypeX :: Scaled TcType -> ZonkTcM (Scaled TcType)
zonkScaledTcTypeToTypeX :: Scaled Kind -> ZonkTcM (Scaled Kind)
zonkScaledTcTypeToTypeX (Scaled Kind
m Kind
ty) = Kind -> Kind -> Scaled Kind
forall a. Kind -> a -> Scaled a
Scaled (Kind -> Kind -> Scaled Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Kind -> Scaled Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
m
                                               ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Kind -> Scaled Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkTcM (Scaled Kind)
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty

zonkTcTypeToTypeX   :: TcType   -> ZonkTcM Type
zonkTcTypesToTypesX :: [TcType] -> ZonkTcM [Type]
zonkCoToCo          :: Coercion -> ZonkTcM Coercion
(Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX, [Kind] -> ZonkTcM [Kind]
zonkTcTypesToTypesX, Coercion -> ZonkTcM Coercion
zonkCoToCo)
  = case TyCoMapper ZonkEnv (IOEnv (Env TcGblEnv TcLclEnv))
-> (ZonkEnv -> Kind -> TcM Kind, ZonkEnv -> [Kind] -> TcM [Kind],
    ZonkEnv -> Coercion -> IOEnv (Env TcGblEnv TcLclEnv) Coercion,
    ZonkEnv -> [Coercion] -> TcM [Coercion])
forall (m :: * -> *) env.
Monad m =>
TyCoMapper env m
-> (env -> Kind -> m Kind, env -> [Kind] -> m [Kind],
    env -> Coercion -> m Coercion, env -> [Coercion] -> m [Coercion])
mapTyCoX TyCoMapper ZonkEnv (IOEnv (Env TcGblEnv TcLclEnv))
zonk_tycomapper of
      (ZonkEnv -> Kind -> TcM Kind
zty, ZonkEnv -> [Kind] -> TcM [Kind]
ztys, ZonkEnv -> Coercion -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
zco, ZonkEnv -> [Coercion] -> TcM [Coercion]
_) ->
        ((ZonkEnv -> TcM Kind) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM Kind)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> (Kind -> ZonkEnv -> TcM Kind)
-> Kind
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonkEnv -> Kind -> TcM Kind) -> Kind -> ZonkEnv -> TcM Kind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZonkEnv -> Kind -> TcM Kind
zty, (ZonkEnv -> TcM [Kind]) -> ZonkTcM [Kind]
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM [Kind]) -> ZonkTcM [Kind])
-> ([Kind] -> ZonkEnv -> TcM [Kind]) -> [Kind] -> ZonkTcM [Kind]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonkEnv -> [Kind] -> TcM [Kind])
-> [Kind] -> ZonkEnv -> TcM [Kind]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZonkEnv -> [Kind] -> TcM [Kind]
ztys, (ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) Coercion)
-> ZonkTcM Coercion
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) Coercion)
 -> ZonkTcM Coercion)
-> (Coercion -> ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) Coercion)
-> Coercion
-> ZonkTcM Coercion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonkEnv -> Coercion -> IOEnv (Env TcGblEnv TcLclEnv) Coercion)
-> Coercion -> ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZonkEnv -> Coercion -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
zco)

zonkScaledTcTypesToTypesX :: [Scaled TcType] -> ZonkTcM [Scaled Type]
zonkScaledTcTypesToTypesX :: [Scaled Kind] -> ZonkTcM [Scaled Kind]
zonkScaledTcTypesToTypesX [Scaled Kind]
scaled_tys =
   (Scaled Kind -> ZonkTcM (Scaled Kind))
-> [Scaled Kind] -> ZonkTcM [Scaled Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Scaled Kind -> ZonkTcM (Scaled Kind)
zonkScaledTcTypeToTypeX [Scaled Kind]
scaled_tys


zonkEnvIds :: ZonkEnv -> TypeEnv
zonkEnvIds :: ZonkEnv -> TypeEnv
zonkEnvIds (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env })
  = [(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id, Id -> TyThing
AnId Id
id) | Id
id <- TyCoVarEnv Id -> [Id]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM TyCoVarEnv Id
id_env]
  -- It's OK to use nonDetEltsUFM here because we forget the ordering
  -- immediately by creating a TypeEnv

zonkLIdOcc :: LocatedN TcId -> ZonkTcM (LocatedN Id)
zonkLIdOcc :: GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
zonkLIdOcc = (Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenLocated SrcSpanAnnN a -> f (GenLocated SrcSpanAnnN b)
traverse Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc

zonkIdOcc :: TcId -> ZonkTcM 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 :: Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
id
  | Id -> Bool
isLocalVar Id
id =
    do { ZonkEnv { ze_id_env = id_env } <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv
       ; return $ lookupVarEnv id_env id `orElse` id }
  | Bool
otherwise
  = Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Id
id

zonkIdOccs :: [TcId] -> ZonkTcM [Id]
zonkIdOccs :: [Id] -> ZonkTcM [Id]
zonkIdOccs [Id]
ids = (Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> [Id] -> ZonkTcM [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc [Id]
ids

-- zonkIdBndr is used *after* typechecking to get the Id's type
-- to its final form.  The TyVarEnv give
zonkIdBndrX :: TcId -> ZonkBndrTcM Id
zonkIdBndrX :: Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
v
  = do { id <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
v
       ; extendIdZonkEnv id
       ; return id }
{-# INLINE zonkIdBndrX #-} -- See Note [Inlining ZonkBndrT computations]

zonkIdBndr :: TcId -> ZonkTcM Id
zonkIdBndr :: Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
v
  = do { Scaled w' ty' <- Scaled Kind -> ZonkTcM (Scaled Kind)
zonkScaledTcTypeToTypeX (Id -> Scaled Kind
idScaledType Id
v)
       ; return $ setIdMult (setIdType v ty') w' }

zonkIdBndrs :: [TcId] -> ZonkTcM [Id]
zonkIdBndrs :: [Id] -> ZonkTcM [Id]
zonkIdBndrs [Id]
ids = (Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> [Id] -> ZonkTcM [Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr [Id]
ids

zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs :: [Id] -> TcM [Id]
zonkTopBndrs [Id]
ids = ZonkFlexi -> ZonkTcM [Id] -> TcM [Id]
forall (m :: * -> *) b. MonadIO m => ZonkFlexi -> ZonkT m b -> m b
initZonkEnv ZonkFlexi
DefaultFlexi (ZonkTcM [Id] -> TcM [Id]) -> ZonkTcM [Id] -> TcM [Id]
forall a b. (a -> b) -> a -> b
$ [Id] -> ZonkTcM [Id]
zonkIdBndrs [Id]
ids

zonkFieldOcc :: FieldOcc GhcTc -> ZonkTcM (FieldOcc GhcTc)
zonkFieldOcc :: FieldOcc GhcTc -> ZonkTcM (FieldOcc GhcTc)
zonkFieldOcc (FieldOcc XCFieldOcc GhcTc
sel XRec GhcTc RdrName
lbl)
  = (Id -> FieldOcc GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkTcM (FieldOcc GhcTc)
forall a b.
(a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Id -> GenLocated SrcSpanAnnN RdrName -> FieldOcc GhcTc)
-> GenLocated SrcSpanAnnN RdrName -> Id -> FieldOcc GhcTc
forall a b c. (a -> b -> c) -> b -> a -> c
flip XCFieldOcc GhcTc -> XRec GhcTc RdrName -> FieldOcc GhcTc
Id -> GenLocated SrcSpanAnnN RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc) XRec GhcTc RdrName
GenLocated SrcSpanAnnN RdrName
lbl) (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
 -> ZonkTcM (FieldOcc GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkTcM (FieldOcc GhcTc)
forall a b. (a -> b) -> a -> b
$ Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr XCFieldOcc GhcTc
Id
sel

zonkEvBndrsX :: [EvVar] -> ZonkBndrTcM [EvVar]
zonkEvBndrsX :: [Id] -> ZonkBndrTcM [Id]
zonkEvBndrsX = (Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> [Id] -> ZonkBndrTcM [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkEvBndrX
{-# INLINE zonkEvBndrsX #-} -- See Note [Inlining ZonkBndrT computations]

zonkEvBndrX :: EvVar -> ZonkBndrTcM EvVar
-- Works for dictionaries and coercions
zonkEvBndrX :: Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkEvBndrX Id
var
  = do { var' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkEvBndr Id
var
       ; extendZonkEnv [var']
       ; return var' }
{-# INLINE zonkEvBndr #-} -- See Note [Inlining ZonkBndrT computations]

zonkEvBndr :: EvVar -> ZonkTcM EvVar
-- Works for dictionaries and coercions
-- Does not extend the ZonkEnv
zonkEvBndr :: Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkEvBndr Id
var
  = (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *). Monad m => (Kind -> m Kind) -> Id -> m Id
updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX) Id
var

{-
zonkEvVarOcc :: EvVar -> ZonkTcM EvTerm
zonkEvVarOcc env v
  | isCoVar v
  = EvCoercion <$> zonkCoVarOcc env v
  | otherwise
  = return (EvId $ zonkIdOcc env v)
-}

zonkCoreBndrX :: Var -> ZonkBndrTcM Var
zonkCoreBndrX :: Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkCoreBndrX Id
v
  | Id -> Bool
isId Id
v    = Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
v
  | Bool
otherwise = Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX Id
v
{-# INLINE zonkCoreBndrX #-} -- See Note [Inlining ZonkBndrT computations]

zonkCoreBndrsX :: [Var] -> ZonkBndrTcM [Var]
zonkCoreBndrsX :: [Id] -> ZonkBndrTcM [Id]
zonkCoreBndrsX = (Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> [Id] -> ZonkBndrTcM [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkCoreBndrX
{-# INLINE zonkCoreBndrsX #-} -- See Note [Inlining ZonkBndrT computations]

zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr HsExpr GhcTc
e = ZonkFlexi
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> TcM (HsExpr GhcTc)
forall (m :: * -> *) b. MonadIO m => ZonkFlexi -> ZonkT m b -> m b
initZonkEnv ZonkFlexi
DefaultFlexi (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
 -> TcM (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
e

zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr LHsExpr GhcTc
e = ZonkFlexi
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
-> TcM (LHsExpr GhcTc)
forall (m :: * -> *) b. MonadIO m => ZonkFlexi -> ZonkT m b -> m b
initZonkEnv ZonkFlexi
DefaultFlexi (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
 -> TcM (LHsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
-> TcM (LHsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e

zonkTopDecls :: Bag EvBind
             -> LHsBinds GhcTc
             -> [LRuleDecl GhcTc] -> [LTcSpecPrag]
             -> [LForeignDecl GhcTc]
             -> TcM (TypeEnv,
                     Bag EvBind,
                     LHsBinds GhcTc,
                     [LForeignDecl GhcTc],
                     [LTcSpecPrag],
                     [LRuleDecl    GhcTc])
zonkTopDecls :: Bag EvBind
-> LHsBinds GhcTc
-> [LRuleDecl GhcTc]
-> [LTcSpecPrag]
-> [LForeignDecl GhcTc]
-> TcM
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
zonkTopDecls Bag EvBind
ev_binds LHsBinds GhcTc
binds [LRuleDecl GhcTc]
rules [LTcSpecPrag]
imp_specs [LForeignDecl GhcTc]
fords
  = ZonkFlexi
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
-> TcM
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
forall (m :: * -> *) b. MonadIO m => ZonkFlexi -> ZonkT m b -> m b
initZonkEnv ZonkFlexi
DefaultFlexi (ZonkT
   (IOEnv (Env TcGblEnv TcLclEnv))
   (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
    [LTcSpecPrag], [LRuleDecl GhcTc])
 -> TcM
      (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
       [LTcSpecPrag], [LRuleDecl GhcTc]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
-> TcM
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
forall a b. (a -> b) -> a -> b
$
    ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
-> forall r.
   (Bag EvBind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (Bag EvBind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonkEvBinds Bag EvBind
ev_binds)   ((Bag EvBind
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
        [LTcSpecPrag], [LRuleDecl GhcTc]))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
       [LTcSpecPrag], [LRuleDecl GhcTc]))
-> (Bag EvBind
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
forall a b. (a -> b) -> a -> b
$ \ Bag EvBind
ev_binds' ->
    ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
-> forall r.
   ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc)
zonkRecMonoBinds LHsBinds GhcTc
binds) (([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
        [LTcSpecPrag], [LRuleDecl GhcTc]))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
       [LTcSpecPrag], [LRuleDecl GhcTc]))
-> ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
forall a b. (a -> b) -> a -> b
$ \ [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
binds'    ->
     -- Top level is implicitly recursive
  do  { rules' <- [LRuleDecl GhcTc] -> ZonkTcM [LRuleDecl GhcTc]
zonkRules [LRuleDecl GhcTc]
rules
      ; specs' <- zonkLTcSpecPrags imp_specs
      ; fords' <- zonkForeignExports fords
      ; ty_env <- zonkEnvIds <$> getZonkEnv
      ; return (ty_env, ev_binds', binds', fords', specs', rules') }


---------------------------------------------
zonkLocalBinds :: HsLocalBinds GhcTc
               -> ZonkBndrTcM (HsLocalBinds GhcTc)
zonkLocalBinds :: HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
zonkLocalBinds (EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
x)
  = HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XEmptyLocalBinds GhcTc GhcTc -> HsLocalBinds GhcTc
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
x)

zonkLocalBinds (HsValBinds XHsValBinds GhcTc GhcTc
_ (ValBinds {}))
  = String -> ZonkBndrTcM (HsLocalBinds GhcTc)
forall a. HasCallStack => String -> a
panic String
"zonkLocalBinds" -- Not in typechecker output

zonkLocalBinds (HsValBinds XHsValBinds GhcTc GhcTc
x (XValBindsLR (NValBinds [(RecFlag, LHsBinds GhcTc)]
binds [LSig GhcRn]
sigs)))
  = do  { new_binds <- ((RecFlag, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (RecFlag, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]))
-> [(RecFlag, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(RecFlag, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RecFlag, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (RecFlag, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
forall {a}.
(a, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (a, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
go [(RecFlag, LHsBinds GhcTc)]
[(RecFlag, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])]
binds
        ; return (HsValBinds x (XValBindsLR (NValBinds new_binds sigs))) }
  where
    go :: (a, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (a, [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
go (a
r,[GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
b)
      = do { b' <- LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc)
zonkRecMonoBinds LHsBinds GhcTc
[GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
b
           ; return (r,b') }

zonkLocalBinds (HsIPBinds XHsIPBinds GhcTc GhcTc
x (IPBinds XIPBinds GhcTc
dict_binds [LIPBind GhcTc]
binds )) = do
    new_binds <- ZonkT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated SrcSpanAnnA (IPBind GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (IPBind GhcTc)]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT
   (IOEnv (Env TcGblEnv TcLclEnv))
   [GenLocated SrcSpanAnnA (IPBind GhcTc)]
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      [GenLocated SrcSpanAnnA (IPBind GhcTc)])
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (IPBind GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (IPBind GhcTc)]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (IPBind GhcTc)
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (IPBind GhcTc)))
-> [GenLocated SrcSpanAnnA (IPBind GhcTc)]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (IPBind GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((IPBind GhcTc -> ZonkTcM (IPBind GhcTc))
-> GenLocated SrcSpanAnnA (IPBind GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (IPBind GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA IPBind GhcTc -> ZonkTcM (IPBind GhcTc)
zonk_ip_bind) [LIPBind GhcTc]
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
binds
    extendIdZonkEnvRec [ n | (L _ (IPBind n _ _)) <- new_binds]
    new_dict_binds <- zonkTcEvBinds dict_binds
    return $ HsIPBinds x (IPBinds new_dict_binds new_binds)
  where
    zonk_ip_bind :: IPBind GhcTc -> ZonkTcM (IPBind GhcTc)
zonk_ip_bind (IPBind XCIPBind GhcTc
dict_id XRec GhcTc HsIPName
n LHsExpr GhcTc
e)
        = do dict_id' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr XCIPBind GhcTc
Id
dict_id
             e'       <- zonkLExpr e
             return (IPBind dict_id' n e')

---------------------------------------------
zonkRecMonoBinds :: LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc)
zonkRecMonoBinds :: LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc)
zonkRecMonoBinds LHsBinds GhcTc
binds
  = (LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc))
-> ZonkBndrTcM (LHsBinds GhcTc)
forall a.
(a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc))
 -> ZonkBndrTcM (LHsBinds GhcTc))
-> (LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc))
-> ZonkBndrTcM (LHsBinds GhcTc)
forall a b. (a -> b) -> a -> b
$ \ LHsBinds GhcTc
new_binds ->
  do { [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec (CollectFlag GhcTc -> LHsBinds GhcTc -> [IdP GhcTc]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders LHsBinds GhcTc
new_binds)
     ; ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsBinds GhcTc)
-> ZonkBndrTcM (LHsBinds GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsBinds GhcTc)
 -> ZonkBndrTcM (LHsBinds GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsBinds GhcTc)
-> ZonkBndrTcM (LHsBinds GhcTc)
forall a b. (a -> b) -> a -> b
$ LHsBinds GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsBinds GhcTc)
zonkMonoBinds LHsBinds GhcTc
binds }

---------------------------------------------
zonkMonoBinds :: LHsBinds GhcTc -> ZonkTcM (LHsBinds GhcTc)
zonkMonoBinds :: LHsBinds GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsBinds GhcTc)
zonkMonoBinds LHsBinds GhcTc
binds = (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsBind GhcTc -> ZonkTcM (LHsBind GhcTc)
GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_lbind LHsBinds GhcTc
[GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
binds

zonk_lbind :: LHsBind GhcTc -> ZonkTcM (LHsBind GhcTc)
zonk_lbind :: LHsBind GhcTc -> ZonkTcM (LHsBind GhcTc)
zonk_lbind = (HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
zonk_bind

zonk_bind :: HsBind GhcTc -> ZonkTcM (HsBind GhcTc)
zonk_bind :: HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
zonk_bind bind :: HsBindLR GhcTc GhcTc
bind@(PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcTc
pat, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
grhss
                        , pat_mult :: forall idL idR. HsBindLR idL idR -> HsMultAnn idL
pat_mult = HsMultAnn GhcTc
mult_ann
                        , pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_ext = (Kind
ty, ([CoreTickish], [[CoreTickish]])
ticks)})
  = do  { new_pat   <- ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
forall (m :: * -> *) a. Monad m => ZonkBndrT m a -> ZonkT m a
don'tBind (ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc))
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
forall a b. (a -> b) -> a -> b
$ LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat            -- Env already extended
        ; new_grhss <- zonkGRHSs zonkLExpr grhss
        ; new_ty    <- zonkTcTypeToTypeX ty
        ; new_mult  <- zonkMultAnn mult_ann
        ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss
                       , pat_mult = new_mult
                       , pat_ext = (new_ty, ticks) }) }

zonk_bind (VarBind { var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
var_ext = XVarBind GhcTc GhcTc
x
                   , var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP GhcTc
var, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr GhcTc
expr })
  = do { new_var  <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr IdP GhcTc
Id
var
       ; new_expr <- zonkLExpr expr
       ; return (VarBind { var_ext = x
                         , var_id = new_var
                         , var_rhs = new_expr }) }

zonk_bind bind :: HsBindLR GhcTc GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
loc Id
var
                        , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
                        , fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext = (HsWrapper
co_fn, [CoreTickish]
ticks) })
  = do { new_var <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
var
       ; runZonkBndrT (zonkCoFn co_fn) $ \ HsWrapper
new_co_fn ->
    do { new_ms <- (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
ms
       ; return (bind { fun_id = L loc new_var
                      , fun_matches = new_ms
                      , fun_ext = (new_co_fn, ticks) }) } }

zonk_bind (XHsBindsLR (AbsBinds { abs_tvs :: AbsBinds -> [Id]
abs_tvs = [Id]
tyvars, abs_ev_vars :: AbsBinds -> [Id]
abs_ev_vars = [Id]
evs
                                , abs_ev_binds :: AbsBinds -> [TcEvBinds]
abs_ev_binds = [TcEvBinds]
ev_binds
                                , abs_exports :: AbsBinds -> [ABExport]
abs_exports = [ABExport]
exports
                                , abs_binds :: AbsBinds -> LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
val_binds
                                , abs_sig :: AbsBinds -> Bool
abs_sig = Bool
has_sig }))
  = Bool
-> ZonkTcM (HsBindLR GhcTc GhcTc) -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a. HasCallStack => Bool -> a -> a
assert ( (Id -> Bool) -> [Id] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Id -> Bool
isImmutableTyVar [Id]
tyvars ) (ZonkTcM (HsBindLR GhcTc GhcTc) -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ZonkTcM (HsBindLR GhcTc GhcTc) -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$
    ZonkBndrTcM [Id]
-> forall r.
   ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([Id] -> ZonkBndrTcM [Id]
zonkTyBndrsX    [Id]
tyvars  ) (([Id] -> ZonkTcM (HsBindLR GhcTc GhcTc))
 -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ([Id] -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ \ [Id]
new_tyvars   ->
    ZonkBndrTcM [Id]
-> forall r.
   ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([Id] -> ZonkBndrTcM [Id]
zonkEvBndrsX    [Id]
evs     ) (([Id] -> ZonkTcM (HsBindLR GhcTc GhcTc))
 -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ([Id] -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ \ [Id]
new_evs      ->
    ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [TcEvBinds]
-> forall r.
   ([TcEvBinds] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([TcEvBinds]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [TcEvBinds]
zonkTcEvBinds_s [TcEvBinds]
ev_binds) (([TcEvBinds] -> ZonkTcM (HsBindLR GhcTc GhcTc))
 -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ([TcEvBinds] -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ \ [TcEvBinds]
new_ev_binds ->
  do { (new_val_bind, new_exports) <- (([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport])
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport])
forall a.
(a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport])
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport]))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport]))
-> (([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport])
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport])
forall a b. (a -> b) -> a -> b
$ \ ~([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
new_val_binds, [ABExport]
_) ->
       ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
-> forall r.
   (() -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec ([Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ())
-> [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall a b. (a -> b) -> a -> b
$ CollectFlag GhcTc -> LHsBinds GhcTc -> [IdP GhcTc]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders LHsBinds GhcTc
[GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
new_val_binds) ((()
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport]))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport]))
-> (()
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)], [ABExport])
forall a b. (a -> b) -> a -> b
$ \ ()
_ ->
       do { new_val_binds <- (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_val_bind LHsBinds GhcTc
[GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
val_binds
          ; new_exports   <- mapM zonk_export exports
          ; return (new_val_binds, new_exports)
          }
     ; return $ XHsBindsLR $
                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
                         , abs_sig = has_sig } }
  where
    zonk_val_bind :: GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_val_bind GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind
      | Bool
has_sig
      , (L SrcSpanAnnA
loc bind :: HsBindLR GhcTc GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id      = (L SrcSpanAnnN
mloc Id
mono_id)
                             , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
                             , fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext     = (HsWrapper
co_fn, [CoreTickish]
ticks) })) <- GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind
      = do { new_mono_id <- (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *). Monad m => (Kind -> m Kind) -> Id -> m Id
updateIdTypeAndMultM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Id
mono_id
                            -- Specifically /not/ zonkIdBndr; we do not want to
                            -- complain about a representation-polymorphic binder
           ; runZonkBndrT (zonkCoFn co_fn) $ \ HsWrapper
new_co_fn ->
        do { new_ms            <- (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
ms
           ; return $ L loc $
             bind { fun_id      = L mloc new_mono_id
                  , fun_matches = new_ms
                  , fun_ext     = (new_co_fn, ticks) } } }
      | Bool
otherwise
      = LHsBind GhcTc -> ZonkTcM (LHsBind GhcTc)
zonk_lbind LHsBind GhcTc
GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind   -- The normal case

    zonk_export :: ABExport -> ZonkTcM ABExport
    zonk_export :: ABExport -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ABExport
zonk_export (ABE{ abe_wrap :: ABExport -> HsWrapper
abe_wrap  = HsWrapper
wrap
                    , abe_poly :: ABExport -> Id
abe_poly  = Id
poly_id
                    , abe_mono :: ABExport -> Id
abe_mono  = Id
mono_id
                    , abe_prags :: ABExport -> TcSpecPrags
abe_prags = TcSpecPrags
prags })
        = do new_poly_id <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
poly_id
             new_wrap    <- don'tBind $ zonkCoFn wrap
             new_prags   <- zonkSpecPrags prags
             new_mono_id <- zonkIdOcc mono_id
             return (ABE{ abe_wrap  = new_wrap
                        , abe_poly  = new_poly_id
                        , abe_mono  = new_mono_id
                        , abe_prags = new_prags })

zonk_bind (PatSynBind XPatSynBind GhcTc GhcTc
x bind :: PatSynBind GhcTc GhcTc
bind@(PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id   = L SrcSpanAnnN
loc Id
id
                                  , psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args = HsPatSynDetails GhcTc
details
                                  , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def  = LPat GhcTc
lpat
                                  , psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir  = HsPatSynDir GhcTc
dir }))
  = do { id' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
id
       ; runZonkBndrT (zonkPat lpat) $ \ GenLocated SrcSpanAnnA (Pat GhcTc)
lpat' ->
    do { details' <- HsPatSynDetails GhcTc -> ZonkTcM (HsPatSynDetails GhcTc)
zonkPatSynDetails HsPatSynDetails GhcTc
details
       ; dir'     <- zonkPatSynDir dir
       ; return $ PatSynBind x $
                  bind { psb_id   = L loc id'
                       , psb_args = details'
                       , psb_def  = lpat'
                       , psb_dir  = dir' } } }

zonkMultAnn :: HsMultAnn GhcTc -> ZonkTcM (HsMultAnn GhcTc)
zonkMultAnn :: HsMultAnn GhcTc -> ZonkTcM (HsMultAnn GhcTc)
zonkMultAnn (HsNoMultAnn XNoMultAnn GhcTc
mult)
  = do { mult' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
XNoMultAnn GhcTc
mult
       ; return (HsNoMultAnn mult') }
zonkMultAnn (HsPct1Ann XPct1Ann GhcTc
mult)
  = do { mult' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
XPct1Ann GhcTc
mult
       ; return (HsPct1Ann mult') }
zonkMultAnn (HsMultAnn XMultAnn GhcTc
mult LHsType (NoGhcTc GhcTc)
hs_ty)
  = do { mult' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
XMultAnn GhcTc
mult
       ; return (HsMultAnn mult' hs_ty) }

zonkPatSynDetails :: HsPatSynDetails GhcTc
                  -> ZonkTcM (HsPatSynDetails GhcTc)
zonkPatSynDetails :: HsPatSynDetails GhcTc -> ZonkTcM (HsPatSynDetails GhcTc)
zonkPatSynDetails (PrefixCon [Void]
_ [LIdP GhcTc]
as)
  = [Void]
-> [GenLocated SrcSpanAnnN Id]
-> HsConDetails
     Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc]
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs ([GenLocated SrcSpanAnnN Id]
 -> HsConDetails
      Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv)) [GenLocated SrcSpanAnnN Id]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsConDetails
        Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id))
-> [GenLocated SrcSpanAnnN Id]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv)) [GenLocated SrcSpanAnnN Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
zonkLIdOcc [LIdP GhcTc]
[GenLocated SrcSpanAnnN Id]
as
zonkPatSynDetails (InfixCon LIdP GhcTc
a1 LIdP GhcTc
a2)
  = GenLocated SrcSpanAnnN Id
-> GenLocated SrcSpanAnnN Id
-> HsConDetails
     Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc]
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (GenLocated SrcSpanAnnN Id
 -> GenLocated SrcSpanAnnN Id
 -> HsConDetails
      Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
-> ZonkTcM (GenLocated SrcSpanAnnN Id)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnN Id
      -> HsConDetails
           Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
zonkLIdOcc LIdP GhcTc
GenLocated SrcSpanAnnN Id
a1 ZonkT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (GenLocated SrcSpanAnnN Id
   -> HsConDetails
        Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
-> ZonkTcM (GenLocated SrcSpanAnnN Id)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsConDetails
        Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
zonkLIdOcc LIdP GhcTc
GenLocated SrcSpanAnnN Id
a2
zonkPatSynDetails (RecCon [RecordPatSynField GhcTc]
flds)
  = [RecordPatSynField GhcTc]
-> HsConDetails
     Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc]
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon ([RecordPatSynField GhcTc]
 -> HsConDetails
      Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [RecordPatSynField GhcTc]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsConDetails
        Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RecordPatSynField GhcTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (RecordPatSynField GhcTc))
-> [RecordPatSynField GhcTc]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [RecordPatSynField GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RecordPatSynField GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (RecordPatSynField GhcTc)
zonkPatSynField [RecordPatSynField GhcTc]
flds

zonkPatSynField :: RecordPatSynField GhcTc -> ZonkTcM (RecordPatSynField GhcTc)
zonkPatSynField :: RecordPatSynField GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (RecordPatSynField GhcTc)
zonkPatSynField (RecordPatSynField FieldOcc GhcTc
x LIdP GhcTc
y) =
  FieldOcc GhcTc -> LIdP GhcTc -> RecordPatSynField GhcTc
FieldOcc GhcTc
-> GenLocated SrcSpanAnnN Id -> RecordPatSynField GhcTc
forall pass. FieldOcc pass -> LIdP pass -> RecordPatSynField pass
RecordPatSynField (FieldOcc GhcTc
 -> GenLocated SrcSpanAnnN Id -> RecordPatSynField GhcTc)
-> ZonkTcM (FieldOcc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnN Id -> RecordPatSynField GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldOcc GhcTc -> ZonkTcM (FieldOcc GhcTc)
zonkFieldOcc FieldOcc GhcTc
x ZonkT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (GenLocated SrcSpanAnnN Id -> RecordPatSynField GhcTc)
-> ZonkTcM (GenLocated SrcSpanAnnN Id)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (RecordPatSynField GhcTc)
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
zonkLIdOcc LIdP GhcTc
GenLocated SrcSpanAnnN Id
y

zonkPatSynDir :: HsPatSynDir GhcTc
              -> ZonkTcM (HsPatSynDir GhcTc)
zonkPatSynDir :: HsPatSynDir GhcTc -> ZonkTcM (HsPatSynDir GhcTc)
zonkPatSynDir HsPatSynDir GhcTc
Unidirectional             = HsPatSynDir GhcTc -> ZonkTcM (HsPatSynDir GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return HsPatSynDir GhcTc
forall id. HsPatSynDir id
Unidirectional
zonkPatSynDir HsPatSynDir GhcTc
ImplicitBidirectional      = HsPatSynDir GhcTc -> ZonkTcM (HsPatSynDir GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return HsPatSynDir GhcTc
forall id. HsPatSynDir id
ImplicitBidirectional
zonkPatSynDir (ExplicitBidirectional MatchGroup GhcTc (LHsExpr GhcTc)
mg) = MatchGroup GhcTc (LHsExpr GhcTc) -> HsPatSynDir GhcTc
MatchGroup GhcTc (LocatedA (HsExpr GhcTc)) -> HsPatSynDir GhcTc
forall id. MatchGroup id (LHsExpr id) -> HsPatSynDir id
ExplicitBidirectional (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)) -> HsPatSynDir GhcTc)
-> ZonkTcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
-> ZonkTcM (HsPatSynDir GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
mg

zonkSpecPrags :: TcSpecPrags -> ZonkTcM TcSpecPrags
zonkSpecPrags :: TcSpecPrags -> ZonkTcM TcSpecPrags
zonkSpecPrags TcSpecPrags
IsDefaultMethod = TcSpecPrags -> ZonkTcM TcSpecPrags
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return TcSpecPrags
IsDefaultMethod
zonkSpecPrags (SpecPrags [LTcSpecPrag]
ps)  = do { ps' <- [LTcSpecPrag] -> ZonkTcM [LTcSpecPrag]
zonkLTcSpecPrags [LTcSpecPrag]
ps
                                   ; return (SpecPrags ps') }

zonkLTcSpecPrags :: [LTcSpecPrag] -> ZonkTcM [LTcSpecPrag]
zonkLTcSpecPrags :: [LTcSpecPrag] -> ZonkTcM [LTcSpecPrag]
zonkLTcSpecPrags [LTcSpecPrag]
ps
  = (LTcSpecPrag -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) LTcSpecPrag)
-> [LTcSpecPrag] -> ZonkTcM [LTcSpecPrag]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LTcSpecPrag -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) LTcSpecPrag
forall {l}.
GenLocated l TcSpecPrag
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated l TcSpecPrag)
zonk_prag [LTcSpecPrag]
ps
  where
    zonk_prag :: GenLocated l TcSpecPrag
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated l TcSpecPrag)
zonk_prag (L l
loc (SpecPrag Id
id HsWrapper
co_fn InlinePragma
inl))
        = do { co_fn' <- ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (m :: * -> *) a. Monad m => ZonkBndrT m a -> ZonkT m a
don'tBind (ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall a b. (a -> b) -> a -> b
$ HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
co_fn
             ; id' <- zonkIdOcc id
             ; return (L loc (SpecPrag id' co_fn' inl)) }

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}
*                                                                      *
************************************************************************
-}

zonkMatchGroup :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO
               => (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
               -> MatchGroup GhcTc (LocatedA (body GhcTc))
               -> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup :: forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L Anno
  [GenLocated
     (Anno (Match GhcTc (LocatedA (body GhcTc))))
     (Match GhcTc (LocatedA (body GhcTc)))]
l [GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))]
ms
                         , mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = MatchGroupTc [Scaled Kind]
arg_tys Kind
res_ty Origin
origin
                         })
  = do  { ms' <- (GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated
         (Anno (Match GhcTc (LocatedA (body GhcTc))))
         (Match GhcTc (LocatedA (body GhcTc)))))
-> [GenLocated
      (Anno (Match GhcTc (LocatedA (body GhcTc))))
      (Match GhcTc (LocatedA (body GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        (Anno (Match GhcTc (LocatedA (body GhcTc))))
        (Match GhcTc (LocatedA (body GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (LMatch GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody) [GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))]
ms
        ; arg_tys' <- zonkScaledTcTypesToTypesX arg_tys
        ; res_ty'  <- zonkTcTypeToTypeX res_ty
        ; return (MG { mg_alts = L l ms'
                     , mg_ext = MatchGroupTc arg_tys' res_ty' origin
                     }) }

zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO
          => (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
          -> LMatch GhcTc (LocatedA (body GhcTc))
          -> ZonkTcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch :: forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (L Anno (Match GhcTc (LocatedA (body GhcTc)))
loc match :: Match GhcTc (LocatedA (body GhcTc))
match@(Match { m_pats :: forall p body. Match p body -> XRec p [LPat p]
m_pats = L EpaLocation
l [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats
                                    , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcTc (LocatedA (body GhcTc))
grhss }))
  = ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> forall r.
   ([GenLocated SrcSpanAnnA (Pat GhcTc)]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
forall (f :: * -> *).
Traversable f =>
f (LPat GhcTc) -> ZonkBndrTcM (f (LPat GhcTc))
zonkPats [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
pats) (([GenLocated SrcSpanAnnA (Pat GhcTc)]
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       (LMatch GhcTc (LocatedA (body GhcTc))))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (LMatch GhcTc (LocatedA (body GhcTc))))
-> ([GenLocated SrcSpanAnnA (Pat GhcTc)]
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (LMatch GhcTc (LocatedA (body GhcTc))))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (LMatch GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ \ [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats ->
  do  { new_grhss <- (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (GRHSs GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody GRHSs GhcTc (LocatedA (body GhcTc))
grhss
      ; return (L loc (match { m_pats = L l new_pats, m_grhss = new_grhss })) }

-------------------------------------------------------------------------
zonkGRHSs :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO
          => (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
          -> GRHSs GhcTc (LocatedA (body GhcTc))
          -> ZonkTcM (GRHSs GhcTc (LocatedA (body GhcTc)))

zonkGRHSs :: forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (GRHSs XCGRHSs GhcTc (LocatedA (body GhcTc))
x [LGRHS GhcTc (LocatedA (body GhcTc))]
grhss HsLocalBinds GhcTc
binds) =
  ZonkBndrTcM (HsLocalBinds GhcTc)
-> forall r.
   (HsLocalBinds GhcTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
zonkLocalBinds HsLocalBinds GhcTc
binds) ((HsLocalBinds GhcTc
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       (GRHSs GhcTc (LocatedA (body GhcTc))))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GRHSs GhcTc (LocatedA (body GhcTc))))
-> (HsLocalBinds GhcTc
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (GRHSs GhcTc (LocatedA (body GhcTc))))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GRHSs GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ \ HsLocalBinds GhcTc
new_binds ->
    do { new_grhss <- (GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))))
-> [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((GRHS GhcTc (LocatedA (body GhcTc))
 -> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc))))
-> GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc))))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA GRHS GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc)))
zonk_grhs) [LGRHS GhcTc (LocatedA (body GhcTc))]
[GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))]
grhss
       ; return (GRHSs x new_grhss new_binds) }
  where
     zonk_grhs :: GRHS GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc)))
zonk_grhs (GRHS XCGRHS GhcTc (LocatedA (body GhcTc))
xx [GuardLStmt GhcTc]
guarded LocatedA (body GhcTc)
rhs) =
       ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> forall r.
   ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ((LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
guarded) (([GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
  -> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc))))
 -> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc))))
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc))))
-> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ \ [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_guarded ->
         XCGRHS GhcTc (LocatedA (body GhcTc))
-> [GuardLStmt GhcTc]
-> LocatedA (body GhcTc)
-> GRHS GhcTc (LocatedA (body GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (LocatedA (body GhcTc))
xx [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_guarded (LocatedA (body GhcTc) -> GRHS GhcTc (LocatedA (body GhcTc)))
-> ZonkTcM (LocatedA (body GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody LocatedA (body GhcTc)
rhs

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
*                                                                      *
************************************************************************
-}

zonkLExprs :: [LHsExpr GhcTc] -> ZonkTcM [LHsExpr GhcTc]
zonkLExpr  :: LHsExpr GhcTc   -> ZonkTcM (LHsExpr GhcTc)
zonkExpr   :: HsExpr GhcTc    -> ZonkTcM (HsExpr GhcTc)

zonkLExprs :: [LHsExpr GhcTc] -> ZonkTcM [LHsExpr GhcTc]
zonkLExprs [LHsExpr GhcTc]
exprs = (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> [LocatedA (HsExpr GhcTc)]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [LocatedA (HsExpr GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr [LHsExpr GhcTc]
[LocatedA (HsExpr GhcTc)]
exprs
zonkLExpr :: LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr  LHsExpr GhcTc
expr  = (HsExpr GhcTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
expr

zonkExpr :: HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr (HsVar XVar GhcTc
x (L SrcSpanAnnN
l Id
id))
  = Bool
-> SDoc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Maybe DataCon -> Bool
forall a. Maybe a -> Bool
isNothing (Id -> Maybe DataCon
isDataConId_maybe Id
id)) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id) (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$
  do { id' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
id
     ; return (HsVar x (L l id')) }

zonkExpr (HsUnboundVar XUnboundVar GhcTc
her RdrName
occ)
  = do her' <- HoleExprRef -> ZonkTcM HoleExprRef
zonk_her XUnboundVar GhcTc
HoleExprRef
her
       return (HsUnboundVar her' occ)
  where
    zonk_her :: HoleExprRef -> ZonkTcM HoleExprRef
    zonk_her :: HoleExprRef -> ZonkTcM HoleExprRef
zonk_her (HER IORef EvTerm
ref Kind
ty Unique
u)
      = do IORef EvTerm
-> (EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *) a. MonadIO m => TcRef a -> (a -> m a) -> m ()
updTcRefM IORef EvTerm
ref EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm
           ty'  <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
           return (HER ref ty' u)

zonkExpr (HsRecSel XRecSel GhcTc
_ (FieldOcc XCFieldOcc GhcTc
v XRec GhcTc RdrName
occ))
  = do { v' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc XCFieldOcc GhcTc
Id
v
       ; return (HsRecSel noExtField (FieldOcc v' occ)) }

zonkExpr (HsIPVar XIPVar GhcTc
x HsIPName
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XIPVar GhcTc
DataConCantHappen
x

zonkExpr (HsOverLabel XOverLabel GhcTc
x FastString
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XOverLabel GhcTc
DataConCantHappen
x

zonkExpr (HsLit XLitE GhcTc
x (HsRat XHsRat GhcTc
e FractionalLit
f Kind
ty))
  = do new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       return (HsLit x (HsRat e f new_ty))

zonkExpr (HsLit XLitE GhcTc
x HsLit GhcTc
lit)
  = HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
x HsLit GhcTc
lit)

zonkExpr (HsOverLit XOverLitE GhcTc
x HsOverLit GhcTc
lit)
  = do  { lit' <- HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
zonkOverLit HsOverLit GhcTc
lit
        ; return (HsOverLit x lit') }

zonkExpr (HsLam XLam GhcTc
x HsLamVariant
lam_variant MatchGroup GhcTc (LHsExpr GhcTc)
matches)
  = do new_matches <- (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
matches
       return (HsLam x lam_variant new_matches)

zonkExpr (HsApp XApp GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       new_e2 <- zonkLExpr e2
       return (HsApp x new_e1 new_e2)

zonkExpr (HsAppType XAppTypeE GhcTc
ty LHsExpr GhcTc
e LHsWcType (NoGhcTc GhcTc)
t)
  = do new_e <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       new_ty <- zonkTcTypeToTypeX ty
       return (HsAppType new_ty new_e t)
       -- NB: the type is an HsType; can't zonk that!

zonkExpr (HsTypedBracket XTypedBracket GhcTc
hsb_tc LHsExpr GhcTc
body)
  = (\HsBracketTc
x -> XTypedBracket GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XTypedBracket p -> LHsExpr p -> HsExpr p
HsTypedBracket XTypedBracket GhcTc
HsBracketTc
x LHsExpr GhcTc
body) (HsBracketTc -> HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsBracketTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsBracketTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsBracketTc
zonkBracket XTypedBracket GhcTc
HsBracketTc
hsb_tc

zonkExpr (HsUntypedBracket XUntypedBracket GhcTc
hsb_tc HsQuote GhcTc
body)
  = (\HsBracketTc
x -> XUntypedBracket GhcTc -> HsQuote GhcTc -> HsExpr GhcTc
forall p. XUntypedBracket p -> HsQuote p -> HsExpr p
HsUntypedBracket XUntypedBracket GhcTc
HsBracketTc
x HsQuote GhcTc
body) (HsBracketTc -> HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsBracketTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsBracketTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsBracketTc
zonkBracket XUntypedBracket GhcTc
HsBracketTc
hsb_tc

zonkExpr (HsTypedSplice XTypedSplice GhcTc
s LHsExpr GhcTc
_) = (ZonkEnv -> TcM (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT (\ ZonkEnv
_ -> DelayedSplice -> TcM (HsExpr GhcTc)
runTopSplice XTypedSplice GhcTc
DelayedSplice
s) ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> (HsExpr GhcTc
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> (a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr

zonkExpr (HsUntypedSplice XUntypedSplice GhcTc
x HsUntypedSplice GhcTc
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XUntypedSplice GhcTc
DataConCantHappen
x

zonkExpr (OpApp XOpApp GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XOpApp GhcTc
DataConCantHappen
x

zonkExpr (NegApp XNegApp GhcTc
x LHsExpr GhcTc
expr SyntaxExpr GhcTc
op)
  = ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> forall r.
   (SyntaxExprTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
op) ((SyntaxExprTc
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> (SyntaxExprTc
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ \ SyntaxExprTc
new_op ->
    do { new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       ; return (NegApp x new_expr new_op) }

zonkExpr (HsPar XPar GhcTc
x LHsExpr GhcTc
e)
  = do { new_e <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       ; return (HsPar x new_e) }

zonkExpr (SectionL XSectionL GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XSectionL GhcTc
DataConCantHappen
x
zonkExpr (SectionR XSectionR GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XSectionR GhcTc
DataConCantHappen
x
zonkExpr (ExplicitTuple XExplicitTuple GhcTc
x [HsTupArg GhcTc]
tup_args Boxity
boxed)
  = do { new_tup_args <- (HsTupArg GhcTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsTupArg GhcTc))
-> [HsTupArg GhcTc]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [HsTupArg GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsTupArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsTupArg GhcTc)
zonk_tup_arg [HsTupArg GhcTc]
tup_args
       ; return (ExplicitTuple x new_tup_args boxed) }
  where
    zonk_tup_arg :: HsTupArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsTupArg GhcTc)
zonk_tup_arg (Present XPresent GhcTc
x LHsExpr GhcTc
e) = do { e' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
                                    ; return (Present x e') }
    zonk_tup_arg (Missing XMissing GhcTc
t) = do { t' <- Scaled Kind -> ZonkTcM (Scaled Kind)
zonkScaledTcTypeToTypeX XMissing GhcTc
Scaled Kind
t
                                  ; return (Missing t') }


zonkExpr (ExplicitSum XExplicitSum GhcTc
args ConTag
alt ConTag
arity LHsExpr GhcTc
expr)
  = do new_args <- (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> [Kind] -> ZonkTcM [Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX [Kind]
XExplicitSum GhcTc
args
       new_expr <- zonkLExpr expr
       return (ExplicitSum new_args alt arity new_expr)

zonkExpr (HsCase XCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsExpr GhcTc)
ms)
  = do new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       new_ms <- zonkMatchGroup zonkLExpr ms
       return (HsCase x new_expr new_ms)

zonkExpr (HsIf XIf GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       new_e2 <- zonkLExpr e2
       new_e3 <- zonkLExpr e3
       return (HsIf x new_e1 new_e2 new_e3)

zonkExpr (HsMultiIf XMultiIf GhcTc
ty [LGRHS GhcTc (LHsExpr GhcTc)]
alts)
  = do { alts' <- (GenLocated EpAnnCO (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated EpAnnCO (GRHS GhcTc (LocatedA (HsExpr GhcTc)))))
-> [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((GRHS GhcTc (LocatedA (HsExpr GhcTc))
 -> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
-> GenLocated EpAnnCO (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated EpAnnCO (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
zonk_alt) [LGRHS GhcTc (LHsExpr GhcTc)]
[GenLocated EpAnnCO (GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
alts
       ; ty'   <- zonkTcTypeToTypeX ty
       ; return $ HsMultiIf ty' alts' }
  where zonk_alt :: GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
zonk_alt (GRHS XCGRHS GhcTc (LocatedA (HsExpr GhcTc))
x [GuardLStmt GhcTc]
guard LocatedA (HsExpr GhcTc)
expr)
          = ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> forall r.
   ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ((LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
guard) (([GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
  -> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
 -> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
-> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
forall a b. (a -> b) -> a -> b
$ \ [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
guard' ->
            do { expr' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
expr
               ; return $ GRHS x guard' expr' }

zonkExpr (HsLet XLet GhcTc
x HsLocalBinds GhcTc
binds LHsExpr GhcTc
expr)
  = ZonkBndrTcM (HsLocalBinds GhcTc)
-> forall r.
   (HsLocalBinds GhcTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
zonkLocalBinds HsLocalBinds GhcTc
binds) ((HsLocalBinds GhcTc
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> (HsLocalBinds GhcTc
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ \ HsLocalBinds GhcTc
new_binds ->
    do { new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       ; return (HsLet x new_binds new_expr) }

zonkExpr (HsDo XDo GhcTc
ty HsDoFlavour
do_or_lc (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts))
  = do new_stmts <- ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
forall (m :: * -> *) a. Monad m => ZonkBndrT m a -> ZonkT m a
don'tBind (ZonkBndrT
   (IOEnv (Env TcGblEnv TcLclEnv))
   [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      [GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))])
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
forall a b. (a -> b) -> a -> b
$ (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts
       new_ty <- zonkTcTypeToTypeX ty
       return (HsDo new_ty do_or_lc (L l new_stmts))

zonkExpr (ExplicitList XExplicitList GhcTc
ty [LHsExpr GhcTc]
exprs)
  = do new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XExplicitList GhcTc
Kind
ty
       new_exprs <- zonkLExprs exprs
       return (ExplicitList new_ty new_exprs)

zonkExpr expr :: HsExpr GhcTc
expr@(RecordCon { rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_ext = XRecordCon GhcTc
con_expr, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds GhcTc
rbinds })
  = do  { new_con_expr <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr XRecordCon GhcTc
HsExpr GhcTc
con_expr
        ; new_rbinds   <- zonkRecFields rbinds
        ; return (expr { rcon_ext  = new_con_expr
                       , rcon_flds = new_rbinds }) }

zonkExpr (ExprWithTySig XExprWithTySig GhcTc
_ LHsExpr GhcTc
e LHsSigWcType (NoGhcTc GhcTc)
ty)
  = do { e' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       ; return (ExprWithTySig noExtField e' ty) }

zonkExpr (ArithSeq XArithSeq GhcTc
expr Maybe (SyntaxExpr GhcTc)
wit ArithSeqInfo GhcTc
info)
  = do { new_expr <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr XArithSeq GhcTc
HsExpr GhcTc
expr
       ; runZonkBndrT (zonkWit wit) $ \ Maybe SyntaxExprTc
new_wit ->
    do { new_info <- ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
zonkArithSeq  ArithSeqInfo GhcTc
info
       ; return (ArithSeq new_expr new_wit new_info) } }
   where zonkWit :: Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
zonkWit Maybe SyntaxExprTc
Nothing    = Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SyntaxExprTc
forall a. Maybe a
Nothing
         zonkWit (Just SyntaxExprTc
fln) = SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just (SyntaxExprTc -> Maybe SyntaxExprTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
SyntaxExprTc
fln

zonkExpr (HsPragE XPragE GhcTc
x HsPragE GhcTc
prag LHsExpr GhcTc
expr)
  = do new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       return (HsPragE x prag new_expr)

-- arrow notation extensions
zonkExpr (HsProc XProc GhcTc
x LPat GhcTc
pat LHsCmdTop GhcTc
body)
  = ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
-> forall r.
   (GenLocated SrcSpanAnnA (Pat GhcTc)
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat) ((GenLocated SrcSpanAnnA (Pat GhcTc)
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> (GenLocated SrcSpanAnnA (Pat GhcTc)
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ \ GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat ->
    do  { new_body <- LHsCmdTop GhcTc -> ZonkTcM (LHsCmdTop GhcTc)
zonkCmdTop LHsCmdTop GhcTc
body
        ; return (HsProc x new_pat new_body) }

-- StaticPointers extension
zonkExpr (HsStatic (NameSet
fvs, Kind
ty) LHsExpr GhcTc
expr)
  = do new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       HsStatic (fvs, new_ty) <$> zonkLExpr expr

zonkExpr (HsEmbTy XEmbTy GhcTc
x LHsWcType (NoGhcTc GhcTc)
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XEmbTy GhcTc
DataConCantHappen
x
zonkExpr (HsQual XQual GhcTc
x XRec GhcTc [LHsExpr GhcTc]
_ LHsExpr GhcTc
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XQual GhcTc
DataConCantHappen
x
zonkExpr (HsForAll XForAll GhcTc
x HsForAllTelescope GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XForAll GhcTc
DataConCantHappen
x
zonkExpr (HsFunArr XFunArr GhcTc
x HsArrowOf (LHsExpr GhcTc) GhcTc
_ LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XFunArr GhcTc
DataConCantHappen
x

zonkExpr (XExpr (WrapExpr HsWrapper
co_fn HsExpr GhcTc
expr))
  = ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
-> forall r.
   (HsWrapper -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
co_fn) ((HsWrapper
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> (HsWrapper
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ \ HsWrapper
new_co_fn ->
    do new_expr <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
expr
       return (XExpr (WrapExpr new_co_fn new_expr))

zonkExpr (XExpr (ExpandedThingTc HsThingRn
thing HsExpr GhcTc
e))
  = do e' <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
e
       return $ XExpr (ExpandedThingTc thing e')


zonkExpr (XExpr (ConLikeTc ConLike
con [Id]
tvs [Scaled Kind]
tys))
  = XXExpr GhcTc -> HsExpr GhcTc
XXExprGhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (XXExprGhcTc -> HsExpr GhcTc)
-> ([Scaled Kind] -> XXExprGhcTc) -> [Scaled Kind] -> HsExpr GhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConLike -> [Id] -> [Scaled Kind] -> XXExprGhcTc
ConLikeTc ConLike
con [Id]
tvs ([Scaled Kind] -> HsExpr GhcTc)
-> ZonkTcM [Scaled Kind]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scaled Kind -> ZonkTcM (Scaled Kind))
-> [Scaled Kind] -> ZonkTcM [Scaled Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Scaled Kind -> ZonkTcM (Scaled Kind)
forall {a}.
Scaled a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Scaled a)
zonk_scale [Scaled Kind]
tys
  where
    zonk_scale :: Scaled a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Scaled a)
zonk_scale (Scaled Kind
m a
ty) = Kind -> a -> Scaled a
forall a. Kind -> a -> Scaled a
Scaled (Kind -> a -> Scaled a)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> Scaled a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
m ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> Scaled a)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Scaled a)
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ty
    -- Only the multiplicity can contain unification variables
    -- The tvs come straight from the data-con, and so are strictly redundant
    -- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head

zonkExpr (RecordUpd XRecordUpd GhcTc
x LHsExpr GhcTc
_ LHsRecUpdFields GhcTc
_)  = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XRecordUpd GhcTc
DataConCantHappen
x
zonkExpr (HsGetField XGetField GhcTc
x LHsExpr GhcTc
_ XRec GhcTc (DotFieldOcc GhcTc)
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XGetField GhcTc
DataConCantHappen
x
zonkExpr (HsProjection XProjection GhcTc
x NonEmpty (XRec GhcTc (DotFieldOcc GhcTc))
_) = DataConCantHappen
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XProjection GhcTc
DataConCantHappen
x
zonkExpr e :: HsExpr GhcTc
e@(XExpr (HsTick {})) = String
-> SDoc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkExpr" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)
zonkExpr e :: HsExpr GhcTc
e@(XExpr (HsBinTick {})) = String
-> SDoc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkExpr" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)

-------------------------------------------------------------------------
{-
Note [Skolems in zonkSyntaxExpr]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider rebindable syntax with something like

  (>>=) :: (forall x. blah) -> (forall y. blah') -> blah''

The x and y become skolems that are in scope when type-checking the
arguments to the bind. This means that we must extend the ZonkEnv with
these skolems when zonking the arguments to the bind. But the skolems
are different between the two arguments, and so we should theoretically
carry around different environments to use for the different arguments.

However, this becomes a logistical nightmare, especially in dealing with
the more exotic Stmt forms. So, we simplify by making the critical
assumption that the uniques of the skolems are different. (This assumption
is justified by the use of newUnique in GHC.Tc.Utils.TcMType.instSkolTyCoVarX.)
Now, we can safely just extend one environment.
-}

-- See Note [Skolems in zonkSyntaxExpr]
zonkSyntaxExpr :: SyntaxExpr GhcTc
               -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr :: SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr (SyntaxExprTc { syn_expr :: SyntaxExprTc -> HsExpr GhcTc
syn_expr      = HsExpr GhcTc
expr
                             , syn_arg_wraps :: SyntaxExprTc -> [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps
                             , syn_res_wrap :: SyntaxExprTc -> HsWrapper
syn_res_wrap  = HsWrapper
res_wrap })
  = do { res_wrap'  <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
res_wrap
       ; expr'      <- noBinders $ zonkExpr expr
       ; arg_wraps' <- traverse zonkCoFn arg_wraps
       ; return SyntaxExprTc { syn_expr      = expr'
                             , syn_arg_wraps = arg_wraps'
                             , syn_res_wrap  = res_wrap' } }
zonkSyntaxExpr SyntaxExpr GhcTc
SyntaxExprTc
NoSyntaxExprTc = SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return SyntaxExprTc
NoSyntaxExprTc

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

zonkLCmd  :: LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkCmd   :: HsCmd GhcTc  -> ZonkTcM (HsCmd GhcTc)

zonkLCmd :: LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd  LHsCmd GhcTc
cmd  = (HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc))
-> LocatedA (HsCmd GhcTc) -> ZonkTcM (LocatedA (HsCmd GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
zonkCmd LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
cmd

zonkCmd :: HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
zonkCmd (XCmd (HsWrap HsWrapper
w HsCmd GhcTc
cmd))
  = ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
-> forall r.
   (HsWrapper -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
w) ((HsWrapper -> ZonkTcM (HsCmd GhcTc)) -> ZonkTcM (HsCmd GhcTc))
-> (HsWrapper -> ZonkTcM (HsCmd GhcTc)) -> ZonkTcM (HsCmd GhcTc)
forall a b. (a -> b) -> a -> b
$ \ HsWrapper
w' ->
    do { cmd' <- HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
zonkCmd HsCmd GhcTc
cmd
       ; return (XCmd (HsWrap w' cmd')) }
zonkCmd (HsCmdArrApp XCmdArrApp GhcTc
ty LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 HsArrAppType
ho Bool
rl)
  = do new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       new_e2 <- zonkLExpr e2
       new_ty <- zonkTcTypeToTypeX ty
       return (HsCmdArrApp new_ty new_e1 new_e2 ho rl)

zonkCmd (HsCmdArrForm XCmdArrForm GhcTc
x LHsExpr GhcTc
op LexicalFixity
fixity [LHsCmdTop GhcTc]
args)
  = do new_op <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
op
       new_args <- mapM zonkCmdTop args
       return (HsCmdArrForm x new_op fixity new_args)

zonkCmd (HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
c LHsExpr GhcTc
e)
  = do new_c <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
c
       new_e <- zonkLExpr e
       return (HsCmdApp x new_c new_e)

zonkCmd (HsCmdPar XCmdPar GhcTc
x LHsCmd GhcTc
c)
  = do new_c <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
c
       return (HsCmdPar x new_c)

zonkCmd (HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsCmd GhcTc)
ms)
  = do new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       new_ms <- zonkMatchGroup zonkLCmd ms
       return (HsCmdCase x new_expr new_ms)

zonkCmd (HsCmdLam XCmdLamCase GhcTc
x HsLamVariant
lam_variant MatchGroup GhcTc (LHsCmd GhcTc)
ms)
  = do new_ms <- (LocatedA (HsCmd GhcTc) -> ZonkTcM (LocatedA (HsCmd GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (HsCmd GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
LocatedA (HsCmd GhcTc) -> ZonkTcM (LocatedA (HsCmd GhcTc))
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
ms
       return (HsCmdLam x lam_variant new_ms)

zonkCmd (HsCmdIf XCmdIf GhcTc
x SyntaxExpr GhcTc
eCond LHsExpr GhcTc
ePred LHsCmd GhcTc
cThen LHsCmd GhcTc
cElse)
  = ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> forall r.
   (SyntaxExprTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
eCond) ((SyntaxExprTc -> ZonkTcM (HsCmd GhcTc)) -> ZonkTcM (HsCmd GhcTc))
-> (SyntaxExprTc -> ZonkTcM (HsCmd GhcTc)) -> ZonkTcM (HsCmd GhcTc)
forall a b. (a -> b) -> a -> b
$ \ SyntaxExprTc
new_eCond ->
    do { new_ePred <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
ePred
       ; new_cThen <- zonkLCmd cThen
       ; new_cElse <- zonkLCmd cElse
       ; return (HsCmdIf x new_eCond new_ePred new_cThen new_cElse) }

zonkCmd (HsCmdLet XCmdLet GhcTc
x HsLocalBinds GhcTc
binds LHsCmd GhcTc
cmd)
  = ZonkBndrTcM (HsLocalBinds GhcTc)
-> forall r.
   (HsLocalBinds GhcTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
zonkLocalBinds HsLocalBinds GhcTc
binds) ((HsLocalBinds GhcTc -> ZonkTcM (HsCmd GhcTc))
 -> ZonkTcM (HsCmd GhcTc))
-> (HsLocalBinds GhcTc -> ZonkTcM (HsCmd GhcTc))
-> ZonkTcM (HsCmd GhcTc)
forall a b. (a -> b) -> a -> b
$ \ HsLocalBinds GhcTc
new_binds ->
    do new_cmd <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
cmd
       return (HsCmdLet x new_binds new_cmd)

zonkCmd (HsCmdDo XCmdDo GhcTc
ty (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
stmts))
  = do new_stmts <- ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
forall (m :: * -> *) a. Monad m => ZonkBndrT m a -> ZonkT m a
don'tBind (ZonkBndrT
   (IOEnv (Env TcGblEnv TcLclEnv))
   [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      [GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))])
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
forall a b. (a -> b) -> a -> b
$ (LocatedA (HsCmd GhcTc) -> ZonkTcM (LocatedA (HsCmd GhcTc)))
-> [LStmt GhcTc (LocatedA (HsCmd GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (HsCmd GhcTc))]
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
LocatedA (HsCmd GhcTc) -> ZonkTcM (LocatedA (HsCmd GhcTc))
zonkLCmd [LStmt GhcTc (LocatedA (HsCmd GhcTc))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
stmts
       new_ty <- zonkTcTypeToTypeX ty
       return (HsCmdDo new_ty (L l new_stmts))



zonkCmdTop :: LHsCmdTop GhcTc -> ZonkTcM (LHsCmdTop GhcTc)
zonkCmdTop :: LHsCmdTop GhcTc -> ZonkTcM (LHsCmdTop GhcTc)
zonkCmdTop LHsCmdTop GhcTc
cmd = (HsCmdTop GhcTc -> ZonkTcM (HsCmdTop GhcTc))
-> GenLocated EpAnnCO (HsCmdTop GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated EpAnnCO (HsCmdTop GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA (HsCmdTop GhcTc -> ZonkTcM (HsCmdTop GhcTc)
zonk_cmd_top) LHsCmdTop GhcTc
GenLocated EpAnnCO (HsCmdTop GhcTc)
cmd

zonk_cmd_top :: HsCmdTop GhcTc -> ZonkTcM (HsCmdTop GhcTc)
zonk_cmd_top :: HsCmdTop GhcTc -> ZonkTcM (HsCmdTop GhcTc)
zonk_cmd_top (HsCmdTop (CmdTopTc Kind
stack_tys Kind
ty CmdSyntaxTable GhcTc
ids) LHsCmd GhcTc
cmd)
  = do new_cmd <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
cmd
       new_stack_tys <- zonkTcTypeToTypeX stack_tys
       new_ty <- zonkTcTypeToTypeX ty
       new_ids <- mapSndM zonkExpr ids

       massert (definitelyLiftedType new_stack_tys)
         -- desugarer assumes that this is not representation-polymorphic...
         -- but indeed it should always be lifted due to the typing
         -- rules for arrows

       return (HsCmdTop (CmdTopTc new_stack_tys new_ty new_ids) new_cmd)

-------------------------------------------------------------------------
zonkCoFn :: HsWrapper -> ZonkBndrTcM HsWrapper
zonkCoFn :: HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
WpHole   = HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return HsWrapper
WpHole
zonkCoFn (WpCompose HsWrapper
c1 HsWrapper
c2) = do { c1' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
c1
                                ; c2' <- zonkCoFn c2
                                ; return (WpCompose c1' c2') }
zonkCoFn (WpFun HsWrapper
c1 HsWrapper
c2 Scaled Kind
t1)  = do { c1' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
c1
                                ; c2' <- zonkCoFn c2
                                ; t1' <- noBinders $ zonkScaledTcTypeToTypeX t1
                                ; return (WpFun c1' c2' t1') }
zonkCoFn (WpCast Coercion
co)   = Coercion -> HsWrapper
WpCast  (Coercion -> HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Coercion
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkTcM Coercion
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Coercion
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (Coercion -> ZonkTcM Coercion
zonkCoToCo Coercion
co)
zonkCoFn (WpEvLam Id
ev)  = Id -> HsWrapper
WpEvLam (Id -> HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkEvBndrX Id
ev
zonkCoFn (WpEvApp EvTerm
arg) = EvTerm -> HsWrapper
WpEvApp (EvTerm -> HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm EvTerm
arg)
zonkCoFn (WpTyLam Id
tv)  = Bool
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isImmutableTyVar Id
tv) (ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall a b. (a -> b) -> a -> b
$
                         Id -> HsWrapper
WpTyLam (Id -> HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX Id
tv
zonkCoFn (WpTyApp Kind
ty)  = Kind -> HsWrapper
WpTyApp (Kind -> HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty)
zonkCoFn (WpLet TcEvBinds
bs)    = TcEvBinds -> HsWrapper
WpLet   (TcEvBinds -> HsWrapper)
-> ZonkBndrTcM TcEvBinds
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds TcEvBinds
bs
zonkCoFn (WpMultCoercion Coercion
co) = Coercion -> HsWrapper
WpMultCoercion (Coercion -> HsWrapper)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Coercion
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkTcM Coercion
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Coercion
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (Coercion -> ZonkTcM Coercion
zonkCoToCo Coercion
co)

-------------------------------------------------------------------------
zonkOverLit :: HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
zonkOverLit :: HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
zonkOverLit lit :: HsOverLit GhcTc
lit@(OverLit {ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_ext = x :: XOverLit GhcTc
x@OverLitTc { ol_witness :: OverLitTc -> HsExpr GhcTc
ol_witness = HsExpr GhcTc
e, ol_type :: OverLitTc -> Kind
ol_type = Kind
ty } })
  = do  { ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
        ; e' <- zonkExpr e
        ; return (lit { ol_ext = x { ol_witness = e'
                                   , ol_type = ty' } }) }

-------------------------------------------------------------------------
zonkBracket :: HsBracketTc -> ZonkTcM HsBracketTc
zonkBracket :: HsBracketTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsBracketTc
zonkBracket (HsBracketTc HsQuote GhcRn
hsb_thing Kind
ty Maybe QuoteWrapper
wrap [PendingTcSplice]
bs)
  = do wrap' <- (QuoteWrapper
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) QuoteWrapper)
-> Maybe QuoteWrapper
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe QuoteWrapper)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse QuoteWrapper -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) QuoteWrapper
zonkQuoteWrap Maybe QuoteWrapper
wrap
       bs' <- mapM zonk_b bs
       new_ty <- zonkTcTypeToTypeX ty
       return (HsBracketTc hsb_thing new_ty wrap' bs')
  where
    zonkQuoteWrap :: QuoteWrapper -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) QuoteWrapper
zonkQuoteWrap (QuoteWrapper Id
ev Kind
ty) = do
        ev' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
ev
        ty' <- zonkTcTypeToTypeX ty
        return (QuoteWrapper ev' ty')

    zonk_b :: PendingTcSplice
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) PendingTcSplice
zonk_b (PendingTcSplice Name
n LHsExpr GhcTc
e) = do e' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
                                      return (PendingTcSplice n e')

-------------------------------------------------------------------------
zonkArithSeq :: ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)

zonkArithSeq :: ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
zonkArithSeq (From LHsExpr GhcTc
e)
  = do new_e <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       return (From new_e)

zonkArithSeq (FromThen LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       new_e2 <- zonkLExpr e2
       return (FromThen new_e1 new_e2)

zonkArithSeq (FromTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       new_e2 <- zonkLExpr e2
       return (FromTo new_e1 new_e2)

zonkArithSeq (FromThenTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       new_e2 <- zonkLExpr e2
       new_e3 <- zonkLExpr e3
       return (FromThenTo new_e1 new_e2 new_e3)

-------------------------------------------------------------------------
zonkStmts :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
          => (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
          -> [LStmt GhcTc (LocatedA (body GhcTc))]
          -> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts :: forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
_ []     = [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
zonkStmts LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (LStmt GhcTc (LocatedA (body GhcTc))
s:[LStmt GhcTc (LocatedA (body GhcTc))]
ss) = do { s'  <- (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
 -> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkBndrTcM
     (GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
forall a b ann.
(a -> ZonkBndrTcM b)
-> GenLocated (EpAnn ann) a
-> ZonkBndrTcM (GenLocated (EpAnn ann) b)
wrapLocZonkBndrMA ((LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody) LStmt GhcTc (LocatedA (body GhcTc))
GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s
                            ; ss' <- zonkStmts zBody ss
                            ; return (s' : ss') }

zonkStmt :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
         => (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
         -> Stmt GhcTc (LocatedA (body GhcTc))
         -> ZonkBndrTcM (Stmt GhcTc (LocatedA (body GhcTc)))
zonkStmt :: forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
_ (ParStmt XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
bind_ty [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs HsExpr GhcTc
mzip_op SyntaxExpr GhcTc
bind_op)
  = do { new_bind_op <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
bind_op
       ; new_bind_ty <- noBinders $ zonkTcTypeToTypeX bind_ty
       ; new_stmts_w_bndrs <- noBinders $ mapM zonk_branch stmts_w_bndrs

       -- Add in the binders after we're done with all the branches.
       ; let new_binders = [ Id
b | ParStmtBlock XParStmtBlock GhcTc GhcTc
_ [GuardLStmt GhcTc]
_ [IdP GhcTc]
bs SyntaxExpr GhcTc
_ <- [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs
                           , Id
b <- [IdP GhcTc]
[Id]
bs ]
       ; extendIdZonkEnvRec new_binders
       ; new_mzip <- noBinders $ zonkExpr mzip_op
       ; return (ParStmt new_bind_ty new_stmts_w_bndrs new_mzip new_bind_op)}
  where
    zonk_branch :: ParStmtBlock GhcTc GhcTc
                -> ZonkTcM (ParStmtBlock GhcTc GhcTc)
    zonk_branch :: ParStmtBlock GhcTc GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc)
zonk_branch (ParStmtBlock XParStmtBlock GhcTc GhcTc
x [GuardLStmt GhcTc]
stmts [IdP GhcTc]
bndrs SyntaxExpr GhcTc
return_op)
       = ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> forall r.
   ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ((LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
stmts) (([GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc))
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ \ [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts ->
         ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> forall r.
   (SyntaxExprTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
return_op)  ((SyntaxExprTc
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc))
-> (SyntaxExprTc
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ \ SyntaxExprTc
new_return ->
         do { new_bndrs <- [Id] -> ZonkTcM [Id]
zonkIdOccs [IdP GhcTc]
[Id]
bndrs
            ; return (ParStmtBlock x new_stmts new_bndrs new_return) }

zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
segStmts, recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_later_ids = [IdP GhcTc]
lvs
                        , recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids = [IdP GhcTc]
rvs
                        , recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn = SyntaxExpr GhcTc
ret_id, recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn = SyntaxExpr GhcTc
mfix_id
                        , recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_bind_fn = SyntaxExpr GhcTc
bind_id
                        , recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_ext =
                                   RecStmtTc { recS_bind_ty :: RecStmtTc -> Kind
recS_bind_ty = Kind
bind_ty
                                             , recS_later_rets :: RecStmtTc -> [HsExpr GhcTc]
recS_later_rets = [HsExpr GhcTc]
later_rets
                                             , recS_rec_rets :: RecStmtTc -> [HsExpr GhcTc]
recS_rec_rets = [HsExpr GhcTc]
rec_rets
                                             , recS_ret_ty :: RecStmtTc -> Kind
recS_ret_ty = Kind
ret_ty} })
  = do { new_bind_id <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
bind_id
       ; new_mfix_id <- zonkSyntaxExpr mfix_id
       ; new_ret_id  <- zonkSyntaxExpr ret_id
       ; new_bind_ty <- noBinders $ zonkTcTypeToTypeX bind_ty
       ; new_rvs     <- noBinders $ zonkIdBndrs rvs
       ; new_lvs     <- noBinders $ zonkIdBndrs lvs
       ; new_ret_ty  <- noBinders $ zonkTcTypeToTypeX ret_ty

    -- Zonk the ret-expressions in an environment that
    -- has the polymorphic bindings
       ; rec_stmt <- noBinders $ don'tBind $
          do { extendIdZonkEnvRec new_rvs
             ; new_segStmts   <- zonkStmts zBody segStmts
             ; new_later_rets <- noBinders $ mapM zonkExpr later_rets
             ; new_rec_rets   <- noBinders $ mapM zonkExpr rec_rets
             ; return $
               RecStmt { recS_stmts = noLocA 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_ext = RecStmtTc
                           { recS_bind_ty = new_bind_ty
                           , recS_later_rets = new_later_rets
                           , recS_rec_rets = new_rec_rets
                           , recS_ret_ty = new_ret_ty } } }

    -- Only the lvs are needed
       ; extendIdZonkEnvRec new_lvs
       ; return rec_stmt }

zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (BodyStmt XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
ty LocatedA (body GhcTc)
body SyntaxExpr GhcTc
then_op SyntaxExpr GhcTc
guard_op)
  = do { new_then_op  <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
then_op
       ; new_guard_op <- zonkSyntaxExpr guard_op
       ; new_body     <- noBinders $ zBody body
       ; new_ty       <- noBinders $ zonkTcTypeToTypeX  ty
       ; return $ BodyStmt new_ty new_body new_then_op new_guard_op }

zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (LastStmt XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
x LocatedA (body GhcTc)
body Maybe Bool
noret SyntaxExpr GhcTc
ret_op)
  = ZonkT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT
   (IOEnv (Env TcGblEnv TcLclEnv))
   (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> forall r.
   (SyntaxExprTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
ret_op) ((SyntaxExprTc
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> (SyntaxExprTc
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ \ SyntaxExprTc
new_ret ->
    do { new_body <- LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody LocatedA (body GhcTc)
body
       ; return $ LastStmt x new_body noret new_ret }

zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
_ (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [GuardLStmt GhcTc]
stmts, trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_bndrs = [(IdP GhcTc, IdP GhcTc)]
binderMap
                      , trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_by = Maybe (LHsExpr GhcTc)
by, trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_form = TransForm
form, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_using = LHsExpr GhcTc
using
                      , trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret = SyntaxExpr GhcTc
return_op, trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind = SyntaxExpr GhcTc
bind_op
                      , trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_ext = XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
bind_arg_ty
                      , trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap = HsExpr GhcTc
liftM_op })
  = do { bind_op'     <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
bind_op
       ; bind_arg_ty' <- noBinders $ zonkTcTypeToTypeX bind_arg_ty
       ; stmts'       <- zonkStmts zonkLExpr stmts
       ; by'          <- noBinders $ traverse zonkLExpr by
       ; using'       <- noBinders $ zonkLExpr using
       ; return_op'   <- zonkSyntaxExpr return_op
       ; liftM_op'    <- noBinders $ zonkExpr liftM_op
       ; binderMap'   <- mapM zonkBinderMapEntry binderMap
       ; return (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_ext = bind_arg_ty'
                           , trS_fmap = liftM_op' }) }
  where
    zonkBinderMapEntry :: (Id, Id) -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, Id)
zonkBinderMapEntry (Id
oldBinder, Id
newBinder) = do
        oldBinder' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
oldBinder
        newBinder' <- zonkIdBndrX newBinder
        return (oldBinder', newBinder')

zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
_ (LetStmt XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
x HsLocalBinds GhcTc
binds)
  = XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> HsLocalBinds GhcTc -> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
x (HsLocalBinds GhcTc -> StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkBndrTcM (HsLocalBinds GhcTc)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
zonkLocalBinds HsLocalBinds GhcTc
binds

zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody (BindStmt XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
xbs LPat GhcTc
pat LocatedA (body GhcTc)
body)
  = do  { new_bind    <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr (XBindStmtTc -> SyntaxExpr GhcTc
xbstc_bindOp XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs)
        ; new_w       <- noBinders $ zonkTcTypeToTypeX (xbstc_boundResultMult xbs)
        ; new_bind_ty <- noBinders $ zonkTcTypeToTypeX (xbstc_boundResultType xbs)
        ; new_body    <- noBinders $ zBody body
        ; new_fail <- case xbstc_failOp xbs of
            Maybe (SyntaxExpr GhcTc)
Nothing      -> Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SyntaxExprTc
forall a. Maybe a
Nothing
            Just SyntaxExpr GhcTc
fail_op -> (SyntaxExprTc -> Maybe SyntaxExprTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall a b.
(a -> b)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just (ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc))
-> (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
    -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall a b. (a -> b) -> a -> b
$ ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
forall (m :: * -> *) a. Monad m => ZonkBndrT m a -> ZonkT m a
don'tBind (SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
fail_op)

        ; new_pat     <- zonkPat pat
        ; return $
            BindStmt
            (XBindStmtTc
              { xbstc_bindOp = new_bind
              , xbstc_boundResultType = new_bind_ty
              , xbstc_boundResultMult = new_w
              , xbstc_failOp = new_fail
              })
            new_pat new_body }

-- Scopes: join > ops (in reverse order) > pats (in forward order)
--              > rest of stmts
zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
_zBody (XStmtLR (ApplicativeStmt XApplicativeStmt GhcTc GhcTc
body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args Maybe (SyntaxExpr GhcTc)
mb_join))
  = do  { new_mb_join   <- Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
zonk_join Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
mb_join
        ; new_args      <- zonk_args args
        ; new_body_ty   <- noBinders $ zonkTcTypeToTypeX body_ty
        ; return $ XStmtLR $ ApplicativeStmt new_body_ty new_args new_mb_join }
  where
    zonk_join :: Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
zonk_join Maybe SyntaxExprTc
Nothing  = Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SyntaxExprTc
forall a. Maybe a
Nothing
    zonk_join (Just SyntaxExprTc
j) = SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just (SyntaxExprTc -> Maybe SyntaxExprTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
SyntaxExprTc
j

    get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
    get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
get_pat (SyntaxExpr GhcTc
_, ApplicativeArgOne XApplicativeArgOne GhcTc
_ LPat GhcTc
pat LHsExpr GhcTc
_ Bool
_) = LPat GhcTc
pat
    get_pat (SyntaxExpr GhcTc
_, ApplicativeArgMany XApplicativeArgMany GhcTc
_ [GuardLStmt GhcTc]
_ HsExpr GhcTc
_ LPat GhcTc
pat HsDoFlavour
_) = LPat GhcTc
pat

    replace_pat :: LPat GhcTc
                -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
                -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
    replace_pat :: LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
replace_pat LPat GhcTc
pat (SyntaxExpr GhcTc
op, ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
_ LHsExpr GhcTc
a Bool
isBody)
      = (SyntaxExpr GhcTc
op, XApplicativeArgOne GhcTc
-> LPat GhcTc -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
pat LHsExpr GhcTc
a Bool
isBody)
    replace_pat LPat GhcTc
pat (SyntaxExpr GhcTc
op, ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
a HsExpr GhcTc
b LPat GhcTc
_ HsDoFlavour
c)
      = (SyntaxExpr GhcTc
op, XApplicativeArgMany GhcTc
-> [GuardLStmt GhcTc]
-> HsExpr GhcTc
-> LPat GhcTc
-> HsDoFlavour
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL]
-> HsExpr idL
-> LPat idL
-> HsDoFlavour
-> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
a HsExpr GhcTc
b LPat GhcTc
pat HsDoFlavour
c)

    zonk_args :: [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
zonk_args [(SyntaxExprTc, ApplicativeArg GhcTc)]
args
      = do { new_args_rev <- [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
zonk_args_rev ([(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
           ; new_pats     <- zonkPats (map get_pat args)
           ; return $ zipWithEqual "zonkStmt" replace_pat
                        new_pats (reverse new_args_rev) }

     -- these need to go backward, because if any operators are higher-rank,
     -- later operators may introduce skolems that are in scope for earlier
     -- arguments
    zonk_args_rev :: [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
zonk_args_rev ((SyntaxExprTc
op, ApplicativeArg GhcTc
arg) : [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
      = do { new_op   <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
SyntaxExprTc
op
           ; new_arg  <- noBinders $ zonk_arg arg
           ; new_args <- zonk_args_rev args
           ; return $ (new_op, new_arg) : new_args }
    zonk_args_rev [] = [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []

    zonk_arg :: ApplicativeArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
zonk_arg (ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
pat LHsExpr GhcTc
expr Bool
isBody)
      = do { new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
           ; new_fail <- forM fail_op $ don'tBind . zonkSyntaxExpr
           ; return (ApplicativeArgOne new_fail pat new_expr isBody) }
    zonk_arg (ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
stmts HsExpr GhcTc
ret LPat GhcTc
pat HsDoFlavour
ctxt)
      = ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> forall r.
   ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ((LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmt GhcTc (LocatedA (body GhcTc))]
zonkStmts LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
stmts) (([GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc))
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc))
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
forall a b. (a -> b) -> a -> b
$ \ [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts ->
        do { new_ret <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
ret
           ; return (ApplicativeArgMany x new_stmts new_ret pat ctxt) }

-------------------------------------------------------------------------
zonkRecFields :: HsRecordBinds GhcTc -> ZonkTcM (HsRecordBinds GhcTc)
zonkRecFields :: HsRecordBinds GhcTc -> ZonkTcM (HsRecordBinds GhcTc)
zonkRecFields (HsRecFields XHsRecFields GhcTc
x [LHsRecField GhcTc (LHsExpr GhcTc)]
flds Maybe (XRec GhcTc RecFieldsDotDot)
dd)
  = do  { flds' <- (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
      (LocatedA (HsExpr GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
            (LocatedA (HsExpr GhcTc)))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (LocatedA (HsExpr GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc))))
forall {l} {ann}.
GenLocated
  l
  (HsFieldBind
     (GenLocated (EpAnn ann) (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        l
        (HsFieldBind
           (GenLocated (EpAnn ann) (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc))))
zonk_rbind [LHsRecField GhcTc (LHsExpr GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
      (LocatedA (HsExpr GhcTc)))]
flds
        ; return (HsRecFields x flds' dd) }
  where
    zonk_rbind :: GenLocated
  l
  (HsFieldBind
     (GenLocated (EpAnn ann) (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        l
        (HsFieldBind
           (GenLocated (EpAnn ann) (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc))))
zonk_rbind (L l
l HsFieldBind
  (GenLocated (EpAnn ann) (FieldOcc GhcTc)) (LocatedA (HsExpr GhcTc))
fld)
      = do { new_id   <- (FieldOcc GhcTc -> ZonkTcM (FieldOcc GhcTc))
-> GenLocated (EpAnn ann) (FieldOcc GhcTc)
-> ZonkTcM (GenLocated (EpAnn ann) (FieldOcc GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA FieldOcc GhcTc -> ZonkTcM (FieldOcc GhcTc)
zonkFieldOcc (HsFieldBind
  (GenLocated (EpAnn ann) (FieldOcc GhcTc)) (LocatedA (HsExpr GhcTc))
-> GenLocated (EpAnn ann) (FieldOcc GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS HsFieldBind
  (GenLocated (EpAnn ann) (FieldOcc GhcTc)) (LocatedA (HsExpr GhcTc))
fld)
           ; new_expr <- zonkLExpr (hfbRHS fld)
           ; return (L l (fld { hfbLHS = new_id
                              , hfbRHS = new_expr })) }

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-Pats]{Patterns}
*                                                                      *
************************************************************************
-}


zonkPat :: LPat GhcTc -> ZonkBndrTcM (LPat GhcTc)
-- 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 :: LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat = (Pat GhcTc -> ZonkBndrTcM (Pat GhcTc))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
forall a b ann.
(a -> ZonkBndrTcM b)
-> GenLocated (EpAnn ann) a
-> ZonkBndrTcM (GenLocated (EpAnn ann) b)
wrapLocZonkBndrMA Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
zonk_pat LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat

zonk_pat :: Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
zonk_pat :: Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
zonk_pat (ParPat XParPat GhcTc
x LPat GhcTc
p)
  = do  { p' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
p
        ; return (ParPat x p') }

zonk_pat (WildPat XWildPat GhcTc
ty)
  = do  { ty' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XWildPat GhcTc
Kind
ty
        ; return (WildPat ty') }

zonk_pat (VarPat XVarPat GhcTc
x (L SrcSpanAnnN
l Id
v))
  = do  { v' <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
v
        ; return (VarPat x (L l v')) }

zonk_pat (LazyPat XLazyPat GhcTc
x LPat GhcTc
pat)
  = do  { pat' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; return (LazyPat x pat') }

zonk_pat (BangPat XBangPat GhcTc
x LPat GhcTc
pat)
  = do  { pat' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; return (BangPat x pat') }

zonk_pat (AsPat XAsPat GhcTc
x (L SrcSpanAnnN
loc Id
v) LPat GhcTc
pat)
  = do  { v'   <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
v
        ; pat' <- zonkPat pat
        ; return (AsPat x (L loc v') pat') }

zonk_pat (ViewPat XViewPat GhcTc
ty LHsExpr GhcTc
expr LPat GhcTc
pat)
  = do  { expr' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
        ; pat'  <- zonkPat pat
        ; ty'   <- noBinders $ zonkTcTypeToTypeX ty
        ; return (ViewPat ty' expr' pat') }

zonk_pat (ListPat XListPat GhcTc
ty [LPat GhcTc]
pats)
  = do  { ty'   <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XListPat GhcTc
Kind
ty
        ; pats' <- zonkPats pats
        ; return (ListPat ty' pats') }

zonk_pat (TuplePat XTuplePat GhcTc
tys [LPat GhcTc]
pats Boxity
boxed)
  = do  { tys' <- ZonkTcM [Kind] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM [Kind]
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind])
-> ZonkTcM [Kind]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind]
forall a b. (a -> b) -> a -> b
$ (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> [Kind] -> ZonkTcM [Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX [Kind]
XTuplePat GhcTc
tys
        ; pats' <- zonkPats pats
        ; return (TuplePat tys' pats' boxed) }

zonk_pat (OrPat XOrPat GhcTc
ty NonEmpty (LPat GhcTc)
pats)
  = do  { ty' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XOrPat GhcTc
Kind
ty
        ; pats' <- zonkPats pats
        ; return (OrPat ty' pats') }

zonk_pat (SumPat XSumPat GhcTc
tys LPat GhcTc
pat ConTag
alt ConTag
arity )
  = do  { tys' <- ZonkTcM [Kind] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM [Kind]
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind])
-> ZonkTcM [Kind]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind]
forall a b. (a -> b) -> a -> b
$ (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> [Kind] -> ZonkTcM [Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX [Kind]
XSumPat GhcTc
tys
        ; pat' <- zonkPat pat
        ; return (SumPat tys' pat' alt arity) }

zonk_pat p :: Pat GhcTc
p@(ConPat { pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails GhcTc
args
                   , pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = p' :: XConPat GhcTc
p'@(ConPatTc
                     { cpt_tvs :: ConPatTc -> [Id]
cpt_tvs = [Id]
tyvars
                     , cpt_dicts :: ConPatTc -> [Id]
cpt_dicts = [Id]
evs
                     , cpt_binds :: ConPatTc -> TcEvBinds
cpt_binds = TcEvBinds
binds
                     , cpt_wrap :: ConPatTc -> HsWrapper
cpt_wrap = HsWrapper
wrapper
                     , cpt_arg_tys :: ConPatTc -> [Kind]
cpt_arg_tys = [Kind]
tys
                     })
                   })
  = Bool -> ZonkBndrTcM (Pat GhcTc) -> ZonkBndrTcM (Pat GhcTc)
forall a. HasCallStack => Bool -> a -> a
assert ((Id -> Bool) -> [Id] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Id -> Bool
isImmutableTyVar [Id]
tyvars) (ZonkBndrTcM (Pat GhcTc) -> ZonkBndrTcM (Pat GhcTc))
-> ZonkBndrTcM (Pat GhcTc) -> ZonkBndrTcM (Pat GhcTc)
forall a b. (a -> b) -> a -> b
$
    do  { new_tys     <- ZonkTcM [Kind] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM [Kind]
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind])
-> ZonkTcM [Kind]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Kind]
forall a b. (a -> b) -> a -> b
$ (Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> [Kind] -> ZonkTcM [Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX [Kind]
tys
        ; new_tyvars  <- zonkTyBndrsX tyvars
          -- Must zonk the existential variables, because their
          -- /kind/ need potential zonking.
          -- cf typecheck/should_compile/tc221.hs
        ; new_evs     <- zonkEvBndrsX evs
        ; new_binds   <- zonkTcEvBinds binds
        ; new_wrapper <- zonkCoFn wrapper
        ; new_args    <- zonkConStuff args
        ; pure $ p
                 { pat_args = new_args
                 , pat_con_ext = p'
                   { cpt_arg_tys = new_tys
                   , cpt_tvs = new_tyvars
                   , cpt_dicts = new_evs
                   , cpt_binds = new_binds
                   , cpt_wrap = new_wrapper
                   }
                 }
        }

zonk_pat (LitPat XLitPat GhcTc
x HsLit GhcTc
lit) = Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitPat GhcTc -> HsLit GhcTc -> Pat GhcTc
forall p. XLitPat p -> HsLit p -> Pat p
LitPat XLitPat GhcTc
x HsLit GhcTc
lit)

zonk_pat (SigPat XSigPat GhcTc
ty LPat GhcTc
pat HsPatSigType (NoGhcTc GhcTc)
hs_ty)
  = do  { ty' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XSigPat GhcTc
Kind
ty
        ; pat' <- zonkPat pat
        ; return (SigPat ty' pat' hs_ty) }

zonk_pat (NPat XNPat GhcTc
ty (L EpAnnCO
l HsOverLit GhcTc
lit) Maybe (SyntaxExpr GhcTc)
mb_neg SyntaxExpr GhcTc
eq_expr)
  =  do { eq_expr' <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
eq_expr
        ; mb_neg' <- case mb_neg of
            Maybe (SyntaxExpr GhcTc)
Nothing -> Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SyntaxExprTc
forall a. Maybe a
Nothing
            Just SyntaxExpr GhcTc
n  -> SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just (SyntaxExprTc -> Maybe SyntaxExprTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
n
        ; noBinders $
     do { lit' <- zonkOverLit lit
        ; ty'  <- zonkTcTypeToTypeX ty
        ; return (NPat ty' (L l lit') mb_neg' eq_expr') } }

zonk_pat (NPlusKPat XNPlusKPat GhcTc
ty (L SrcSpanAnnN
loc Id
n) (L EpAnnCO
l HsOverLit GhcTc
lit1) HsOverLit GhcTc
lit2 SyntaxExpr GhcTc
e1 SyntaxExpr GhcTc
e2)
  = do  { e1' <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr  SyntaxExpr GhcTc
e1
        ; e2' <- zonkSyntaxExpr e2
        ; lit1' <- noBinders $ zonkOverLit lit1
        ; lit2' <- noBinders $ zonkOverLit lit2
        ; ty'   <- noBinders $ zonkTcTypeToTypeX ty
        ; n'    <- zonkIdBndrX n
        ; return (NPlusKPat ty' (L loc n') (L l lit1') lit2' e1' e2') }

zonk_pat (EmbTyPat XEmbTyPat GhcTc
ty HsTyPat (NoGhcTc GhcTc)
tp)
  = do { ty' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XEmbTyPat GhcTc
Kind
ty
       ; return (EmbTyPat ty' tp) }

zonk_pat (InvisPat XInvisPat GhcTc
ty HsTyPat (NoGhcTc GhcTc)
tp)
  = do { ty' <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XInvisPat GhcTc
Kind
ty
       ; return (InvisPat ty' tp) }

zonk_pat (XPat XXPat GhcTc
ext) = case XXPat GhcTc
ext of
  { ExpansionPat Pat GhcRn
orig Pat GhcTc
pat->
    do { pat' <- Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
zonk_pat Pat GhcTc
pat
       ; return $ XPat $ ExpansionPat orig pat' }
  ; CoPat HsWrapper
co_fn Pat GhcTc
pat Kind
ty ->
    do { co_fn' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
co_fn
       ; pat'   <- zonkPat (noLocA pat)
       ; ty'    <- noBinders $ zonkTcTypeToTypeX ty
       ; return (XPat $ CoPat co_fn' (unLoc pat') ty')
       } }

zonk_pat Pat GhcTc
pat = String -> SDoc -> ZonkBndrTcM (Pat GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonk_pat" (Pat GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcTc
pat)

---------------------------
zonkConStuff :: HsConPatDetails GhcTc
             -> ZonkBndrTcM (HsConPatDetails GhcTc)
zonkConStuff :: HsConPatDetails GhcTc -> ZonkBndrTcM (HsConPatDetails GhcTc)
zonkConStuff (PrefixCon [HsConPatTyArg (NoGhcTc GhcTc)]
tyargs [LPat GhcTc]
pats)
  = do  { pats' <- [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
forall (f :: * -> *).
Traversable f =>
f (LPat GhcTc) -> ZonkBndrTcM (f (LPat GhcTc))
zonkPats [LPat GhcTc]
pats
        ; return (PrefixCon tyargs pats') }

zonkConStuff (InfixCon LPat GhcTc
p1 LPat GhcTc
p2)
  = do  { p1' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
p1
        ; p2' <- zonkPat p2
        ; return (InfixCon p1' p2') }

zonkConStuff (RecCon (HsRecFields XHsRecFields GhcTc
x [LHsRecField GhcTc (LPat GhcTc)]
rpats Maybe (XRec GhcTc RecFieldsDotDot)
dd))
  = do  { pats' <- [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
forall (f :: * -> *).
Traversable f =>
f (LPat GhcTc) -> ZonkBndrTcM (f (LPat GhcTc))
zonkPats ((GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS (HsFieldBind
   (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
   (GenLocated SrcSpanAnnA (Pat GhcTc))
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
forall l e. GenLocated l e -> e
unLoc) [LHsRecField GhcTc (LPat GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats)
        ; x' <- mapM (noBinders . zonkCoToCo) x
        ; let rpats' = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
 -> GenLocated SrcSpanAnnA (Pat GhcTc)
 -> GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(L SrcSpanAnnA
l HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
rp) GenLocated SrcSpanAnnA (Pat GhcTc)
p' ->
                                  SrcSpanAnnA
-> HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
rp { hfbRHS = p' }))
                               [LHsRecField GhcTc (LPat GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats'
        ; return (RecCon (HsRecFields x' rpats' dd)) }
        -- Field selectors have declared types; hence no zonking

---------------------------
zonkPats :: Traversable f => f (LPat GhcTc) -> ZonkBndrTcM (f (LPat GhcTc))
zonkPats :: forall (f :: * -> *).
Traversable f =>
f (LPat GhcTc) -> ZonkBndrTcM (f (LPat GhcTc))
zonkPats = (GenLocated SrcSpanAnnA (Pat GhcTc)
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> f (GenLocated SrcSpanAnnA (Pat GhcTc))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (f (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
GenLocated SrcSpanAnnA (Pat GhcTc)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
zonkPat
{-# SPECIALISE zonkPats :: [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc] #-}
{-# SPECIALISE zonkPats :: NonEmpty (LPat GhcTc) -> ZonkBndrTcM (NonEmpty (LPat GhcTc)) #-}

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-Foreign]{Foreign exports}
*                                                                      *
************************************************************************
-}

zonkForeignExports :: [LForeignDecl GhcTc]
                   -> ZonkTcM [LForeignDecl GhcTc]
zonkForeignExports :: [LForeignDecl GhcTc] -> ZonkTcM [LForeignDecl GhcTc]
zonkForeignExports [LForeignDecl GhcTc]
ls = (GenLocated SrcSpanAnnA (ForeignDecl GhcTc)
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (ForeignDecl GhcTc)))
-> [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ForeignDecl GhcTc -> ZonkTcM (ForeignDecl GhcTc))
-> GenLocated SrcSpanAnnA (ForeignDecl GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (ForeignDecl GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA ForeignDecl GhcTc -> ZonkTcM (ForeignDecl GhcTc)
zonkForeignExport) [LForeignDecl GhcTc]
[GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
ls

zonkForeignExport :: ForeignDecl GhcTc -> ZonkTcM (ForeignDecl GhcTc)
zonkForeignExport :: ForeignDecl GhcTc -> ZonkTcM (ForeignDecl GhcTc)
zonkForeignExport (ForeignExport { fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name = LIdP GhcTc
i, fd_e_ext :: forall pass. ForeignDecl pass -> XForeignExport pass
fd_e_ext = XForeignExport GhcTc
co
                                 , fd_fe :: forall pass. ForeignDecl pass -> ForeignExport pass
fd_fe = ForeignExport GhcTc
spec })
  = do { i' <- GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
zonkLIdOcc LIdP GhcTc
GenLocated SrcSpanAnnN Id
i
       ; return (ForeignExport { fd_name = i'
                               , fd_sig_ty = undefined, fd_e_ext = co
                               , fd_fe = spec }) }
zonkForeignExport ForeignDecl GhcTc
for_imp
  = ForeignDecl GhcTc -> ZonkTcM (ForeignDecl GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignDecl GhcTc
for_imp     -- Foreign imports don't need zonking

zonkRules :: [LRuleDecl GhcTc] -> ZonkTcM [LRuleDecl GhcTc]
zonkRules :: [LRuleDecl GhcTc] -> ZonkTcM [LRuleDecl GhcTc]
zonkRules [LRuleDecl GhcTc]
rs = (GenLocated SrcSpanAnnA (RuleDecl GhcTc)
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (RuleDecl GhcTc)))
-> [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc))
-> GenLocated SrcSpanAnnA (RuleDecl GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (RuleDecl GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (EpAnn ann) a -> ZonkTcM (GenLocated (EpAnn ann) b)
wrapLocZonkMA RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc)
zonkRule) [LRuleDecl GhcTc]
[GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
rs

zonkRule :: RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc)
zonkRule :: RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc)
zonkRule rule :: RuleDecl GhcTc
rule@(HsRule { rd_tmvs :: forall pass. RuleDecl pass -> [LRuleBndr pass]
rd_tmvs = [LRuleBndr GhcTc]
tm_bndrs{-::[RuleBndr TcId]-}
                      , rd_lhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_lhs = LHsExpr GhcTc
lhs
                      , rd_rhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_rhs = LHsExpr GhcTc
rhs })
  = ZonkBndrT
  (IOEnv (Env TcGblEnv TcLclEnv))
  [GenLocated EpAnnCO (RuleBndr GhcTc)]
-> forall r.
   ([GenLocated EpAnnCO (RuleBndr GhcTc)]
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ((GenLocated EpAnnCO (RuleBndr GhcTc)
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated EpAnnCO (RuleBndr GhcTc)))
-> [GenLocated EpAnnCO (RuleBndr GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated EpAnnCO (RuleBndr GhcTc)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse LRuleBndr GhcTc -> ZonkBndrTcM (LRuleBndr GhcTc)
GenLocated EpAnnCO (RuleBndr GhcTc)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated EpAnnCO (RuleBndr GhcTc))
zonk_tm_bndr [LRuleBndr GhcTc]
[GenLocated EpAnnCO (RuleBndr GhcTc)]
tm_bndrs) (([GenLocated EpAnnCO (RuleBndr GhcTc)]
  -> ZonkTcM (RuleDecl GhcTc))
 -> ZonkTcM (RuleDecl GhcTc))
-> ([GenLocated EpAnnCO (RuleBndr GhcTc)]
    -> ZonkTcM (RuleDecl GhcTc))
-> ZonkTcM (RuleDecl GhcTc)
forall a b. (a -> b) -> a -> b
$ \ [GenLocated EpAnnCO (RuleBndr GhcTc)]
new_tm_bndrs ->
    do { -- See Note [Zonking the LHS of a RULE]
       ; new_lhs <- ZonkFlexi
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
forall (m :: * -> *) a. ZonkFlexi -> ZonkT m a -> ZonkT m a
setZonkType ZonkFlexi
SkolemiseFlexi (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
lhs
       ; new_rhs <-                              zonkLExpr rhs
       ; return $ rule { rd_tmvs = new_tm_bndrs
                       , rd_lhs  = new_lhs
                       , rd_rhs  = new_rhs } }
  where
   zonk_tm_bndr :: LRuleBndr GhcTc -> ZonkBndrTcM (LRuleBndr GhcTc)
   zonk_tm_bndr :: LRuleBndr GhcTc -> ZonkBndrTcM (LRuleBndr GhcTc)
zonk_tm_bndr (L EpAnnCO
l (RuleBndr XCRuleBndr GhcTc
x (L SrcSpanAnnN
loc Id
v)))
      = do { v' <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonk_it Id
v
           ; return (L l (RuleBndr x (L loc v'))) }
   zonk_tm_bndr (L EpAnnCO
_ (RuleBndrSig {})) = String
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated EpAnnCO (RuleBndr GhcTc))
forall a. HasCallStack => String -> a
panic String
"zonk_tm_bndr RuleBndrSig"

   zonk_it :: Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonk_it Id
v
     | Id -> Bool
isId Id
v     = Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
v
     | Bool
otherwise  = Bool
-> (Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> Id
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isImmutableTyVar Id
v)
                    Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX Id
v
                    -- DV: used to be "return v", but that is plain
                    -- wrong because we may need to go inside the kind
                    -- of v and zonk there!

{-
************************************************************************
*                                                                      *
              Constraints and evidence
*                                                                      *
************************************************************************
-}

zonkEvTerm :: EvTerm -> ZonkTcM EvTerm
zonkEvTerm :: EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm (EvExpr EvExpr
e)
  = EvExpr -> EvTerm
EvExpr (EvExpr -> EvTerm)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e
zonkEvTerm (EvTypeable Kind
ty EvTypeable
ev)
  = Kind -> EvTypeable -> EvTerm
EvTypeable (Kind -> EvTypeable -> EvTerm)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (EvTypeable -> EvTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (EvTypeable -> EvTerm)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTypeable
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EvTypeable -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTypeable
zonkEvTypeable EvTypeable
ev
zonkEvTerm (EvFun { et_tvs :: EvTerm -> [Id]
et_tvs = [Id]
tvs, et_given :: EvTerm -> [Id]
et_given = [Id]
evs
                  , et_binds :: EvTerm -> TcEvBinds
et_binds = TcEvBinds
ev_binds, et_body :: EvTerm -> Id
et_body = Id
body_id })
  = ZonkBndrTcM [Id]
-> forall r.
   ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([Id] -> ZonkBndrTcM [Id]
zonkTyBndrsX [Id]
tvs)       (([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
forall a b. (a -> b) -> a -> b
$ \ [Id]
new_tvs      ->
    ZonkBndrTcM [Id]
-> forall r.
   ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([Id] -> ZonkBndrTcM [Id]
zonkEvBndrsX [Id]
evs)       (([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
forall a b. (a -> b) -> a -> b
$ \ [Id]
new_evs      ->
    ZonkBndrTcM TcEvBinds
-> forall r.
   (TcEvBinds -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds TcEvBinds
ev_binds) ((TcEvBinds -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> (TcEvBinds -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
forall a b. (a -> b) -> a -> b
$ \ TcEvBinds
new_ev_binds ->
  do { new_body_id  <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
body_id
     ; return (EvFun { et_tvs = new_tvs, et_given = new_evs
                     , et_binds = new_ev_binds, et_body = new_body_id }) }

zonkCoreExpr :: CoreExpr -> ZonkTcM CoreExpr
zonkCoreExpr :: EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr (Var Id
v)
    | Id -> Bool
isCoVar Id
v
    = Coercion -> EvExpr
forall b. Coercion -> Expr b
Coercion (Coercion -> EvExpr)
-> ZonkTcM Coercion -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> ZonkTcM Coercion
zonkCoVarOcc Id
v
    | Bool
otherwise
    = Id -> EvExpr
forall b. Id -> Expr b
Var (Id -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
v
zonkCoreExpr (Lit Literal
l)
    = EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr)
-> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall a b. (a -> b) -> a -> b
$ Literal -> EvExpr
forall b. Literal -> Expr b
Lit Literal
l
zonkCoreExpr (Coercion Coercion
co)
    = Coercion -> EvExpr
forall b. Coercion -> Expr b
Coercion (Coercion -> EvExpr)
-> ZonkTcM Coercion -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coercion -> ZonkTcM Coercion
zonkCoToCo Coercion
co
zonkCoreExpr (Type Kind
ty)
    = Kind -> EvExpr
forall b. Kind -> Expr b
Type (Kind -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty

zonkCoreExpr (Cast EvExpr
e Coercion
co)
    = EvExpr -> Coercion -> EvExpr
forall b. Expr b -> Coercion -> Expr b
Cast (EvExpr -> Coercion -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Coercion -> EvExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Coercion -> EvExpr)
-> ZonkTcM Coercion -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Coercion -> ZonkTcM Coercion
zonkCoToCo Coercion
co
zonkCoreExpr (Tick CoreTickish
t EvExpr
e)
    = CoreTickish -> EvExpr -> EvExpr
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t (EvExpr -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e -- Do we need to zonk in ticks?

zonkCoreExpr (App EvExpr
e1 EvExpr
e2)
    = EvExpr -> EvExpr -> EvExpr
forall b. Expr b -> Expr b -> Expr b
App (EvExpr -> EvExpr -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (EvExpr -> EvExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e1 ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (EvExpr -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall a b.
ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (a -> b)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e2
zonkCoreExpr (Lam Id
v EvExpr
e)
    = ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
-> forall r.
   (Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkCoreBndrX Id
v) ((Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr)
-> (Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall a b. (a -> b) -> a -> b
$ \ Id
v' ->
      Id -> EvExpr -> EvExpr
forall b. b -> Expr b -> Expr b
Lam Id
v' (EvExpr -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e
zonkCoreExpr (Let Bind Id
bind EvExpr
e)
    = ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id)
-> forall r.
   (Bind Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT (Bind Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id)
zonkCoreBind Bind Id
bind) ((Bind Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr)
-> (Bind Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall a b. (a -> b) -> a -> b
$ \ Bind Id
bind' ->
      Bind Id -> EvExpr -> EvExpr
forall b. Bind b -> Expr b -> Expr b
Let Bind Id
bind' (EvExpr -> EvExpr)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e
zonkCoreExpr (Case EvExpr
scrut Id
b Kind
ty [Alt Id]
alts)
    = do { scrut' <- EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
scrut
         ; ty' <- zonkTcTypeToTypeX ty
         ; runZonkBndrT (zonkIdBndrX b) $ \ Id
b' ->
      do { alts' <- (Alt Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id))
-> [Alt Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [Alt Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Alt Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id)
zonkCoreAlt [Alt Id]
alts
         ; return $ Case scrut' b' ty' alts' } }

zonkCoreAlt :: CoreAlt -> ZonkTcM CoreAlt
zonkCoreAlt :: Alt Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id)
zonkCoreAlt (Alt AltCon
dc [Id]
bndrs EvExpr
rhs)
    = ZonkBndrTcM [Id]
-> forall r.
   ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a.
ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
runZonkBndrT ([Id] -> ZonkBndrTcM [Id]
zonkCoreBndrsX [Id]
bndrs) (([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id))
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id))
-> ([Id] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id)
forall a b. (a -> b) -> a -> b
$ \ [Id]
bndrs' ->
      do { rhs' <- EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
rhs
         ; return $ Alt dc bndrs' rhs' }

zonkCoreBind :: CoreBind -> ZonkBndrTcM CoreBind
zonkCoreBind :: Bind Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id)
zonkCoreBind (NonRec Id
v EvExpr
e)
    = do { (v',e') <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
forall a b. (a -> b) -> a -> b
$ (Id, EvExpr) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
zonkCorePair (Id
v,EvExpr
e)
         ; extendIdZonkEnv v'
         ; return (NonRec v' e') }
zonkCoreBind (Rec [(Id, EvExpr)]
pairs)
    = do pairs' <- ([(Id, EvExpr)]
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)])
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
forall a.
(a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix [(Id, EvExpr)]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
go
         return $ Rec pairs'
  where
    go :: [(Id, EvExpr)]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
go [(Id, EvExpr)]
new_pairs = do
      [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec (((Id, EvExpr) -> Id) -> [(Id, EvExpr)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, EvExpr) -> Id
forall a b. (a, b) -> a
fst [(Id, EvExpr)]
new_pairs)
      ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)])
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
forall a b. (a -> b) -> a -> b
$ ((Id, EvExpr)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr))
-> [(Id, EvExpr)]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, EvExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Id, EvExpr) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
zonkCorePair [(Id, EvExpr)]
pairs

zonkCorePair :: (CoreBndr, CoreExpr) -> ZonkTcM (CoreBndr, CoreExpr)
zonkCorePair :: (Id, EvExpr) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
zonkCorePair (Id
v,EvExpr
e) =
  do { v' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
v
     ; e' <- zonkCoreExpr e
     ; return (v',e') }

zonkEvTypeable :: EvTypeable -> ZonkTcM EvTypeable
zonkEvTypeable :: EvTypeable -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTypeable
zonkEvTypeable (EvTypeableTyCon TcTyCon
tycon [EvTerm]
e)
  = do { e'  <- (EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm)
-> [EvTerm] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [EvTerm]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm [EvTerm]
e
       ; return $ EvTypeableTyCon tycon e' }
zonkEvTypeable (EvTypeableTyApp EvTerm
t1 EvTerm
t2)
  = do { t1' <- EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm EvTerm
t1
       ; t2' <- zonkEvTerm t2
       ; return (EvTypeableTyApp t1' t2') }
zonkEvTypeable (EvTypeableTrFun EvTerm
tm EvTerm
t1 EvTerm
t2)
  = do { tm' <- EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm EvTerm
tm
       ; t1' <- zonkEvTerm t1
       ; t2' <- zonkEvTerm t2
       ; return (EvTypeableTrFun tm' t1' t2') }
zonkEvTypeable (EvTypeableTyLit EvTerm
t1)
  = do { t1' <- EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm EvTerm
t1
       ; return (EvTypeableTyLit t1') }

zonkTcEvBinds_s :: [TcEvBinds] -> ZonkBndrTcM [TcEvBinds]
zonkTcEvBinds_s :: [TcEvBinds]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [TcEvBinds]
zonkTcEvBinds_s [TcEvBinds]
bs = do { bs' <- (TcEvBinds
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind))
-> [TcEvBinds]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [Bag EvBind]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse TcEvBinds -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonk_tc_ev_binds [TcEvBinds]
bs
                        ; return ([EvBinds (unionManyBags bs')]) }

zonkTcEvBinds :: TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds :: TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds TcEvBinds
bs = do { bs' <- TcEvBinds -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonk_tc_ev_binds TcEvBinds
bs
                      ; return (EvBinds bs') }

zonk_tc_ev_binds :: TcEvBinds -> ZonkBndrTcM (Bag EvBind)
zonk_tc_ev_binds :: TcEvBinds -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonk_tc_ev_binds (TcEvBinds EvBindsVar
var) = EvBindsVar
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonkEvBindsVar EvBindsVar
var
zonk_tc_ev_binds (EvBinds Bag EvBind
bs)    = Bag EvBind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonkEvBinds Bag EvBind
bs

zonkEvBindsVar :: EvBindsVar -> ZonkBndrTcM (Bag EvBind)
zonkEvBindsVar :: EvBindsVar
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonkEvBindsVar (EvBindsVar { ebv_binds :: EvBindsVar -> IORef EvBindMap
ebv_binds = IORef EvBindMap
ref })
  = do { bs <- IORef EvBindMap
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) EvBindMap
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef IORef EvBindMap
ref
       ; zonkEvBinds (evBindMapBinds bs) }
zonkEvBindsVar (CoEvBindsVar {}) = Bag EvBind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bag EvBind
forall a. Bag a
emptyBag

zonkEvBinds :: Bag EvBind -> ZonkBndrTcM (Bag EvBind)
zonkEvBinds :: Bag EvBind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonkEvBinds Bag EvBind
binds
  = {-# SCC "zonkEvBinds" #-}
    (Bag EvBind
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind))
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
forall a.
(a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((Bag EvBind
  -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind))
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind))
-> (Bag EvBind
    -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind))
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
forall a b. (a -> b) -> a -> b
$ \ Bag EvBind
new_binds ->
  do { [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec (Bag EvBind -> [Id]
collect_ev_bndrs Bag EvBind
new_binds)
     ; ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
forall a b. (a -> b) -> a -> b
$ (EvBind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvBind)
-> Bag EvBind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM EvBind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvBind
zonkEvBind Bag EvBind
binds }
  where
    collect_ev_bndrs :: Bag EvBind -> [EvVar]
    collect_ev_bndrs :: Bag EvBind -> [Id]
collect_ev_bndrs = (EvBind -> [Id] -> [Id]) -> [Id] -> Bag EvBind -> [Id]
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EvBind -> [Id] -> [Id]
add []
    add :: EvBind -> [Id] -> [Id]
add (EvBind { eb_lhs :: EvBind -> Id
eb_lhs = Id
var }) [Id]
vars = Id
var Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
: [Id]
vars

zonkEvBind :: EvBind -> ZonkTcM EvBind
zonkEvBind :: EvBind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvBind
zonkEvBind bind :: EvBind
bind@(EvBind { eb_lhs :: EvBind -> Id
eb_lhs = Id
var, eb_rhs :: EvBind -> EvTerm
eb_rhs = EvTerm
term })
  = do { var'  <- {-# SCC "zonkEvBndr" #-} Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkEvBndr Id
var

         -- Optimise the common case of Refl coercions
         -- See Note [Optimise coercion zonking]
         -- This has a very big effect on some programs (eg #5030)

       ; term' <- case getEqPredTys_maybe (idType var') of
           Just (Role
r, Kind
ty1, Kind
ty2) | Kind
ty1 HasCallStack => Kind -> Kind -> Bool
Kind -> Kind -> Bool
`eqType` Kind
ty2
                  -> EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coercion -> EvTerm
evCoercion (Role -> Kind -> Coercion
mkReflCo Role
r Kind
ty1))
           Maybe (Role, Kind, Kind)
_other -> EvTerm -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvTerm
zonkEvTerm EvTerm
term

       ; return (bind { eb_lhs = var', eb_rhs = term' }) }

{- Note [Optimise coercion zonking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When optimising evidence binds we may come across situations where
a coercion looks like
      cv = ReflCo ty
or    cv1 = cv2
where the type 'ty' is big.  In such cases it is a waste of time to zonk both
  * The variable on the LHS
  * The coercion on the RHS
Rather, we can zonk the variable, and if its type is (ty ~ ty), we can just
use Refl on the right, ignoring the actual coercion on the RHS.

This can have a very big effect, because the constraint solver sometimes does go
to a lot of effort to prove Refl!  (Eg when solving  10+3 = 10+3; cf #5030)
-}

zonkTcMethInfoToMethInfoX :: TcMethInfo -> ZonkTcM MethInfo
zonkTcMethInfoToMethInfoX :: TcMethInfo -> ZonkTcM TcMethInfo
zonkTcMethInfoToMethInfoX (Name
name, Kind
ty, Maybe (DefMethSpec (SrcSpan, Kind))
gdm_spec)
  = do { ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       ; gdm_spec' <- zonk_gdm gdm_spec
       ; return (name, ty', gdm_spec') }
  where
    zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType))
             -> ZonkTcM (Maybe (DefMethSpec (SrcSpan, Type)))
    zonk_gdm :: Maybe (DefMethSpec (SrcSpan, Kind))
-> ZonkTcM (Maybe (DefMethSpec (SrcSpan, Kind)))
zonk_gdm Maybe (DefMethSpec (SrcSpan, Kind))
Nothing = Maybe (DefMethSpec (SrcSpan, Kind))
-> ZonkTcM (Maybe (DefMethSpec (SrcSpan, Kind)))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DefMethSpec (SrcSpan, Kind))
forall a. Maybe a
Nothing
    zonk_gdm (Just DefMethSpec (SrcSpan, Kind)
VanillaDM) = Maybe (DefMethSpec (SrcSpan, Kind))
-> ZonkTcM (Maybe (DefMethSpec (SrcSpan, Kind)))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (DefMethSpec (SrcSpan, Kind) -> Maybe (DefMethSpec (SrcSpan, Kind))
forall a. a -> Maybe a
Just DefMethSpec (SrcSpan, Kind)
forall ty. DefMethSpec ty
VanillaDM)
    zonk_gdm (Just (GenericDM (SrcSpan
loc, Kind
ty)))
      = do { ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
           ; return (Just (GenericDM (loc, ty'))) }

---------------------------------------
{- Note [Zonking the LHS of a RULE]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also GHC.HsToCore.Binds Note [Free tyvars on rule LHS]

We need to gather the type variables mentioned on the LHS so we can
quantify over them.  Example:
  data T a = C

  foo :: T a -> Int
  foo C = 1

  {-# RULES "myrule"  foo C = 1 #-}

After type checking the LHS becomes (foo alpha (C alpha)) and we do
not want to zap the unbound meta-tyvar 'alpha' to Any, because that
limits the applicability of the rule.  Instead, we want to quantify
over it!

We do this in two stages.

* During zonking, we skolemise the TcTyVar 'alpha' to TyVar 'a'.  We
  do this by using zonkTvSkolemising as the UnboundTyVarZonker in the
  ZonkEnv.  (This is in fact the whole reason that the ZonkEnv has a
  UnboundTyVarZonker.)

* In GHC.HsToCore.Binds, we quantify over it.  See GHC.HsToCore.Binds
  Note [Free tyvars on rule LHS]

Quantifying here is awkward because (a) the data type is big and (b)
finding the free type vars of an expression is necessarily monadic
operation. (consider /\a -> f @ b, where b is side-effected to a)
-}

{-
************************************************************************
*                                                                      *
             Checking for coercion holes
*                                                                      *
************************************************************************
-}

-- | Is a coercion hole filled in?
isFilledCoercionHole :: CoercionHole -> TcM Bool
isFilledCoercionHole :: CoercionHole -> TcM Bool
isFilledCoercionHole (CoercionHole { ch_ref :: CoercionHole -> IORef (Maybe Coercion)
ch_ref = IORef (Maybe Coercion)
ref })
  = Maybe Coercion -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Coercion -> Bool)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion) -> TcM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Maybe Coercion)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion)
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef IORef (Maybe Coercion)
ref

-- | Retrieve the contents of a coercion hole. Panics if the hole
-- is unfilled
unpackCoercionHole :: CoercionHole -> TcM Coercion
unpackCoercionHole :: CoercionHole -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
unpackCoercionHole CoercionHole
hole
  = do { contents <- CoercionHole -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion)
unpackCoercionHole_maybe CoercionHole
hole
       ; case contents of
           Just Coercion
co -> Coercion -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Coercion
co
           Maybe Coercion
Nothing -> String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) Coercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unfilled coercion hole" (CoercionHole -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoercionHole
hole) }

-- | Retrieve the contents of a coercion hole, if it is filled
unpackCoercionHole_maybe :: CoercionHole -> TcM (Maybe Coercion)
unpackCoercionHole_maybe :: CoercionHole -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion)
unpackCoercionHole_maybe (CoercionHole { ch_ref :: CoercionHole -> IORef (Maybe Coercion)
ch_ref = IORef (Maybe Coercion)
ref }) = IORef (Maybe Coercion)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion)
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef IORef (Maybe Coercion)
ref

zonkCtRewriterSet :: Ct -> TcM Ct
zonkCtRewriterSet :: Ct -> TcM Ct
zonkCtRewriterSet Ct
ct
  | Ct -> Bool
isGivenCt Ct
ct
  = Ct -> TcM Ct
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Ct
ct
  | Bool
otherwise
  = case Ct
ct of
      CEqCan eq :: EqCt
eq@(EqCt { eq_ev :: EqCt -> CtEvidence
eq_ev = CtEvidence
ev })       -> do { ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                                                  ; return (CEqCan (eq { eq_ev = ev' })) }
      CIrredCan ir :: IrredCt
ir@(IrredCt { ir_ev :: IrredCt -> CtEvidence
ir_ev = CtEvidence
ev }) -> do { ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                                                  ; return (CIrredCan (ir { ir_ev = ev' })) }
      CDictCan di :: DictCt
di@(DictCt { di_ev :: DictCt -> CtEvidence
di_ev = CtEvidence
ev })   -> do { ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                                                  ; return (CDictCan (di { di_ev = ev' })) }
      CQuantCan {}     -> Ct -> TcM Ct
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Ct
ct
      CNonCanonical CtEvidence
ev -> do { ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                             ; return (CNonCanonical ev') }

zonkCtEvRewriterSet :: CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet :: CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet ev :: CtEvidence
ev@(CtGiven {})
  = CtEvidence -> TcM CtEvidence
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return CtEvidence
ev
zonkCtEvRewriterSet ev :: CtEvidence
ev@(CtWanted { ctev_rewriters :: CtEvidence -> RewriterSet
ctev_rewriters = RewriterSet
rewriters })
  = do { rewriters' <- RewriterSet -> TcM RewriterSet
zonkRewriterSet RewriterSet
rewriters
       ; return (ev { ctev_rewriters = rewriters' }) }

-- | Check whether any coercion hole in a RewriterSet is still unsolved.
-- Does this by recursively looking through filled coercion holes until
-- one is found that is not yet filled in, at which point this aborts.
zonkRewriterSet :: RewriterSet -> TcM RewriterSet
zonkRewriterSet :: RewriterSet -> TcM RewriterSet
zonkRewriterSet (RewriterSet UniqSet CoercionHole
set)
  = (CoercionHole -> TcM RewriterSet -> TcM RewriterSet)
-> TcM RewriterSet -> UniqSet CoercionHole -> TcM RewriterSet
forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetStrictFoldUniqSet CoercionHole -> TcM RewriterSet -> TcM RewriterSet
go (RewriterSet -> TcM RewriterSet
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return RewriterSet
emptyRewriterSet) UniqSet CoercionHole
set
     -- this does not introduce non-determinism, because the only
     -- monadic action is to read, and the combining function is
     -- commutative
  where
    go :: CoercionHole -> TcM RewriterSet -> TcM RewriterSet
    go :: CoercionHole -> TcM RewriterSet -> TcM RewriterSet
go CoercionHole
hole TcM RewriterSet
m_acc = RewriterSet -> RewriterSet -> RewriterSet
unionRewriterSet (RewriterSet -> RewriterSet -> RewriterSet)
-> TcM RewriterSet
-> IOEnv (Env TcGblEnv TcLclEnv) (RewriterSet -> RewriterSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoercionHole -> TcM RewriterSet
check_hole CoercionHole
hole IOEnv (Env TcGblEnv TcLclEnv) (RewriterSet -> RewriterSet)
-> TcM RewriterSet -> TcM RewriterSet
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TcM RewriterSet
m_acc

    check_hole :: CoercionHole -> TcM RewriterSet
    check_hole :: CoercionHole -> TcM RewriterSet
check_hole CoercionHole
hole = do { m_co <- CoercionHole -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion)
unpackCoercionHole_maybe CoercionHole
hole
                         ; case m_co of
                             Maybe Coercion
Nothing -> RewriterSet -> TcM RewriterSet
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoercionHole -> RewriterSet
unitRewriterSet CoercionHole
hole)
                             Just Coercion
co -> UnfilledCoercionHoleMonoid -> TcM RewriterSet
unUCHM (Coercion -> UnfilledCoercionHoleMonoid
check_co Coercion
co) }

    check_ty :: Type -> UnfilledCoercionHoleMonoid
    check_co :: Coercion -> UnfilledCoercionHoleMonoid
    (Kind -> UnfilledCoercionHoleMonoid
check_ty, [Kind] -> UnfilledCoercionHoleMonoid
_, Coercion -> UnfilledCoercionHoleMonoid
check_co, [Coercion] -> UnfilledCoercionHoleMonoid
_) = TyCoFolder () UnfilledCoercionHoleMonoid
-> ()
-> (Kind -> UnfilledCoercionHoleMonoid,
    [Kind] -> UnfilledCoercionHoleMonoid,
    Coercion -> UnfilledCoercionHoleMonoid,
    [Coercion] -> UnfilledCoercionHoleMonoid)
forall a env.
Monoid a =>
TyCoFolder env a
-> env -> (Kind -> a, [Kind] -> a, Coercion -> a, [Coercion] -> a)
foldTyCo TyCoFolder () UnfilledCoercionHoleMonoid
folder ()

    folder :: TyCoFolder () UnfilledCoercionHoleMonoid
    folder :: TyCoFolder () UnfilledCoercionHoleMonoid
folder = TyCoFolder { tcf_view :: Kind -> Maybe Kind
tcf_view  = Kind -> Maybe Kind
noView
                        , tcf_tyvar :: () -> Id -> UnfilledCoercionHoleMonoid
tcf_tyvar = \ ()
_ Id
tv -> Kind -> UnfilledCoercionHoleMonoid
check_ty (Id -> Kind
tyVarKind Id
tv)
                        , tcf_covar :: () -> Id -> UnfilledCoercionHoleMonoid
tcf_covar = \ ()
_ Id
cv -> Kind -> UnfilledCoercionHoleMonoid
check_ty (Id -> Kind
varType Id
cv)
                        , tcf_hole :: () -> CoercionHole -> UnfilledCoercionHoleMonoid
tcf_hole  = \ ()
_ -> TcM RewriterSet -> UnfilledCoercionHoleMonoid
UCHM (TcM RewriterSet -> UnfilledCoercionHoleMonoid)
-> (CoercionHole -> TcM RewriterSet)
-> CoercionHole
-> UnfilledCoercionHoleMonoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoercionHole -> TcM RewriterSet
check_hole
                        , tcf_tycobinder :: () -> Id -> ForAllTyFlag -> ()
tcf_tycobinder = \ ()
_ Id
_ ForAllTyFlag
_ -> () }

newtype UnfilledCoercionHoleMonoid = UCHM { UnfilledCoercionHoleMonoid -> TcM RewriterSet
unUCHM :: TcM RewriterSet }

instance Semigroup UnfilledCoercionHoleMonoid where
  UCHM TcM RewriterSet
l <> :: UnfilledCoercionHoleMonoid
-> UnfilledCoercionHoleMonoid -> UnfilledCoercionHoleMonoid
<> UCHM TcM RewriterSet
r = TcM RewriterSet -> UnfilledCoercionHoleMonoid
UCHM (RewriterSet -> RewriterSet -> RewriterSet
unionRewriterSet (RewriterSet -> RewriterSet -> RewriterSet)
-> TcM RewriterSet
-> IOEnv (Env TcGblEnv TcLclEnv) (RewriterSet -> RewriterSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcM RewriterSet
l IOEnv (Env TcGblEnv TcLclEnv) (RewriterSet -> RewriterSet)
-> TcM RewriterSet -> TcM RewriterSet
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TcM RewriterSet
r)

instance Monoid UnfilledCoercionHoleMonoid where
  mempty :: UnfilledCoercionHoleMonoid
mempty = TcM RewriterSet -> UnfilledCoercionHoleMonoid
UCHM (RewriterSet -> TcM RewriterSet
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return RewriterSet
emptyRewriterSet)