{-# 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,
        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 ( 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.Utils.Panic.Plain

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

{- 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 (SrcSpanAnn' ann) a
              -> ZonkTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkMA :: forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkMA a -> ZonkTcM b
fn (L SrcSpanAnn' ann
loc a
a) = (ZonkEnv -> TcM (GenLocated (SrcSpanAnn' ann) b))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (SrcSpanAnn' ann) b)
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM (GenLocated (SrcSpanAnn' ann) b))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (SrcSpanAnn' ann) b))
-> (ZonkEnv -> TcM (GenLocated (SrcSpanAnn' ann) b))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (SrcSpanAnn' ann) b)
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze ->
  SrcSpanAnn' ann
-> TcM (GenLocated (SrcSpanAnn' ann) b)
-> TcM (GenLocated (SrcSpanAnn' ann) b)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnn' ann
loc (TcM (GenLocated (SrcSpanAnn' ann) b)
 -> TcM (GenLocated (SrcSpanAnn' ann) b))
-> TcM (GenLocated (SrcSpanAnn' ann) b)
-> TcM (GenLocated (SrcSpanAnn' ann) b)
forall a b. (a -> b) -> a -> b
$
  do { b
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
     ; GenLocated (SrcSpanAnn' ann) b
-> TcM (GenLocated (SrcSpanAnn' ann) b)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnn' ann -> b -> GenLocated (SrcSpanAnn' ann) b
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' ann
loc b
b) }

wrapLocZonkBndrMA :: (a -> ZonkBndrTcM b) -> GenLocated (SrcSpanAnn' ann) a
                  -> ZonkBndrTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkBndrMA :: forall a b ann.
(a -> ZonkBndrTcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> ZonkBndrTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkBndrMA a -> ZonkBndrTcM b
fn (L SrcSpanAnn' ann
loc a
a) = (forall r.
 (GenLocated (SrcSpanAnn' ann) b
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (SrcSpanAnn' ann) b)
forall (m :: * -> *) a.
(forall r. (a -> ZonkT m r) -> ZonkT m r) -> ZonkBndrT m a
ZonkBndrT ((forall r.
  (GenLocated (SrcSpanAnn' ann) b
   -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (SrcSpanAnn' ann) b))
-> (forall r.
    (GenLocated (SrcSpanAnn' ann) b
     -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated (SrcSpanAnn' ann) b)
forall a b. (a -> b) -> a -> b
$ \ GenLocated (SrcSpanAnn' 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 ->
  SrcSpanAnn' ann -> TcM r -> TcM r
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnn' 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 (SrcSpanAnn' ann) b
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
k (SrcSpanAnn' ann -> b -> GenLocated (SrcSpanAnn' ann) b
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' 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 { Kind
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' :: Id
tv' = Name -> Kind -> Id
mkTyVar (Id -> Name
tyVarName Id
tv) Kind
ki
       ; Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). Id -> ZonkBndrT m ()
extendTyZonkEnv Id
tv'
       ; Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Id
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 { Id
tv' <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkTyBndrX Id
tv
       ; VarBndr Id vis -> ZonkBndrTcM (VarBndr Id vis)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> vis -> VarBndr Id vis
forall var argf. var -> argf -> VarBndr var argf
Bndr Id
tv' vis
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 :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tv_env } <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv

       ; let lookup_in_tv_env :: ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
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
-> MetaDetails -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonk_meta TcRef MetaDetails
ref MetaDetails
Flexi
               = do { Kind
kind <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX (Id -> Kind
tyVarKind Id
tv)
                    ; Kind
ty <- Id -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
commitFlexi Id
tv Kind
kind

                    ; TcM () -> 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 (TcM () -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ())
-> TcM () -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall a b. (a -> b) -> a -> b
$ ZonkM () -> TcM ()
forall a. ZonkM a -> TcM a
liftZonkM (ZonkM () -> TcM ()) -> ZonkM () -> TcM ()
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Id -> TcRef MetaDetails -> Kind -> ZonkM ()
Id -> TcRef MetaDetails -> Kind -> ZonkM ()
writeMetaTyVarRef Id
tv TcRef MetaDetails
ref Kind
ty  -- Belt and braces
                    ; Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
finish_meta Kind
ty }

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

             finish_meta :: Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
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 Id -> Bool
isTcTyVar Id
tv
         then case Id -> TcTyVarDetails
tcTyVarDetails Id
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 { Maybe Kind
mb_ty <- Id -> ZonkTcM (Maybe Kind)
lookupMetaTv Id
tv
                     -- See Note [Sharing when zonking to Type]
                   ; case Maybe Kind
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 { MetaDetails
mtv_details <- TcRef MetaDetails
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) MetaDetails
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef TcRef MetaDetails
ref
                                     ; TcRef MetaDetails
-> MetaDetails -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonk_meta TcRef MetaDetails
ref MetaDetails
mtv_details } }

         -- This should never really happen;
         -- TyVars should not occur in the typechecker
         else ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
lookup_in_tv_env }

extendMetaEnv :: TcTyVar -> Type -> ZonkTcM ()
extendMetaEnv :: Id -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
extendMetaEnv Id
tv Kind
ty =
  (ZonkEnv -> TcM ()) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM ()) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ())
-> (ZonkEnv -> TcM ()) -> 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) -> TcM ()
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 { TyVarEnv Kind
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
       ; Maybe Kind -> TcM (Maybe Kind)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Kind -> TcM (Maybe Kind)) -> Maybe Kind -> TcM (Maybe Kind)
forall a b. (a -> b) -> a -> b
$ TyVarEnv Kind -> Id -> Maybe Kind
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyVarEnv Kind
mtv_env Id
tv }

lookupTyVarX :: TcTyVar -> ZonkTcM TyVar
lookupTyVarX :: Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
lookupTyVarX Id
tv
  = do { ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tv_env } <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv
       ; let !res :: Id
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)
       ; 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
res }

commitFlexi :: TcTyVar -> Kind -> ZonkTcM Type
commitFlexi :: Id -> Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
commitFlexi Id
tv Kind
zonked_kind
  = do { ZonkFlexi
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
       ; TcM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall (m :: * -> *) a. Monad m => m a -> ZonkT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TcM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind)
-> TcM Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
forall a b. (a -> b) -> a -> b
$ case ZonkFlexi
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 -> TcM ()
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 -> TcM ()
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 -> TcM ()
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 -> TcM ()
addErr (TcRnMessage -> TcM ()) -> TcRnMessage -> TcM ()
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 -> TcM ()
traceTc String
"Defaulting flexi tyvar to Any:" (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 -> Kind
anyTypeOfKind Kind
zonked_kind) }

         ZonkFlexi
RuntimeUnkFlexi
           -> do { String -> SDoc -> TcM ()
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 :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
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 TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
tyco_env Id
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
<$> (TcM 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 (TcM Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> TcM Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ ZonkM Id -> TcM Id
forall a. ZonkM a -> TcM a
liftZonkM (ZonkM Id -> TcM Id) -> ZonkM Id -> TcM 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 { Maybe Coercion
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 Maybe Coercion
contents of
           Just Coercion
co -> do { Coercion
co' <- Coercion -> ZonkTcM Coercion
zonkCoToCo Coercion
co
                         ; TcM Coercion -> ZonkTcM Coercion
forall (m :: * -> *) a. Monad m => m a -> ZonkT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TcM Coercion -> ZonkTcM Coercion)
-> TcM Coercion -> ZonkTcM Coercion
forall a b. (a -> b) -> a -> b
$ ZonkM Coercion -> TcM Coercion
forall a. ZonkM a -> TcM a
liftZonkM (ZonkM Coercion -> TcM Coercion) -> ZonkM Coercion -> TcM Coercion
forall a b. (a -> b) -> a -> b
$ Id -> Coercion -> ZonkM Coercion
checkCoercionHole Id
cv Coercion
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 { TcM () -> 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 (TcM () -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ())
-> TcM () -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc -> TcM ()
traceTc String
"Zonking unfilled coercion hole" (CoercionHole -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoercionHole
hole)
                         ; Id
cv' <- TcM 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 (TcM Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> TcM Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ ZonkM Id -> TcM Id
forall a. ZonkM a -> TcM a
liftZonkM (ZonkM Id -> TcM Id) -> ZonkM Id -> TcM Id
forall a b. (a -> b) -> a -> b
$ Id -> ZonkM Id
zonkCoVar 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' } }
                             -- 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 -> TcM Coercion
tcm_covar      = \ ZonkEnv
env Id
cv -> ZonkTcM Coercion -> ZonkEnv -> TcM Coercion
forall (m :: * -> *) a. ZonkT m a -> ZonkEnv -> m a
runZonkT (Id -> ZonkTcM Coercion
zonkCoVarOcc Id
cv) ZonkEnv
env
  , tcm_hole :: ZonkEnv -> CoercionHole -> TcM Coercion
tcm_hole       = \ ZonkEnv
env CoercionHole
co -> ZonkTcM Coercion -> ZonkEnv -> TcM 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 { TyThing
thing <- Name -> TcM TyThing
tcLookupGlobalOnly (TcTyCon -> Name
forall a. NamedThing a => a -> Name
getName TcTyCon
tc)
                      ; case TyThing
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 -> TcM 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 -> TcM 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 -> TcM Coercion) -> ZonkTcM Coercion
forall (m :: * -> *) a. (ZonkEnv -> m a) -> ZonkT m a
ZonkT ((ZonkEnv -> TcM Coercion) -> ZonkTcM Coercion)
-> (Coercion -> ZonkEnv -> TcM Coercion)
-> Coercion
-> ZonkTcM Coercion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonkEnv -> Coercion -> TcM Coercion)
-> Coercion -> ZonkEnv -> TcM Coercion
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZonkEnv -> Coercion -> TcM 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 key 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 :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env } <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
forall (m :: * -> *). Monad m => ZonkT m ZonkEnv
getZonkEnv
       ; 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 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
id_env Id
id Maybe Id -> Id -> Id
forall a. Maybe a -> a -> a
`orElse` Id
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
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
       ; Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). Id -> ZonkBndrT m ()
extendIdZonkEnv Id
id
       ; Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Id
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 Kind
w' Kind
ty' <- Scaled Kind -> ZonkTcM (Scaled Kind)
zonkScaledTcTypeToTypeX (Id -> Scaled Kind
idScaledType Id
v)
       ; 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 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id)
-> Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a b. (a -> b) -> a -> b
$ Id -> Kind -> Id
setIdMult (Id -> Kind -> Id
setIdType Id
v Kind
ty') Kind
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 { Id
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
       ; [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendZonkEnv [Id
var']
       ; Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Id
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))
  (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> forall r.
   (Bag (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) ((Bag (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]))
-> (Bag (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
$ \ Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds'    ->
     -- Top level is implicitly recursive
  do  { [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
rules' <- [LRuleDecl GhcTc] -> ZonkTcM [LRuleDecl GhcTc]
zonkRules [LRuleDecl GhcTc]
rules
      ; [LTcSpecPrag]
specs' <- [LTcSpecPrag] -> ZonkTcM [LTcSpecPrag]
zonkLTcSpecPrags [LTcSpecPrag]
imp_specs
      ; [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
fords' <- [LForeignDecl GhcTc] -> ZonkTcM [LForeignDecl GhcTc]
zonkForeignExports [LForeignDecl GhcTc]
fords
      ; TypeEnv
ty_env <- ZonkEnv -> TypeEnv
zonkEnvIds (ZonkEnv -> TypeEnv)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ZonkEnv
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) TypeEnv
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
      ; (TypeEnv, Bag EvBind,
 Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
 [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], [LTcSpecPrag],
 [GenLocated SrcSpanAnnA (RuleDecl GhcTc)])
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (TypeEnv, Bag EvBind,
      Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
      [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], [LTcSpecPrag],
      [GenLocated SrcSpanAnnA (RuleDecl GhcTc)])
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeEnv
ty_env, Bag EvBind
ev_binds', Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds', [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
fords', [LTcSpecPrag]
specs', [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
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  { [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
new_binds <- ((RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))))
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(RecFlag, Bag (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, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall {a}.
(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
go [(RecFlag, LHsBinds GhcTc)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
binds
        ; HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XHsValBinds GhcTc GhcTc
-> HsValBindsLR GhcTc GhcTc -> HsLocalBinds GhcTc
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcTc GhcTc
x (XXValBindsLR GhcTc GhcTc -> HsValBindsLR GhcTc GhcTc
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
XValBindsLR ([(RecFlag, LHsBinds GhcTc)] -> [LSig GhcRn] -> NHsValBindsLR GhcTc
forall idL.
[(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
NValBinds [(RecFlag, LHsBinds GhcTc)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
new_binds [LSig GhcRn]
sigs))) }
  where
    go :: (a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
go (a
r,Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b)
      = do { Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b' <- LHsBinds GhcTc -> ZonkBndrTcM (LHsBinds GhcTc)
zonkRecMonoBinds LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b
           ; (a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r,Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b') }

zonkLocalBinds (HsIPBinds XHsIPBinds GhcTc GhcTc
x (IPBinds XIPBinds GhcTc
dict_binds [LIPBind GhcTc]
binds )) = do
    [GenLocated SrcSpanAnnA (IPBind GhcTc)]
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 (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkMA IPBind GhcTc -> ZonkTcM (IPBind GhcTc)
zonk_ip_bind) [LIPBind GhcTc]
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
binds
    [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec [ XCIPBind GhcTc
Id
n | (L SrcSpanAnnA
_ (IPBind XCIPBind GhcTc
n XRec GhcTc HsIPName
_ LHsExpr GhcTc
_)) <- [GenLocated SrcSpanAnnA (IPBind GhcTc)]
new_binds]
    TcEvBinds
new_dict_binds <- TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds XIPBinds GhcTc
TcEvBinds
dict_binds
    HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc))
-> HsLocalBinds GhcTc -> ZonkBndrTcM (HsLocalBinds GhcTc)
forall a b. (a -> b) -> a -> b
$ XHsIPBinds GhcTc GhcTc -> HsIPBinds GhcTc -> HsLocalBinds GhcTc
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds XHsIPBinds GhcTc GhcTc
x (XIPBinds GhcTc -> [LIPBind GhcTc] -> HsIPBinds GhcTc
forall id. XIPBinds id -> [LIPBind id] -> HsIPBinds id
IPBinds XIPBinds GhcTc
TcEvBinds
new_dict_binds [LIPBind GhcTc]
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
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 Id
dict_id' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr XCIPBind GhcTc
Id
dict_id
             LocatedA (HsExpr GhcTc)
e'       <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
             IPBind GhcTc -> ZonkTcM (IPBind GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCIPBind GhcTc
-> XRec GhcTc HsIPName -> LHsExpr GhcTc -> IPBind GhcTc
forall id.
XCIPBind id -> XRec id HsIPName -> LHsExpr id -> IPBind id
IPBind XCIPBind GhcTc
Id
dict_id' XRec GhcTc HsIPName
n LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
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)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM LHsBind GhcTc -> ZonkTcM (LHsBind GhcTc)
GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_lbind LHsBinds GhcTc
Bag (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 (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' 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_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_ext = (Kind
ty, ([CoreTickish], [[CoreTickish]])
ticks)})
  = do  { GenLocated SrcSpanAnnA (Pat GhcTc)
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
        ; GRHSs GhcTc (LocatedA (HsExpr GhcTc))
new_grhss <- (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> GRHSs GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (GRHSs GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
(LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr GRHSs GhcTc (LHsExpr GhcTc)
GRHSs GhcTc (LocatedA (HsExpr GhcTc))
grhss
        ; Kind
new_ty    <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
        ; HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc
bind { pat_lhs = new_pat, pat_rhs = new_grhss
                       , 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 { Id
new_var  <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr IdP GhcTc
Id
var
       ; LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       ; HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (VarBind { var_ext :: XVarBind GhcTc GhcTc
var_ext = XVarBind GhcTc GhcTc
x
                         , var_id :: IdP GhcTc
var_id = IdP GhcTc
Id
new_var
                         , var_rhs :: LHsExpr GhcTc
var_rhs = LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
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 { Id
new_var <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
var
       ; 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 -> ZonkTcM (HsBindLR GhcTc GhcTc))
 -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> (HsWrapper -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ \ HsWrapper
new_co_fn ->
    do { MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
       ; HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc
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 { (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_bind, [ABExport]
new_exports) <- ((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Bag (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 (((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> ((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
     [ABExport])
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a b. (a -> b) -> a -> b
$ \ ~(Bag (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
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds) ((()
  -> ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> (()
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a b. (a -> b) -> a -> b
$ \ ()
_ ->
       do { Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds <- (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_val_bind LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
val_binds
          ; [ABExport]
new_exports   <- (ABExport -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ABExport)
-> [ABExport] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [ABExport]
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 ABExport -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ABExport
zonk_export [ABExport]
exports
          ; (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds, [ABExport]
new_exports)
          }
     ; HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall idL idR. XXHsBindsLR idL idR -> HsBindLR idL idR
XHsBindsLR (XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc)
-> XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall a b. (a -> b) -> a -> b
$
                AbsBinds { abs_tvs :: [Id]
abs_tvs = [Id]
new_tyvars, abs_ev_vars :: [Id]
abs_ev_vars = [Id]
new_evs
                         , abs_ev_binds :: [TcEvBinds]
abs_ev_binds = [TcEvBinds]
new_ev_binds
                         , abs_exports :: [ABExport]
abs_exports = [ABExport]
new_exports, abs_binds :: LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_bind
                         , abs_sig :: Bool
abs_sig = Bool
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 { Id
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
           ; 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))
       (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> (HsWrapper
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a b. (a -> b) -> a -> b
$ \ HsWrapper
new_co_fn ->
        do { MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
           ; GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (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 a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsBindLR GhcTc GhcTc
 -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$
             HsBindLR GhcTc GhcTc
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 Id
new_poly_id <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
poly_id
             HsWrapper
new_wrap    <- 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
wrap
             TcSpecPrags
new_prags   <- TcSpecPrags -> ZonkTcM TcSpecPrags
zonkSpecPrags TcSpecPrags
prags
             Id
new_mono_id <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
mono_id
             ABExport -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ABExport
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ABE{ abe_wrap :: HsWrapper
abe_wrap  = HsWrapper
new_wrap
                        , abe_poly :: Id
abe_poly  = Id
new_poly_id
                        , abe_mono :: Id
abe_mono  = Id
new_mono_id
                        , abe_prags :: TcSpecPrags
abe_prags = TcSpecPrags
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' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
id
       ; 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
lpat) ((GenLocated SrcSpanAnnA (Pat GhcTc)
  -> ZonkTcM (HsBindLR GhcTc GhcTc))
 -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> (GenLocated SrcSpanAnnA (Pat GhcTc)
    -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ \ GenLocated SrcSpanAnnA (Pat GhcTc)
lpat' ->
    do { HsConDetails
  Void (GenLocated SrcSpanAnnN Id) [RecordPatSynField GhcTc]
details' <- HsPatSynDetails GhcTc -> ZonkTcM (HsPatSynDetails GhcTc)
zonkPatSynDetails HsPatSynDetails GhcTc
details
       ; HsPatSynDir GhcTc
dir'     <- HsPatSynDir GhcTc -> ZonkTcM (HsPatSynDir GhcTc)
zonkPatSynDir HsPatSynDir GhcTc
dir
       ; HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc -> ZonkTcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ XPatSynBind GhcTc GhcTc
-> PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind GhcTc GhcTc
x (PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc)
-> PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall a b. (a -> b) -> a -> b
$
                  PatSynBind GhcTc GhcTc
bind { psb_id   = L loc id'
                       , psb_args = details'
                       , psb_def  = lpat'
                       , psb_dir  = dir' } } }

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))) ~ SrcAnn NoEpAnns) =>
(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 { [LTcSpecPrag]
ps' <- [LTcSpecPrag] -> ZonkTcM [LTcSpecPrag]
zonkLTcSpecPrags [LTcSpecPrag]
ps
                                   ; TcSpecPrags -> ZonkTcM TcSpecPrags
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LTcSpecPrag] -> TcSpecPrags
SpecPrags [LTcSpecPrag]
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 { HsWrapper
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
id' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
id
             ; GenLocated l TcSpecPrag
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated l TcSpecPrag)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (l -> TcSpecPrag -> GenLocated l TcSpecPrag
forall l e. l -> e -> GenLocated l e
L l
loc (Id -> HsWrapper -> InlinePragma -> TcSpecPrag
SpecPrag Id
id' HsWrapper
co_fn' InlinePragma
inl)) }

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

zonkMatchGroup :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
               => (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))) ~ SrcAnn NoEpAnns) =>
(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  { [GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))]
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))) ~ SrcAnn NoEpAnns) =>
(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
        ; [Scaled Kind]
arg_tys' <- [Scaled Kind] -> ZonkTcM [Scaled Kind]
zonkScaledTcTypesToTypesX [Scaled Kind]
arg_tys
        ; Kind
res_ty'  <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
res_ty
        ; MatchGroup GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MG { mg_alts :: XRec GhcTc [LMatch GhcTc (LocatedA (body GhcTc))]
mg_alts = Anno
  [GenLocated
     (Anno (Match GhcTc (LocatedA (body GhcTc))))
     (Match GhcTc (LocatedA (body GhcTc)))]
-> [GenLocated
      (Anno (Match GhcTc (LocatedA (body GhcTc))))
      (Match GhcTc (LocatedA (body GhcTc)))]
-> GenLocated
     (Anno
        [GenLocated
           (Anno (Match GhcTc (LocatedA (body GhcTc))))
           (Match GhcTc (LocatedA (body GhcTc)))])
     [GenLocated
        (Anno (Match GhcTc (LocatedA (body GhcTc))))
        (Match GhcTc (LocatedA (body GhcTc)))]
forall l e. l -> e -> GenLocated l e
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 :: XMG GhcTc (LocatedA (body GhcTc))
mg_ext = [Scaled Kind] -> Kind -> Origin -> MatchGroupTc
MatchGroupTc [Scaled Kind]
arg_tys' Kind
res_ty' Origin
origin
                     }) }

zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
          => (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))) ~ SrcAnn NoEpAnns) =>
(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 -> [LPat p]
m_pats = [LPat 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]
zonkPats [LPat 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  { GRHSs GhcTc (LocatedA (body GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
      ; 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 a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Anno (Match GhcTc (LocatedA (body GhcTc)))
-> Match GhcTc (LocatedA (body GhcTc))
-> GenLocated
     (Anno (Match GhcTc (LocatedA (body GhcTc))))
     (Match GhcTc (LocatedA (body GhcTc)))
forall l e. l -> e -> GenLocated l e
L Anno (Match GhcTc (LocatedA (body GhcTc)))
loc (Match GhcTc (LocatedA (body GhcTc))
match { m_pats = new_pats, m_grhss = new_grhss })) }

-------------------------------------------------------------------------
zonkGRHSs :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
          => (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))) ~ SrcAnn NoEpAnns) =>
(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 { [GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
new_grhss <- (GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated
         (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))))
-> [GenLocated
      (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated (SrcAnn NoEpAnns) (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
     (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc))))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkMA GRHS GhcTc (LocatedA (body GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (body GhcTc)))
zonk_grhs) [LGRHS GhcTc (LocatedA (body GhcTc))]
[GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
grhss
       ; GRHSs GhcTc (LocatedA (body GhcTc))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GRHSs GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHSs GhcTc (LocatedA (body GhcTc))
-> [LGRHS GhcTc (LocatedA (body GhcTc))]
-> HsLocalBinds GhcTc
-> GRHSs GhcTc (LocatedA (body GhcTc))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcTc (LocatedA (body GhcTc))
x [LGRHS GhcTc (LocatedA (body GhcTc))]
[GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
new_grhss HsLocalBinds GhcTc
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 (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' 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' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
id
     ; 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 (XVar GhcTc -> LIdP GhcTc -> HsExpr GhcTc
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcTc
x (SrcSpanAnnN -> Id -> GenLocated SrcSpanAnnN Id
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l Id
id')) }

zonkExpr (HsUnboundVar XUnboundVar GhcTc
her RdrName
occ)
  = do HoleExprRef
her' <- HoleExprRef -> ZonkTcM HoleExprRef
zonk_her XUnboundVar GhcTc
HoleExprRef
her
       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 (XUnboundVar GhcTc -> RdrName -> HsExpr GhcTc
forall p. XUnboundVar p -> RdrName -> HsExpr p
HsUnboundVar XUnboundVar GhcTc
HoleExprRef
her' RdrName
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
           Kind
ty'  <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
           HoleExprRef -> ZonkTcM HoleExprRef
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef EvTerm -> Kind -> Unique -> HoleExprRef
HER IORef EvTerm
ref Kind
ty' Unique
u)

zonkExpr (HsRecSel XRecSel GhcTc
_ (FieldOcc XCFieldOcc GhcTc
v XRec GhcTc RdrName
occ))
  = do { Id
v' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc XCFieldOcc GhcTc
Id
v
       ; 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 (XRecSel GhcTc -> FieldOcc GhcTc -> HsExpr GhcTc
forall p. XRecSel p -> FieldOcc p -> HsExpr p
HsRecSel XRecSel GhcTc
NoExtField
noExtField (XCFieldOcc GhcTc -> XRec GhcTc RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc GhcTc
Id
v' XRec GhcTc RdrName
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 SourceText
_ 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 Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       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 (XHsRat GhcTc -> FractionalLit -> Kind -> HsLit GhcTc
forall x. XHsRat x -> FractionalLit -> Kind -> HsLit x
HsRat XHsRat GhcTc
e FractionalLit
f Kind
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  { HsOverLit GhcTc
lit' <- HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
zonkOverLit HsOverLit 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 (XOverLitE GhcTc -> HsOverLit GhcTc -> HsExpr GhcTc
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcTc
x HsOverLit GhcTc
lit') }

zonkExpr (HsLam XLam GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
matches)
  = do MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
       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 (XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_matches)

zonkExpr (HsLamCase XLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsExpr GhcTc)
matches)
  = do MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
       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 (XLamCase GhcTc
-> LamCaseVariant
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> HsExpr GhcTc
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_matches)

zonkExpr (HsApp XApp GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do LocatedA (HsExpr GhcTc)
new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       LocatedA (HsExpr GhcTc)
new_e2 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e2
       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 (XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2)

zonkExpr (HsAppType XAppTypeE GhcTc
ty LHsExpr GhcTc
e LHsToken "@" GhcTc
at LHsWcType (NoGhcTc GhcTc)
t)
  = do LocatedA (HsExpr GhcTc)
new_e <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XAppTypeE GhcTc
Kind
ty
       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 (XAppTypeE GhcTc
-> LHsExpr GhcTc
-> LHsToken "@" GhcTc
-> LHsWcType (NoGhcTc GhcTc)
-> HsExpr GhcTc
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcTc
Kind
new_ty LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e LHsToken "@" GhcTc
at LHsWcType (NoGhcTc GhcTc)
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 { LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       ; 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 (XNegApp GhcTc -> LHsExpr GhcTc -> SyntaxExpr GhcTc -> HsExpr GhcTc
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp XNegApp GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr SyntaxExpr GhcTc
SyntaxExprTc
new_op) }

zonkExpr (HsPar XPar GhcTc
x LHsToken "(" GhcTc
lpar LHsExpr GhcTc
e LHsToken ")" GhcTc
rpar)
  = do { LocatedA (HsExpr GhcTc)
new_e <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       ; 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 (XPar GhcTc
-> LHsToken "(" GhcTc
-> LHsExpr GhcTc
-> LHsToken ")" GhcTc
-> HsExpr GhcTc
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcTc
x LHsToken "(" GhcTc
lpar LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e LHsToken ")" GhcTc
rpar) }

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 { [HsTupArg GhcTc]
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
       ; 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 (XExplicitTuple GhcTc -> [HsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcTc
x [HsTupArg GhcTc]
new_tup_args Boxity
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 { LocatedA (HsExpr GhcTc)
e' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
                                    ; HsTupArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsTupArg GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
e') }
    zonk_tup_arg (Missing XMissing GhcTc
t) = do { Scaled Kind
t' <- Scaled Kind -> ZonkTcM (Scaled Kind)
zonkScaledTcTypeToTypeX XMissing GhcTc
Scaled Kind
t
                                  ; HsTupArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsTupArg GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XMissing GhcTc -> HsTupArg GhcTc
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcTc
Scaled Kind
t') }


zonkExpr (ExplicitSum XExplicitSum GhcTc
args ConTag
alt ConTag
arity LHsExpr GhcTc
expr)
  = do [Kind]
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
       LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       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 (XExplicitSum GhcTc
-> ConTag -> ConTag -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XExplicitSum p -> ConTag -> ConTag -> LHsExpr p -> HsExpr p
ExplicitSum [Kind]
XExplicitSum GhcTc
new_args ConTag
alt ConTag
arity LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr)

zonkExpr (HsCase XCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsExpr GhcTc)
ms)
  = do LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
       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 (XCase GhcTc
-> LHsExpr GhcTc
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> HsExpr GhcTc
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_ms)

zonkExpr (HsIf XIf GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do LocatedA (HsExpr GhcTc)
new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       LocatedA (HsExpr GhcTc)
new_e2 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e2
       LocatedA (HsExpr GhcTc)
new_e3 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e3
       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 (XIf GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf XIf GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e3)

zonkExpr (HsMultiIf XMultiIf GhcTc
ty [LGRHS GhcTc (LHsExpr GhcTc)]
alts)
  = do { [GenLocated
   (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
alts' <- (GenLocated
   (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated
         (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc)))))
-> [GenLocated
      (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        (SrcAnn NoEpAnns) (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
     (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkMA GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
zonk_alt) [LGRHS GhcTc (LHsExpr GhcTc)]
[GenLocated
   (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
alts
       ; Kind
ty'   <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XMultiIf GhcTc
Kind
ty
       ; 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 (HsExpr GhcTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ XMultiIf GhcTc -> [LGRHS GhcTc (LHsExpr GhcTc)] -> HsExpr GhcTc
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf XMultiIf GhcTc
Kind
ty' [LGRHS GhcTc (LHsExpr GhcTc)]
[GenLocated
   (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
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 { LocatedA (HsExpr GhcTc)
expr' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
expr
               ; GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GRHS GhcTc (LocatedA (HsExpr GhcTc))
 -> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
-> GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkTcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcTc (LocatedA (HsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> LocatedA (HsExpr GhcTc)
-> GRHS GhcTc (LocatedA (HsExpr GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (LocatedA (HsExpr GhcTc))
x [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
guard' LocatedA (HsExpr GhcTc)
expr' }

zonkExpr (HsLet XLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
binds LHsToken "in" GhcTc
tkIn 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 { LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       ; 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 (XLet GhcTc
-> LHsToken "let" GhcTc
-> HsLocalBinds GhcTc
-> LHsToken "in" GhcTc
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
new_binds LHsToken "in" GhcTc
tkIn LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr) }

zonkExpr (HsDo XDo GhcTc
ty HsDoFlavour
do_or_lc (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts))
  = do [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
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
       Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XDo GhcTc
Kind
ty
       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 (XDo GhcTc
-> HsDoFlavour -> XRec GhcTc [GuardLStmt GhcTc] -> HsExpr GhcTc
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcTc
Kind
new_ty HsDoFlavour
do_or_lc (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts))

zonkExpr (ExplicitList XExplicitList GhcTc
ty [LHsExpr GhcTc]
exprs)
  = do Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XExplicitList GhcTc
Kind
ty
       [LocatedA (HsExpr GhcTc)]
new_exprs <- [LHsExpr GhcTc] -> ZonkTcM [LHsExpr GhcTc]
zonkLExprs [LHsExpr GhcTc]
exprs
       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 (XExplicitList GhcTc -> [LHsExpr GhcTc] -> HsExpr GhcTc
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcTc
Kind
new_ty [LHsExpr GhcTc]
[LocatedA (HsExpr GhcTc)]
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  { HsExpr GhcTc
new_con_expr <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr XRecordCon GhcTc
HsExpr GhcTc
con_expr
        ; HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
new_rbinds   <- HsRecordBinds GhcTc -> ZonkTcM (HsRecordBinds GhcTc)
zonkRecFields HsRecordBinds GhcTc
rbinds
        ; 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 (HsExpr GhcTc
expr { rcon_ext  = new_con_expr
                       , rcon_flds = new_rbinds }) }

zonkExpr (ExprWithTySig XExprWithTySig GhcTc
_ LHsExpr GhcTc
e LHsSigWcType (NoGhcTc GhcTc)
ty)
  = do { LocatedA (HsExpr GhcTc)
e' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       ; 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 (XExprWithTySig GhcTc
-> LHsExpr GhcTc -> LHsSigWcType (NoGhcTc GhcTc) -> HsExpr GhcTc
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcTc
NoExtField
noExtField LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
e' LHsSigWcType (NoGhcTc GhcTc)
ty) }

zonkExpr (ArithSeq XArithSeq GhcTc
expr Maybe (SyntaxExpr GhcTc)
wit ArithSeqInfo GhcTc
info)
  = do { HsExpr GhcTc
new_expr <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr XArithSeq GhcTc
HsExpr GhcTc
expr
       ; ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
-> forall r.
   (Maybe 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 (Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
zonkWit Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
wit) ((Maybe SyntaxExprTc
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> (Maybe SyntaxExprTc
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ \ Maybe SyntaxExprTc
new_wit ->
    do { ArithSeqInfo GhcTc
new_info <- ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
zonkArithSeq  ArithSeqInfo GhcTc
info
       ; 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 (XArithSeq GhcTc
-> Maybe (SyntaxExpr GhcTc) -> ArithSeqInfo GhcTc -> HsExpr GhcTc
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq GhcTc
HsExpr GhcTc
new_expr Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
new_wit ArithSeqInfo GhcTc
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 LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       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 (XPragE GhcTc -> HsPragE GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
HsPragE XPragE GhcTc
x HsPragE GhcTc
prag LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
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  { GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
new_body <- LHsCmdTop GhcTc -> ZonkTcM (LHsCmdTop GhcTc)
zonkCmdTop LHsCmdTop GhcTc
body
        ; 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 (XProc GhcTc -> LPat GhcTc -> LHsCmdTop GhcTc -> HsExpr GhcTc
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
HsProc XProc GhcTc
x LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat LHsCmdTop GhcTc
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
new_body) }

-- StaticPointers extension
zonkExpr (HsStatic (NameSet
fvs, Kind
ty) LHsExpr GhcTc
expr)
  = do Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic (NameSet
fvs, Kind
new_ty) (LocatedA (HsExpr GhcTc) -> HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr

zonkExpr (XExpr (WrapExpr (HsWrap 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 HsExpr GhcTc
new_expr <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
expr
       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 (XXExpr GhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (HsWrap HsExpr -> XXExprGhcTc
WrapExpr (HsWrapper -> HsExpr GhcTc -> HsWrap HsExpr
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
new_co_fn HsExpr GhcTc
new_expr)))

zonkExpr (XExpr (ExpansionExpr (HsExpanded HsExpr GhcRn
a HsExpr GhcTc
b)))
  = XXExpr GhcTc -> HsExpr GhcTc
XXExprGhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (XXExprGhcTc -> HsExpr GhcTc)
-> (HsExpr GhcTc -> XXExprGhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc
ExpansionExpr (HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc)
-> (HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc))
-> HsExpr GhcTc
-> XXExprGhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcRn
-> HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc)
forall orig expanded. orig -> expanded -> HsExpansion orig expanded
HsExpanded HsExpr GhcRn
a (HsExpr GhcTc -> HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
b

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 { HsWrapper
res_wrap'  <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
res_wrap
       ; HsExpr GhcTc
expr'      <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
expr
       ; [HsWrapper]
arg_wraps' <- (HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper)
-> [HsWrapper]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [HsWrapper]
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 HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn [HsWrapper]
arg_wraps
       ; 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 { syn_expr :: HsExpr GhcTc
syn_expr      = HsExpr GhcTc
expr'
                             , syn_arg_wraps :: [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps'
                             , syn_res_wrap :: HsWrapper
syn_res_wrap  = HsWrapper
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 (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' 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 { HsCmd GhcTc
cmd' <- HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
zonkCmd HsCmd GhcTc
cmd
       ; HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XXCmd GhcTc -> HsCmd GhcTc
forall id. XXCmd id -> HsCmd id
XCmd (HsWrapper -> HsCmd GhcTc -> HsWrap HsCmd
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
w' HsCmd GhcTc
cmd')) }
zonkCmd (HsCmdArrApp XCmdArrApp GhcTc
ty LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 HsArrAppType
ho Bool
rl)
  = do LocatedA (HsExpr GhcTc)
new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       LocatedA (HsExpr GhcTc)
new_e2 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e2
       Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XCmdArrApp GhcTc
Kind
ty
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrApp GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsArrAppType
-> Bool
-> HsCmd GhcTc
forall id.
XCmdArrApp id
-> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
HsCmdArrApp XCmdArrApp GhcTc
Kind
new_ty LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2 HsArrAppType
ho Bool
rl)

zonkCmd (HsCmdArrForm XCmdArrForm GhcTc
x LHsExpr GhcTc
op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
args)
  = do LocatedA (HsExpr GhcTc)
new_op <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
op
       [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
new_args <- (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)))
-> [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated (SrcAnn NoEpAnns) (HsCmdTop 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 LHsCmdTop GhcTc -> ZonkTcM (LHsCmdTop GhcTc)
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc))
zonkCmdTop [LHsCmdTop GhcTc]
[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
args
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrForm GhcTc
-> LHsExpr GhcTc
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcTc]
-> HsCmd GhcTc
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
new_args)

zonkCmd (HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
c LHsExpr GhcTc
e)
  = do LocatedA (HsCmd GhcTc)
new_c <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
c
       LocatedA (HsExpr GhcTc)
new_e <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdApp GhcTc -> LHsCmd GhcTc -> LHsExpr GhcTc -> HsCmd GhcTc
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_c LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e)

zonkCmd (HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
matches)
  = do MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_matches <- (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))) ~ SrcAnn NoEpAnns) =>
(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))
matches
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLam GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_matches)

zonkCmd (HsCmdPar XCmdPar GhcTc
x LHsToken "(" GhcTc
lpar LHsCmd GhcTc
c LHsToken ")" GhcTc
rpar)
  = do LocatedA (HsCmd GhcTc)
new_c <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
c
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdPar GhcTc
-> LHsToken "(" GhcTc
-> LHsCmd GhcTc
-> LHsToken ")" GhcTc
-> HsCmd GhcTc
forall id.
XCmdPar id
-> LHsToken "(" id -> LHsCmd id -> LHsToken ")" id -> HsCmd id
HsCmdPar XCmdPar GhcTc
x LHsToken "(" GhcTc
lpar LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_c LHsToken ")" GhcTc
rpar)

zonkCmd (HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsCmd GhcTc)
ms)
  = do LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
       MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdCase GhcTc
-> LHsExpr GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_ms)

zonkCmd (HsCmdLamCase XCmdLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsCmd GhcTc)
ms)
  = do MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
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))) ~ SrcAnn NoEpAnns) =>
(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
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLamCase GhcTc
-> LamCaseVariant -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id.
XCmdLamCase id
-> LamCaseVariant -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLamCase XCmdLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
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 { LocatedA (HsExpr GhcTc)
new_ePred <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
ePred
       ; LocatedA (HsCmd GhcTc)
new_cThen <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
cThen
       ; LocatedA (HsCmd GhcTc)
new_cElse <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
cElse
       ; HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdIf GhcTc
-> SyntaxExpr GhcTc
-> LHsExpr GhcTc
-> LHsCmd GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdIf id
-> SyntaxExpr id
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcTc
x SyntaxExpr GhcTc
SyntaxExprTc
new_eCond LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_ePred LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_cThen LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_cElse) }

zonkCmd (HsCmdLet XCmdLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
binds LHsToken "in" GhcTc
tkIn 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 LocatedA (HsCmd GhcTc)
new_cmd <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
cmd
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLet GhcTc
-> LHsToken "let" GhcTc
-> HsLocalBinds GhcTc
-> LHsToken "in" GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdLet id
-> LHsToken "let" id
-> HsLocalBinds id
-> LHsToken "in" id
-> LHsCmd id
-> HsCmd id
HsCmdLet XCmdLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
new_binds LHsToken "in" GhcTc
tkIn LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_cmd)

zonkCmd (HsCmdDo XCmdDo GhcTc
ty (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
stmts))
  = do [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
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
       Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XCmdDo GhcTc
Kind
ty
       HsCmd GhcTc -> ZonkTcM (HsCmd GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdDo GhcTc -> XRec GhcTc [CmdLStmt GhcTc] -> HsCmd GhcTc
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo XCmdDo GhcTc
Kind
new_ty (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
new_stmts))



zonkCmdTop :: LHsCmdTop GhcTc -> ZonkTcM (LHsCmdTop GhcTc)
zonkCmdTop :: LHsCmdTop GhcTc -> ZonkTcM (LHsCmdTop GhcTc)
zonkCmdTop LHsCmdTop GhcTc
cmd = (HsCmdTop GhcTc -> ZonkTcM (HsCmdTop GhcTc))
-> GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkMA (HsCmdTop GhcTc -> ZonkTcM (HsCmdTop GhcTc)
zonk_cmd_top) LHsCmdTop GhcTc
GenLocated (SrcAnn NoEpAnns) (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 LocatedA (HsCmd GhcTc)
new_cmd <- LHsCmd GhcTc -> ZonkTcM (LHsCmd GhcTc)
zonkLCmd LHsCmd GhcTc
cmd
       Kind
new_stack_tys <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
stack_tys
       Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       CmdSyntaxTable GhcTc
new_ids <- (HsExpr GhcTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> CmdSyntaxTable GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (CmdSyntaxTable GhcTc)
forall (m :: * -> *) (f :: * -> *) b c a.
(Applicative m, Traversable f) =>
(b -> m c) -> f (a, b) -> m (f (a, c))
mapSndM HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr CmdSyntaxTable GhcTc
ids

       Bool -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Kind -> Bool
isLiftedTypeKind (HasDebugCallStack => Kind -> Kind
Kind -> Kind
typeKind Kind
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

       HsCmdTop GhcTc -> ZonkTcM (HsCmdTop GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdTop GhcTc -> LHsCmd GhcTc -> HsCmdTop GhcTc
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop (Kind -> Kind -> CmdSyntaxTable GhcTc -> CmdTopTc
CmdTopTc Kind
new_stack_tys Kind
new_ty CmdSyntaxTable GhcTc
new_ids) LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
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 { HsWrapper
c1' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
c1
                                ; HsWrapper
c2' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
c2
                                ; 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 -> HsWrapper -> HsWrapper
WpCompose HsWrapper
c1' HsWrapper
c2') }
zonkCoFn (WpFun HsWrapper
c1 HsWrapper
c2 Scaled Kind
t1)  = do { HsWrapper
c1' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
c1
                                ; HsWrapper
c2' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
c2
                                ; Scaled Kind
t1' <- ZonkTcM (Scaled Kind)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Scaled Kind)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM (Scaled Kind)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Scaled Kind))
-> ZonkTcM (Scaled Kind)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Scaled Kind)
forall a b. (a -> b) -> a -> b
$ Scaled Kind -> ZonkTcM (Scaled Kind)
zonkScaledTcTypeToTypeX Scaled Kind
t1
                                ; 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 -> HsWrapper -> Scaled Kind -> HsWrapper
WpFun HsWrapper
c1' HsWrapper
c2' Scaled Kind
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  { Kind
ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
        ; HsExpr GhcTc
e' <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
e
        ; HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit GhcTc
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 Maybe QuoteWrapper
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
       [PendingTcSplice]
bs' <- (PendingTcSplice
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) PendingTcSplice)
-> [PendingTcSplice]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [PendingTcSplice]
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 PendingTcSplice
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) PendingTcSplice
zonk_b [PendingTcSplice]
bs
       Kind
new_ty <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       HsBracketTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) HsBracketTc
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsQuote GhcRn
-> Kind -> Maybe QuoteWrapper -> [PendingTcSplice] -> HsBracketTc
HsBracketTc HsQuote GhcRn
hsb_thing Kind
new_ty Maybe QuoteWrapper
wrap' [PendingTcSplice]
bs')
  where
    zonkQuoteWrap :: QuoteWrapper -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) QuoteWrapper
zonkQuoteWrap (QuoteWrapper Id
ev Kind
ty) = do
        Id
ev' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
ev
        Kind
ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
        QuoteWrapper -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) QuoteWrapper
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Kind -> QuoteWrapper
QuoteWrapper Id
ev' Kind
ty')

    zonk_b :: PendingTcSplice
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) PendingTcSplice
zonk_b (PendingTcSplice Name
n LHsExpr GhcTc
e) = do LocatedA (HsExpr GhcTc)
e' <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
                                      PendingTcSplice
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) PendingTcSplice
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> LHsExpr GhcTc -> PendingTcSplice
PendingTcSplice Name
n LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
e')

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

zonkArithSeq :: ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
zonkArithSeq (From LHsExpr GhcTc
e)
  = do LocatedA (HsExpr GhcTc)
new_e <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
       ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> ArithSeqInfo id
From LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e)

zonkArithSeq (FromThen LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do LocatedA (HsExpr GhcTc)
new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       LocatedA (HsExpr GhcTc)
new_e2 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e2
       ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2)

zonkArithSeq (FromTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do LocatedA (HsExpr GhcTc)
new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       LocatedA (HsExpr GhcTc)
new_e2 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e2
       ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2)

zonkArithSeq (FromThenTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do LocatedA (HsExpr GhcTc)
new_e1 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e1
       LocatedA (HsExpr GhcTc)
new_e2 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e2
       LocatedA (HsExpr GhcTc)
new_e3 <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e3
       ArithSeqInfo GhcTc -> ZonkTcM (ArithSeqInfo GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
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 { GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
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 (SrcSpanAnn' ann) a
-> ZonkBndrTcM (GenLocated (SrcSpanAnn' 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
                            ; [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
ss' <- (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [LStmt GhcTc (LocatedA (body 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 LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody [LStmt GhcTc (LocatedA (body GhcTc))]
ss
                            ; [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 (GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s' GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
forall a. a -> [a] -> [a]
: [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
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 { SyntaxExprTc
new_bind_op <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
bind_op
       ; Kind
new_bind_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 XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
bind_ty
       ; [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [ParStmtBlock GhcTc GhcTc]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) [ParStmtBlock GhcTc GhcTc]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [ParStmtBlock GhcTc GhcTc]
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv)) [ParStmtBlock GhcTc GhcTc])
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [ParStmtBlock GhcTc GhcTc]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) [ParStmtBlock GhcTc GhcTc]
forall a b. (a -> b) -> a -> b
$ (ParStmtBlock GhcTc GhcTc
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [ParStmtBlock 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 ParStmtBlock GhcTc GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc)
zonk_branch [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs

       -- Add in the binders after we're done with all the branches.
       ; let new_binders :: [Id]
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 ]
       ; [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec [Id]
new_binders
       ; HsExpr GhcTc
new_mzip <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
mzip_op
       ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> HsExpr GhcTc
-> SyntaxExpr GhcTc
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
new_bind_ty [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs HsExpr GhcTc
new_mzip SyntaxExpr GhcTc
SyntaxExprTc
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 { [Id]
new_bndrs <- [Id] -> ZonkTcM [Id]
zonkIdOccs [IdP GhcTc]
[Id]
bndrs
            ; ParStmtBlock GhcTc GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ParStmtBlock GhcTc GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParStmtBlock GhcTc GhcTc
-> [GuardLStmt GhcTc]
-> [IdP GhcTc]
-> SyntaxExpr GhcTc
-> ParStmtBlock GhcTc GhcTc
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock GhcTc GhcTc
x [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts [IdP GhcTc]
[Id]
new_bndrs SyntaxExpr GhcTc
SyntaxExprTc
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 { SyntaxExprTc
new_bind_id <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
bind_id
       ; SyntaxExprTc
new_mfix_id <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
mfix_id
       ; SyntaxExprTc
new_ret_id  <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
ret_id
       ; Kind
new_bind_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 Kind
bind_ty
       ; [Id]
new_rvs     <- ZonkTcM [Id] -> ZonkBndrTcM [Id]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM [Id] -> ZonkBndrTcM [Id])
-> ZonkTcM [Id] -> ZonkBndrTcM [Id]
forall a b. (a -> b) -> a -> b
$ [Id] -> ZonkTcM [Id]
zonkIdBndrs [IdP GhcTc]
[Id]
rvs
       ; [Id]
new_lvs     <- ZonkTcM [Id] -> ZonkBndrTcM [Id]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM [Id] -> ZonkBndrTcM [Id])
-> ZonkTcM [Id] -> ZonkBndrTcM [Id]
forall a b. (a -> b) -> a -> b
$ [Id] -> ZonkTcM [Id]
zonkIdBndrs [IdP GhcTc]
[Id]
lvs
       ; Kind
new_ret_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 Kind
ret_ty

    -- Zonk the ret-expressions in an environment that
    -- has the polymorphic bindings
       ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
rec_stmt <- ZonkT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkBndrTcM (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)))
 -> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => ZonkBndrT m a -> ZonkT m a
don'tBind (ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$
          do { [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec [Id]
new_rvs
             ; [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
new_segStmts   <- (LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc)))
-> [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
-> ZonkBndrTcM [LStmtLR GhcTc GhcTc (LocatedA (body 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 LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
segStmts
             ; [HsExpr GhcTc]
new_later_rets <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc])
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
forall a b. (a -> b) -> a -> b
$ (HsExpr GhcTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> [HsExpr GhcTc]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [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 HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr [HsExpr GhcTc]
later_rets
             ; [HsExpr GhcTc]
new_rec_rets   <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc])
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [HsExpr GhcTc]
forall a b. (a -> b) -> a -> b
$ (HsExpr GhcTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> [HsExpr GhcTc]
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) [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 HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr [HsExpr GhcTc]
rec_rets
             ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
 -> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$
               RecStmt { recS_stmts :: XRec GhcTc [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
recS_stmts = [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
forall a an. a -> LocatedAn an a
noLocA [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
new_segStmts
                       , recS_later_ids :: [IdP GhcTc]
recS_later_ids = [IdP GhcTc]
[Id]
new_lvs
                       , recS_rec_ids :: [IdP GhcTc]
recS_rec_ids = [IdP GhcTc]
[Id]
new_rvs, recS_ret_fn :: SyntaxExpr GhcTc
recS_ret_fn = SyntaxExpr GhcTc
SyntaxExprTc
new_ret_id
                       , recS_mfix_fn :: SyntaxExpr GhcTc
recS_mfix_fn = SyntaxExpr GhcTc
SyntaxExprTc
new_mfix_id, recS_bind_fn :: SyntaxExpr GhcTc
recS_bind_fn = SyntaxExpr GhcTc
SyntaxExprTc
new_bind_id
                       , recS_ext :: XRecStmt GhcTc GhcTc (LocatedA (body GhcTc))
recS_ext = RecStmtTc
                           { recS_bind_ty :: Kind
recS_bind_ty = Kind
new_bind_ty
                           , recS_later_rets :: [HsExpr GhcTc]
recS_later_rets = [HsExpr GhcTc]
new_later_rets
                           , recS_rec_rets :: [HsExpr GhcTc]
recS_rec_rets = [HsExpr GhcTc]
new_rec_rets
                           , recS_ret_ty :: Kind
recS_ret_ty = Kind
new_ret_ty } } }

    -- Only the lvs are needed
       ; [Id] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). [Id] -> ZonkBndrT m ()
extendIdZonkEnvRec [Id]
new_lvs
       ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
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 { SyntaxExprTc
new_then_op  <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
then_op
       ; SyntaxExprTc
new_guard_op <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
guard_op
       ; LocatedA (body GhcTc)
new_body     <- ZonkTcM (LocatedA (body GhcTc))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (body GhcTc))
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM (LocatedA (body GhcTc))
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (body GhcTc)))
-> ZonkTcM (LocatedA (body GhcTc))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (body GhcTc))
forall a b. (a -> b) -> a -> b
$ LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody LocatedA (body GhcTc)
body
       ; Kind
new_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  XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
ty
       ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
 -> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LocatedA (body GhcTc)
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
new_ty LocatedA (body GhcTc)
new_body SyntaxExpr GhcTc
SyntaxExprTc
new_then_op SyntaxExpr GhcTc
SyntaxExprTc
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)))
-> ZonkBndrTcM (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)))
 -> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> ZonkBndrTcM (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 { LocatedA (body GhcTc)
new_body <- LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody LocatedA (body GhcTc)
body
       ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LocatedA (body GhcTc)
-> Maybe Bool
-> SyntaxExpr GhcTc
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
x LocatedA (body GhcTc)
new_body Maybe Bool
noret SyntaxExpr GhcTc
SyntaxExprTc
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 { SyntaxExprTc
bind_op'     <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
bind_op
       ; Kind
bind_arg_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 XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
bind_arg_ty
       ; [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts'       <- (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
       ; Maybe (LocatedA (HsExpr GhcTc))
by'          <- ZonkT
  (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe (LocatedA (HsExpr GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe (LocatedA (HsExpr GhcTc)))
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT
   (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe (LocatedA (HsExpr GhcTc)))
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe (LocatedA (HsExpr GhcTc))))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe (LocatedA (HsExpr GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe (LocatedA (HsExpr GhcTc)))
forall a b. (a -> b) -> a -> b
$ (LocatedA (HsExpr GhcTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc)))
-> Maybe (LocatedA (HsExpr GhcTc))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe (LocatedA (HsExpr 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) -> Maybe a -> f (Maybe b)
traverse LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
LocatedA (HsExpr GhcTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (HsExpr GhcTc))
zonkLExpr Maybe (LHsExpr GhcTc)
Maybe (LocatedA (HsExpr GhcTc))
by
       ; LocatedA (HsExpr GhcTc)
using'       <- 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
using
       ; SyntaxExprTc
return_op'   <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
return_op
       ; HsExpr GhcTc
liftM_op'    <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
liftM_op
       ; [(Id, Id)]
binderMap'   <- ((Id, Id) -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, Id))
-> [(Id, Id)]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [(Id, 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, Id) -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, Id)
zonkBinderMapEntry [(IdP GhcTc, IdP GhcTc)]
[(Id, Id)]
binderMap
       ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TransStmt { trS_stmts :: [GuardLStmt GhcTc]
trS_stmts = [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts', trS_bndrs :: [(IdP GhcTc, IdP GhcTc)]
trS_bndrs = [(IdP GhcTc, IdP GhcTc)]
[(Id, Id)]
binderMap'
                           , trS_by :: Maybe (LHsExpr GhcTc)
trS_by = Maybe (LHsExpr GhcTc)
Maybe (LocatedA (HsExpr GhcTc))
by', trS_form :: TransForm
trS_form = TransForm
form, trS_using :: LHsExpr GhcTc
trS_using = LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
using'
                           , trS_ret :: SyntaxExpr GhcTc
trS_ret = SyntaxExpr GhcTc
SyntaxExprTc
return_op', trS_bind :: SyntaxExpr GhcTc
trS_bind = SyntaxExpr GhcTc
SyntaxExprTc
bind_op'
                           , trS_ext :: XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
trS_ext = XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
bind_arg_ty'
                           , trS_fmap :: HsExpr GhcTc
trS_fmap = HsExpr GhcTc
liftM_op' }) }
  where
    zonkBinderMapEntry :: (Id, Id) -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, Id)
zonkBinderMapEntry (Id
oldBinder, Id
newBinder) = do
        Id
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
        Id
newBinder' <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
newBinder
        (Id, Id) -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, Id)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
oldBinder', Id
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)
-> ZonkBndrTcM (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  { SyntaxExprTc
new_bind    <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr (XBindStmtTc -> SyntaxExpr GhcTc
xbstc_bindOp XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs)
        ; Kind
new_w       <- 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 (XBindStmtTc -> Kind
xbstc_boundResultMult XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs)
        ; Kind
new_bind_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 (XBindStmtTc -> Kind
xbstc_boundResultType XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs)
        ; LocatedA (body GhcTc)
new_body    <- ZonkTcM (LocatedA (body GhcTc))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (body GhcTc))
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM (LocatedA (body GhcTc))
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (body GhcTc)))
-> ZonkTcM (LocatedA (body GhcTc))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv)) (LocatedA (body GhcTc))
forall a b. (a -> b) -> a -> b
$ LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
zBody LocatedA (body GhcTc)
body
        ; Maybe SyntaxExprTc
new_fail <- case XBindStmtTc -> Maybe (SyntaxExpr GhcTc)
xbstc_failOp XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
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)

        ; GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat     <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
 -> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$
            XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LPat GhcTc
-> LocatedA (body GhcTc)
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt
            (XBindStmtTc
              { xbstc_bindOp :: SyntaxExpr GhcTc
xbstc_bindOp = SyntaxExpr GhcTc
SyntaxExprTc
new_bind
              , xbstc_boundResultType :: Kind
xbstc_boundResultType = Kind
new_bind_ty
              , xbstc_boundResultMult :: Kind
xbstc_boundResultMult = Kind
new_w
              , xbstc_failOp :: Maybe (SyntaxExpr GhcTc)
xbstc_failOp = Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
new_fail
              })
            LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat LocatedA (body GhcTc)
new_body }

-- Scopes: join > ops (in reverse order) > pats (in forward order)
--              > rest of stmts
zonkStmt LocatedA (body GhcTc) -> ZonkTcM (LocatedA (body GhcTc))
_zBody (ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args Maybe (SyntaxExpr GhcTc)
mb_join)
  = do  { Maybe SyntaxExprTc
new_mb_join   <- Maybe SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
zonk_join Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
mb_join
        ; [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args      <- [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
zonk_args [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
[(SyntaxExprTc, ApplicativeArg GhcTc)]
args
        ; Kind
new_body_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 XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
body_ty
        ; StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
 -> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> ZonkBndrTcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a b. (a -> b) -> a -> b
$ XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> Maybe (SyntaxExpr GhcTc)
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
new_body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
[(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
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 { [(SyntaxExprTc, ApplicativeArg GhcTc)]
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)
           ; [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats     <- [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
zonkPats (((SyntaxExprTc, ApplicativeArg GhcTc)
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
(SyntaxExprTc, ApplicativeArg GhcTc)
-> GenLocated SrcSpanAnnA (Pat GhcTc)
get_pat [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
           ; [(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 ([(SyntaxExprTc, ApplicativeArg GhcTc)]
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a b. (a -> b) -> a -> b
$ String
-> (GenLocated SrcSpanAnnA (Pat GhcTc)
    -> (SyntaxExprTc, ApplicativeArg GhcTc)
    -> (SyntaxExprTc, ApplicativeArg GhcTc))
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a b c.
HasDebugCallStack =>
String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"zonkStmt" LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
GenLocated SrcSpanAnnA (Pat GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc)
replace_pat
                        [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats ([(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExprTc, ApplicativeArg GhcTc)]
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 { SyntaxExprTc
new_op   <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
SyntaxExprTc
op
           ; ApplicativeArg GhcTc
new_arg  <- ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
forall a b. (a -> b) -> a -> b
$ ApplicativeArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
zonk_arg ApplicativeArg GhcTc
arg
           ; [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args <- [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
zonk_args_rev [(SyntaxExprTc, ApplicativeArg GhcTc)]
args
           ; [(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 ([(SyntaxExprTc, ApplicativeArg GhcTc)]
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a b. (a -> b) -> a -> b
$ (SyntaxExprTc
new_op, ApplicativeArg GhcTc
new_arg) (SyntaxExprTc, ApplicativeArg GhcTc)
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. a -> [a] -> [a]
: [(SyntaxExprTc, ApplicativeArg GhcTc)]
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 { LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
expr
           ; Maybe SyntaxExprTc
new_fail <- Maybe SyntaxExprTc
-> (SyntaxExprTc
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc)
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe SyntaxExprTc
XApplicativeArgOne GhcTc
fail_op ((SyntaxExprTc
  -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc)
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Maybe SyntaxExprTc))
-> (SyntaxExprTc
    -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc)
-> ZonkT (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 (ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
 -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc)
-> (SyntaxExprTc
    -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc)
-> SyntaxExprTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
SyntaxExprTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) SyntaxExprTc
zonkSyntaxExpr
           ; ApplicativeArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgOne GhcTc
-> LPat GhcTc -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne Maybe SyntaxExprTc
XApplicativeArgOne GhcTc
new_fail LPat GhcTc
pat LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr Bool
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 { HsExpr GhcTc
new_ret <- HsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
ret
           ; ApplicativeArg GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (ApplicativeArg GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (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]
[GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts HsExpr GhcTc
new_ret LPat GhcTc
pat HsDoFlavour
ctxt) }

-------------------------------------------------------------------------
zonkRecFields :: HsRecordBinds GhcTc -> ZonkTcM (HsRecordBinds GhcTc)
zonkRecFields :: HsRecordBinds GhcTc -> ZonkTcM (HsRecordBinds GhcTc)
zonkRecFields (HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
flds Maybe (XRec GhcTc RecFieldsDotDot)
dd)
  = do  { [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (LocatedA (HsExpr GhcTc)))]
flds' <- (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (LocatedA (HsExpr GhcTc)))
 -> ZonkT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
            (LocatedA (HsExpr GhcTc)))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (LocatedA (HsExpr GhcTc)))]
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc))))
forall {l} {ann}.
GenLocated
  l
  (HsFieldBind
     (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        l
        (HsFieldBind
           (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc))))
zonk_rbind [LHsRecField GhcTc (LHsExpr GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (LocatedA (HsExpr GhcTc)))]
flds
        ; HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsRecFields GhcTc (LocatedA (HsExpr GhcTc)))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsRecField GhcTc (LocatedA (HsExpr GhcTc))]
-> Maybe (XRec GhcTc RecFieldsDotDot)
-> HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
forall p arg.
[LHsRecField p arg]
-> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
HsRecFields [LHsRecField GhcTc (LocatedA (HsExpr GhcTc))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (LocatedA (HsExpr GhcTc)))]
flds' Maybe (XRec GhcTc RecFieldsDotDot)
dd) }
  where
    zonk_rbind :: GenLocated
  l
  (HsFieldBind
     (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        l
        (HsFieldBind
           (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc))))
zonk_rbind (L l
l HsFieldBind
  (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
  (LocatedA (HsExpr GhcTc))
fld)
      = do { GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc)
new_id   <- (FieldOcc GhcTc -> ZonkTcM (FieldOcc GhcTc))
-> GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc)
-> ZonkTcM (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
forall a b ann.
(a -> ZonkTcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' ann) b)
wrapLocZonkMA FieldOcc GhcTc -> ZonkTcM (FieldOcc GhcTc)
zonkFieldOcc (HsFieldBind
  (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
  (LocatedA (HsExpr GhcTc))
-> GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS HsFieldBind
  (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
  (LocatedA (HsExpr GhcTc))
fld)
           ; LocatedA (HsExpr GhcTc)
new_expr <- LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr (HsFieldBind
  (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
  (LocatedA (HsExpr GhcTc))
-> LocatedA (HsExpr GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
  (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
  (LocatedA (HsExpr GhcTc))
fld)
           ; GenLocated
  l
  (HsFieldBind
     (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc)))
-> ZonkT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated
        l
        (HsFieldBind
           (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
           (LocatedA (HsExpr GhcTc))))
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (l
-> HsFieldBind
     (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
     (LocatedA (HsExpr GhcTc))
-> GenLocated
     l
     (HsFieldBind
        (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
        (LocatedA (HsExpr GhcTc)))
forall l e. l -> e -> GenLocated l e
L l
l (HsFieldBind
  (GenLocated (SrcSpanAnn' ann) (FieldOcc GhcTc))
  (LocatedA (HsExpr GhcTc))
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 (SrcSpanAnn' ann) a
-> ZonkBndrTcM (GenLocated (SrcSpanAnn' 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 LHsToken "(" GhcTc
lpar LPat GhcTc
p LHsToken ")" GhcTc
rpar)
  = do  { GenLocated SrcSpanAnnA (Pat GhcTc)
p' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
p
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParPat GhcTc
-> LHsToken "(" GhcTc
-> LPat GhcTc
-> LHsToken ")" GhcTc
-> Pat GhcTc
forall p.
XParPat p -> LHsToken "(" p -> LPat p -> LHsToken ")" p -> Pat p
ParPat XParPat GhcTc
x LHsToken "(" GhcTc
lpar LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
p' LHsToken ")" GhcTc
rpar) }

zonk_pat (WildPat XWildPat GhcTc
ty)
  = do  { Kind
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
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XWildPat GhcTc -> Pat GhcTc
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcTc
Kind
ty') }

zonk_pat (VarPat XVarPat GhcTc
x (L SrcSpanAnnN
l Id
v))
  = do  { Id
v' <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
v
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XVarPat GhcTc -> LIdP GhcTc -> Pat GhcTc
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcTc
x (SrcSpanAnnN -> Id -> GenLocated SrcSpanAnnN Id
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l Id
v')) }

zonk_pat (LazyPat XLazyPat GhcTc
x LPat GhcTc
pat)
  = do  { GenLocated SrcSpanAnnA (Pat GhcTc)
pat' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLazyPat GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XLazyPat p -> LPat p -> Pat p
LazyPat XLazyPat GhcTc
x LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat (BangPat XBangPat GhcTc
x LPat GhcTc
pat)
  = do  { GenLocated SrcSpanAnnA (Pat GhcTc)
pat' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XBangPat GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XBangPat p -> LPat p -> Pat p
BangPat XBangPat GhcTc
x LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat (AsPat XAsPat GhcTc
x (L SrcSpanAnnN
loc Id
v) LHsToken "@" GhcTc
at LPat GhcTc
pat)
  = do  { Id
v'   <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
v
        ; GenLocated SrcSpanAnnA (Pat GhcTc)
pat' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XAsPat GhcTc
-> LIdP GhcTc -> LHsToken "@" GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XAsPat p -> LIdP p -> LHsToken "@" p -> LPat p -> Pat p
AsPat XAsPat GhcTc
x (SrcSpanAnnN -> Id -> GenLocated SrcSpanAnnN Id
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc Id
v') LHsToken "@" GhcTc
at LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat (ViewPat XViewPat GhcTc
ty LHsExpr GhcTc
expr LPat GhcTc
pat)
  = do  { LocatedA (HsExpr GhcTc)
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
        ; GenLocated SrcSpanAnnA (Pat GhcTc)
pat'  <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; Kind
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 XViewPat GhcTc
Kind
ty
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XViewPat GhcTc -> LHsExpr GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat XViewPat GhcTc
Kind
ty' LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
expr' LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat (ListPat XListPat GhcTc
ty [LPat GhcTc]
pats)
  = do  { Kind
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
        ; [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats' <- [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
zonkPats [LPat GhcTc]
pats
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XListPat GhcTc -> [LPat GhcTc] -> Pat GhcTc
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat GhcTc
Kind
ty' [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') }

zonk_pat (TuplePat XTuplePat GhcTc
tys [LPat GhcTc]
pats Boxity
boxed)
  = do  { [Kind]
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
        ; [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats' <- [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
zonkPats [LPat GhcTc]
pats
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTuplePat GhcTc -> [LPat GhcTc] -> Boxity -> Pat GhcTc
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat [Kind]
XTuplePat GhcTc
tys' [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
pats' Boxity
boxed) }

zonk_pat (SumPat XSumPat GhcTc
tys LPat GhcTc
pat ConTag
alt ConTag
arity )
  = do  { [Kind]
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
        ; GenLocated SrcSpanAnnA (Pat GhcTc)
pat' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XSumPat GhcTc -> LPat GhcTc -> ConTag -> ConTag -> Pat GhcTc
forall p. XSumPat p -> LPat p -> ConTag -> ConTag -> Pat p
SumPat [Kind]
XSumPat GhcTc
tys' LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat' ConTag
alt ConTag
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  { [Kind]
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
        ; [Id]
new_tyvars  <- [Id] -> ZonkBndrTcM [Id]
zonkTyBndrsX [Id]
tyvars
          -- Must zonk the existential variables, because their
          -- /kind/ need potential zonking.
          -- cf typecheck/should_compile/tc221.hs
        ; [Id]
new_evs     <- [Id] -> ZonkBndrTcM [Id]
zonkEvBndrsX [Id]
evs
        ; TcEvBinds
new_binds   <- TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds TcEvBinds
binds
        ; HsWrapper
new_wrapper <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
wrapper
        ; HsConDetails
  (HsConPatTyArg GhcRn)
  (GenLocated SrcSpanAnnA (Pat GhcTc))
  (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
new_args    <- HsConPatDetails GhcTc -> ZonkBndrTcM (HsConPatDetails GhcTc)
zonkConStuff HsConPatDetails GhcTc
args
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat GhcTc -> ZonkBndrTcM (Pat GhcTc))
-> Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a b. (a -> b) -> a -> b
$ Pat GhcTc
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  { Kind
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
        ; GenLocated SrcSpanAnnA (Pat GhcTc)
pat' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
pat
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XSigPat GhcTc
-> LPat GhcTc -> HsPatSigType (NoGhcTc GhcTc) -> Pat GhcTc
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat XSigPat GhcTc
Kind
ty' LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat' HsPatSigType (NoGhcTc GhcTc)
hs_ty) }

zonk_pat (NPat XNPat GhcTc
ty (L SrcAnn NoEpAnns
l HsOverLit GhcTc
lit) Maybe (SyntaxExpr GhcTc)
mb_neg SyntaxExpr GhcTc
eq_expr)
  =  do { SyntaxExprTc
eq_expr' <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
eq_expr
        ; Maybe SyntaxExprTc
mb_neg' <- case Maybe (SyntaxExpr GhcTc)
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
        ; ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Pat GhcTc)
-> ZonkBndrTcM (Pat GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Pat GhcTc)
 -> ZonkBndrTcM (Pat GhcTc))
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Pat GhcTc)
-> ZonkBndrTcM (Pat GhcTc)
forall a b. (a -> b) -> a -> b
$
     do { HsOverLit GhcTc
lit' <- HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
zonkOverLit HsOverLit GhcTc
lit
        ; Kind
ty'  <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX XNPat GhcTc
Kind
ty
        ; Pat GhcTc -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Pat GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XNPat GhcTc
-> XRec GhcTc (HsOverLit GhcTc)
-> Maybe (SyntaxExpr GhcTc)
-> SyntaxExpr GhcTc
-> Pat GhcTc
forall p.
XNPat p
-> XRec p (HsOverLit p)
-> Maybe (SyntaxExpr p)
-> SyntaxExpr p
-> Pat p
NPat XNPat GhcTc
Kind
ty' (SrcAnn NoEpAnns
-> HsOverLit GhcTc
-> GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l HsOverLit GhcTc
lit') Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
mb_neg' SyntaxExpr GhcTc
SyntaxExprTc
eq_expr') } }

zonk_pat (NPlusKPat XNPlusKPat GhcTc
ty (L SrcSpanAnnN
loc Id
n) (L SrcAnn NoEpAnns
l HsOverLit GhcTc
lit1) HsOverLit GhcTc
lit2 SyntaxExpr GhcTc
e1 SyntaxExpr GhcTc
e2)
  = do  { SyntaxExprTc
e1' <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr  SyntaxExpr GhcTc
e1
        ; SyntaxExprTc
e2' <- SyntaxExpr GhcTc -> ZonkBndrTcM (SyntaxExpr GhcTc)
zonkSyntaxExpr SyntaxExpr GhcTc
e2
        ; HsOverLit GhcTc
lit1' <- ZonkTcM (HsOverLit GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsOverLit GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM (HsOverLit GhcTc)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsOverLit GhcTc))
-> ZonkTcM (HsOverLit GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsOverLit GhcTc)
forall a b. (a -> b) -> a -> b
$ HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
zonkOverLit HsOverLit GhcTc
lit1
        ; HsOverLit GhcTc
lit2' <- ZonkTcM (HsOverLit GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsOverLit GhcTc)
forall (m :: * -> *) a. Monad m => ZonkT m a -> ZonkBndrT m a
noBinders (ZonkTcM (HsOverLit GhcTc)
 -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsOverLit GhcTc))
-> ZonkTcM (HsOverLit GhcTc)
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (HsOverLit GhcTc)
forall a b. (a -> b) -> a -> b
$ HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc)
zonkOverLit HsOverLit GhcTc
lit2
        ; Kind
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 XNPlusKPat GhcTc
Kind
ty
        ; Id
n'    <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndrX Id
n
        ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XNPlusKPat GhcTc
-> LIdP GhcTc
-> XRec GhcTc (HsOverLit GhcTc)
-> HsOverLit GhcTc
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Pat GhcTc
forall p.
XNPlusKPat p
-> LIdP p
-> XRec p (HsOverLit p)
-> HsOverLit p
-> SyntaxExpr p
-> SyntaxExpr p
-> Pat p
NPlusKPat XNPlusKPat GhcTc
Kind
ty' (SrcSpanAnnN -> Id -> GenLocated SrcSpanAnnN Id
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc Id
n') (SrcAnn NoEpAnns
-> HsOverLit GhcTc
-> GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l HsOverLit GhcTc
lit1') HsOverLit GhcTc
lit2' SyntaxExpr GhcTc
SyntaxExprTc
e1' SyntaxExpr GhcTc
SyntaxExprTc
e2') }

zonk_pat (XPat XXPat GhcTc
ext) = case XXPat GhcTc
ext of
  { ExpansionPat Pat GhcRn
orig Pat GhcTc
pat->
    do { Pat GhcTc
pat' <- Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
zonk_pat Pat GhcTc
pat
       ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcTc -> ZonkBndrTcM (Pat GhcTc))
-> Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a b. (a -> b) -> a -> b
$ XXPat GhcTc -> Pat GhcTc
forall p. XXPat p -> Pat p
XPat (XXPat GhcTc -> Pat GhcTc) -> XXPat GhcTc -> Pat GhcTc
forall a b. (a -> b) -> a -> b
$ Pat GhcRn -> Pat GhcTc -> XXPatGhcTc
ExpansionPat Pat GhcRn
orig Pat GhcTc
pat' }
  ; CoPat HsWrapper
co_fn Pat GhcTc
pat Kind
ty ->
    do { HsWrapper
co_fn' <- HsWrapper -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) HsWrapper
zonkCoFn HsWrapper
co_fn
       ; GenLocated SrcSpanAnnA (Pat GhcTc)
pat'   <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat (Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
forall a an. a -> LocatedAn an a
noLocA Pat GhcTc
pat)
       ; Kind
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 Kind
ty
       ; Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XXPat GhcTc -> Pat GhcTc
forall p. XXPat p -> Pat p
XPat (XXPat GhcTc -> Pat GhcTc) -> XXPat GhcTc -> Pat GhcTc
forall a b. (a -> b) -> a -> b
$ HsWrapper -> Pat GhcTc -> Kind -> XXPatGhcTc
CoPat HsWrapper
co_fn' (GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat GhcTc)
pat') Kind
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  { [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats' <- [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
zonkPats [LPat GhcTc]
pats
        ; HsConDetails
  (HsConPatTyArg GhcRn)
  (GenLocated SrcSpanAnnA (Pat GhcTc))
  (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsConDetails
        (HsConPatTyArg GhcRn)
        (GenLocated SrcSpanAnnA (Pat GhcTc))
        (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([HsConPatTyArg GhcRn]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> HsConDetails
     (HsConPatTyArg GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcTc))
     (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [HsConPatTyArg (NoGhcTc GhcTc)]
[HsConPatTyArg GhcRn]
tyargs [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') }

zonkConStuff (InfixCon LPat GhcTc
p1 LPat GhcTc
p2)
  = do  { GenLocated SrcSpanAnnA (Pat GhcTc)
p1' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
p1
        ; GenLocated SrcSpanAnnA (Pat GhcTc)
p2' <- LPat GhcTc
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (LPat GhcTc)
zonkPat LPat GhcTc
p2
        ; HsConDetails
  (HsConPatTyArg GhcRn)
  (GenLocated SrcSpanAnnA (Pat GhcTc))
  (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsConDetails
        (HsConPatTyArg GhcRn)
        (GenLocated SrcSpanAnnA (Pat GhcTc))
        (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (Pat GhcTc)
-> GenLocated SrcSpanAnnA (Pat GhcTc)
-> HsConDetails
     (HsConPatTyArg GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcTc))
     (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon GenLocated SrcSpanAnnA (Pat GhcTc)
p1' GenLocated SrcSpanAnnA (Pat GhcTc)
p2') }

zonkConStuff (RecCon (HsRecFields [LHsRecField GhcTc (LPat GhcTc)]
rpats Maybe (XRec GhcTc RecFieldsDotDot)
dd))
  = do  { [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats' <- [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
zonkPats ((GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
   (GenLocated SrcSpanAnnA (Pat GhcTc))
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
forall l e. GenLocated l e -> e
unLoc) [LHsRecField GhcTc (LPat GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats)
        ; let rpats' :: [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats' = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
 -> GenLocated SrcSpanAnnA (Pat GhcTc)
 -> GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(L SrcSpanAnnA
l HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
rp) GenLocated SrcSpanAnnA (Pat GhcTc)
p' ->
                                  SrcSpanAnnA
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
rp { hfbRHS = p' }))
                               [LHsRecField GhcTc (LPat GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats'
        ; HsConDetails
  (HsConPatTyArg GhcRn)
  (GenLocated SrcSpanAnnA (Pat GhcTc))
  (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsConDetails
        (HsConPatTyArg GhcRn)
        (GenLocated SrcSpanAnnA (Pat GhcTc))
        (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
-> HsConDetails
     (HsConPatTyArg GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcTc))
     (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon ([LHsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))]
-> Maybe (XRec GhcTc RecFieldsDotDot)
-> HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
forall p arg.
[LHsRecField p arg]
-> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
HsRecFields [LHsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats' Maybe (XRec GhcTc RecFieldsDotDot)
dd)) }
        -- Field selectors have declared types; hence no zonking

---------------------------
zonkPats :: [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
zonkPats :: [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc]
zonkPats = (GenLocated SrcSpanAnnA (Pat GhcTc)
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [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) -> [a] -> 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

{-
************************************************************************
*                                                                      *
\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 (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' 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 { GenLocated SrcSpanAnnN Id
i' <- GenLocated SrcSpanAnnN Id -> ZonkTcM (GenLocated SrcSpanAnnN Id)
zonkLIdOcc LIdP GhcTc
GenLocated SrcSpanAnnN Id
i
       ; ForeignDecl GhcTc -> ZonkTcM (ForeignDecl GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignExport { fd_name :: LIdP GhcTc
fd_name = LIdP GhcTc
GenLocated SrcSpanAnnN Id
i'
                               , fd_sig_ty :: LHsSigType GhcTc
fd_sig_ty = LHsSigType GhcTc
GenLocated SrcSpanAnnA (HsSigType GhcTc)
forall a. HasCallStack => a
undefined, fd_e_ext :: XForeignExport GhcTc
fd_e_ext = XForeignExport GhcTc
co
                               , fd_fe :: ForeignExport GhcTc
fd_fe = ForeignExport GhcTc
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 (SrcSpanAnn' ann) a
-> ZonkTcM (GenLocated (SrcSpanAnn' 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 (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
-> forall r.
   ([GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (RuleBndr GhcTc)
 -> ZonkBndrT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)))
-> [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     [GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (RuleBndr GhcTc)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc))
zonk_tm_bndr [LRuleBndr GhcTc]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
tm_bndrs) (([GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
  -> ZonkTcM (RuleDecl GhcTc))
 -> ZonkTcM (RuleDecl GhcTc))
-> ([GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
    -> ZonkTcM (RuleDecl GhcTc))
-> ZonkTcM (RuleDecl GhcTc)
forall a b. (a -> b) -> a -> b
$ \ [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
new_tm_bndrs ->
    do { -- See Note [Zonking the LHS of a RULE]
       ; LocatedA (HsExpr GhcTc)
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
       ; LocatedA (HsExpr GhcTc)
new_rhs <-                              LHsExpr GhcTc
-> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
rhs
       ; RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc))
-> RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc)
forall a b. (a -> b) -> a -> b
$ RuleDecl GhcTc
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 SrcAnn NoEpAnns
l (RuleBndr XCRuleBndr GhcTc
x (L SrcSpanAnnN
loc Id
v)))
      = do { Id
v' <- Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonk_it Id
v
           ; GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc))
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn NoEpAnns
-> RuleBndr GhcTc -> GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l (XCRuleBndr GhcTc -> LIdP GhcTc -> RuleBndr GhcTc
forall pass. XCRuleBndr pass -> LIdP pass -> RuleBndr pass
RuleBndr XCRuleBndr GhcTc
x (SrcSpanAnnN -> Id -> GenLocated SrcSpanAnnN Id
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc Id
v'))) }
   zonk_tm_bndr (L SrcAnn NoEpAnns
_ (RuleBndrSig {})) = String
-> ZonkBndrT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated (SrcAnn NoEpAnns) (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 { Id
new_body_id  <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdOcc Id
body_id
     ; 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 (EvFun { et_tvs :: [Id]
et_tvs = [Id]
new_tvs, et_given :: [Id]
et_given = [Id]
new_evs
                     , et_binds :: TcEvBinds
et_binds = TcEvBinds
new_ev_binds, et_body :: Id
et_body = Id
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 { EvExpr
scrut' <- EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
scrut
         ; Kind
ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
         ; 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
zonkIdBndrX Id
b) ((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
b' ->
      do { [Alt Id]
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
         ; 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
$ EvExpr -> Id -> Kind -> [Alt Id] -> EvExpr
forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
Case EvExpr
scrut' Id
b' Kind
ty' [Alt Id]
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 { EvExpr
rhs' <- EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
rhs
         ; Alt Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Alt Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id))
-> Alt Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Alt Id)
forall a b. (a -> b) -> a -> b
$ AltCon -> [Id] -> EvExpr -> Alt Id
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
dc [Id]
bndrs' EvExpr
rhs' }

zonkCoreBind :: CoreBind -> ZonkBndrTcM CoreBind
zonkCoreBind :: Bind Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id)
zonkCoreBind (NonRec Id
v EvExpr
e)
    = do { (Id
v',EvExpr
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)
         ; Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *). Id -> ZonkBndrT m ()
extendIdZonkEnv Id
v'
         ; Bind Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> EvExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
v' EvExpr
e') }
zonkCoreBind (Rec [(Id, EvExpr)]
pairs)
    = do [(Id, EvExpr)]
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
         Bind Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id)
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bind Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id))
-> Bind Id -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bind Id)
forall a b. (a -> b) -> a -> b
$ [(Id, EvExpr)] -> Bind Id
forall b. [(b, Expr b)] -> Bind b
Rec [(Id, EvExpr)]
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 { Id
v' <- Id -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Id
zonkIdBndr Id
v
     ; EvExpr
e' <- EvExpr -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvExpr
zonkCoreExpr EvExpr
e
     ; (Id, EvExpr) -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) (Id, EvExpr)
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
v',EvExpr
e') }

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

zonkTcEvBinds_s :: [TcEvBinds] -> ZonkBndrTcM [TcEvBinds]
zonkTcEvBinds_s :: [TcEvBinds]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [TcEvBinds]
zonkTcEvBinds_s [TcEvBinds]
bs = do { [Bag EvBind]
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
                        ; [TcEvBinds]
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [TcEvBinds]
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Bag EvBind -> TcEvBinds
EvBinds ([Bag EvBind] -> Bag EvBind
forall a. [Bag a] -> Bag a
unionManyBags [Bag EvBind]
bs')]) }

zonkTcEvBinds :: TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds :: TcEvBinds -> ZonkBndrTcM TcEvBinds
zonkTcEvBinds TcEvBinds
bs = do { Bag EvBind
bs' <- TcEvBinds -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonk_tc_ev_binds TcEvBinds
bs
                      ; TcEvBinds -> ZonkBndrTcM TcEvBinds
forall a. a -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag EvBind -> TcEvBinds
EvBinds Bag EvBind
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 { EvBindMap
bs <- IORef EvBindMap
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) EvBindMap
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef IORef EvBindMap
ref
       ; Bag EvBind
-> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) (Bag EvBind)
zonkEvBinds (EvBindMap -> Bag EvBind
evBindMapBinds EvBindMap
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 { Id
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)

       ; EvTerm
term' <- case Kind -> Maybe (Role, Kind, Kind)
getEqPredTys_maybe (Id -> Kind
idType Id
var') of
           Just (Role
r, Kind
ty1, Kind
ty2) | Kind
ty1 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

       ; EvBind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) EvBind
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EvBind
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 { Kind
ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
       ; Maybe (DefMethSpec (SrcSpan, Kind))
gdm_spec' <- Maybe (DefMethSpec (SrcSpan, Kind))
-> ZonkTcM (Maybe (DefMethSpec (SrcSpan, Kind)))
zonk_gdm Maybe (DefMethSpec (SrcSpan, Kind))
gdm_spec
       ; TcMethInfo -> ZonkTcM TcMethInfo
forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, Kind
ty', Maybe (DefMethSpec (SrcSpan, Kind))
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 { Kind
ty' <- Kind -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) Kind
zonkTcTypeToTypeX Kind
ty
           ; 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 ((SrcSpan, Kind) -> DefMethSpec (SrcSpan, Kind)
forall ty. ty -> DefMethSpec ty
GenericDM (SrcSpan
loc, Kind
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 -> TcM Coercion
unpackCoercionHole CoercionHole
hole
  = do { Maybe Coercion
contents <- CoercionHole -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion)
unpackCoercionHole_maybe CoercionHole
hole
       ; case Maybe Coercion
contents of
           Just Coercion
co -> Coercion -> TcM 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 -> TcM 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 { CtEvidence
ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                                                  ; Ct -> TcM Ct
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EqCt -> Ct
CEqCan (EqCt
eq { eq_ev = ev' })) }
      CIrredCan ir :: IrredCt
ir@(IrredCt { ir_ev :: IrredCt -> CtEvidence
ir_ev = CtEvidence
ev }) -> do { CtEvidence
ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                                                  ; Ct -> TcM Ct
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IrredCt -> Ct
CIrredCan (IrredCt
ir { ir_ev = ev' })) }
      CDictCan di :: DictCt
di@(DictCt { di_ev :: DictCt -> CtEvidence
di_ev = CtEvidence
ev })   -> do { CtEvidence
ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                                                  ; Ct -> TcM Ct
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (DictCt -> Ct
CDictCan (DictCt
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 { CtEvidence
ev' <- CtEvidence -> TcM CtEvidence
zonkCtEvRewriterSet CtEvidence
ev
                             ; Ct -> TcM Ct
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (CtEvidence -> Ct
CNonCanonical CtEvidence
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 { RewriterSet
rewriters' <- RewriterSet -> TcM RewriterSet
zonkRewriterSet RewriterSet
rewriters
       ; CtEvidence -> TcM CtEvidence
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (CtEvidence
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 { Maybe Coercion
m_co <- CoercionHole -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Coercion)
unpackCoercionHole_maybe CoercionHole
hole
                         ; case Maybe Coercion
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)