{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}

{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

Renaming of expressions

Basically dependency analysis.

Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
general, all of these functions return a renamed thing, and a set of
free variables.
-}

module GHC.Rename.Expr (
        rnLExpr, rnExpr, rnStmts, mkExpandedExpr,
        AnnoBody, UnexpectedStatement(..)
   ) where

import GHC.Prelude
import GHC.Data.FastString

import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS
                        , rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import GHC.Hs
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Env ( isBrackStage )
import GHC.Tc.Utils.Monad
import GHC.Unit.Module ( getModule, isInteractiveModule )
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( bindLocalNamesFV, checkDupNames
                        , bindLocalNames
                        , mapMaybeFvRn, mapFvRn
                        , warnUnusedLocalBinds, typeAppErr
                        , checkUnusedRecordWildcard
                        , wrapGenSpan, genHsIntegralLit, genHsTyLit
                        , genHsVar, genLHsVar, genHsApp, genHsApps
                        , genAppType )
import GHC.Rename.Unbound ( reportUnboundName )
import GHC.Rename.Splice  ( rnTypedBracket, rnUntypedBracket, rnTypedSplice, rnUntypedSpliceExpr, checkThLocalName )
import GHC.Rename.HsType
import GHC.Rename.Pat
import GHC.Driver.Session
import GHC.Builtin.Names

import GHC.Types.FieldLabel
import GHC.Types.Fixity
import GHC.Types.Id.Make
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.Unique.Set
import GHC.Types.SourceText
import GHC.Utils.Misc
import GHC.Data.List.SetOps ( removeDups )
import GHC.Utils.Error
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Outputable as Outputable
import GHC.Types.SrcLoc
import Control.Monad
import GHC.Builtin.Types ( nilDataConName )
import qualified GHC.LanguageExtensions as LangExt

import Language.Haskell.Syntax.Basic (FieldLabelString(..))

import Data.List (unzip4, minimumBy)
import Data.List.NonEmpty ( NonEmpty(..), nonEmpty )
import Data.Maybe (isJust, isNothing)
import Control.Arrow (first)
import Data.Ord
import Data.Array
import qualified Data.List.NonEmpty as NE

{- Note [Handling overloaded and rebindable constructs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For overloaded constructs (overloaded literals, lists, strings), and
rebindable constructs (e.g. if-then-else), our general plan is this,
using overloaded labels #foo as an example:

* In the RENAMER: transform
      HsOverLabel "foo"
      ==> XExpr (HsExpansion (HsOverLabel #foo)
                             (fromLabel `HsAppType` "foo"))
  We write this more compactly in concrete-syntax form like this
      #foo  ==>  fromLabel @"foo"

  Recall that in (HsExpansion orig expanded), 'orig' is the original term
  the user wrote, and 'expanded' is the expanded or desugared version
  to be typechecked.

* In the TYPECHECKER: typecheck the expansion, in this case
      fromLabel @"foo"
  The typechecker (and desugarer) will never see HsOverLabel

In effect, the renamer does a bit of desugaring. Recall GHC.Hs.Expr
Note [Rebindable syntax and HsExpansion], which describes the use of HsExpansion.

RebindableSyntax:
  If RebindableSyntax is off we use the built-in 'fromLabel', defined in
     GHC.Builtin.Names.fromLabelClassOpName
  If RebindableSyntax if ON, we look up "fromLabel" in the environment
     to get whichever one is in scope.
This is accomplished by lookupSyntaxName, and it applies to all the
constructs below.

See also Note [Handling overloaded and rebindable patterns] in GHC.Rename.Pat
for the story with patterns.

Here are the expressions that we transform in this way. Some are uniform,
but several have a little bit of special treatment:

* HsIf (if-the-else)
     if b then e1 else e2  ==>  ifThenElse b e1 e2
  We do this /only/ if rebindable syntax is on, because the coverage
  checker looks for HsIf (see GHC.HsToCore.Ticks.addTickHsExpr)
  That means the typechecker and desugarer need to understand HsIf
  for the non-rebindable-syntax case.

* OverLabel (overloaded labels, #lbl)
     #lbl  ==>  fromLabel @"lbl"
  As ever, we use lookupSyntaxName to look up 'fromLabel'
  See Note [Overloaded labels]

* ExplicitList (explicit lists [a,b,c])
  When (and only when) OverloadedLists is on
     [e1,e2]  ==>  fromListN 2 [e1,e2]
  NB: the type checker and desugarer still see ExplicitList,
      but to them it always means the built-in lists.

* SectionL and SectionR (left and right sections)
     (`op` e) ==> rightSection op e
     (e `op`) ==> leftSection  (op e)
  where `leftSection` and `rightSection` are representation-polymorphic
  wired-in Ids. See Note [Left and right sections]

* It's a bit painful to transform `OpApp e1 op e2` to a `HsExpansion`
  form, because the renamer does precedence rearrangement after name
  resolution.  So the renamer leaves an OpApp as an OpApp.

  The typechecker turns `OpApp` into a use of `HsExpansion`
  on the fly, in GHC.Tc.Gen.Head.splitHsApps.  RebindableSyntax
  does not affect this.

* RecordUpd: we desugar record updates into case expressions,
  in GHC.Tc.Gen.Expr.tcExpr.

  Example:

    data T p q = T1 { x :: Int, y :: Bool, z :: Char }
               | T2 { v :: Char }
               | T3 { x :: Int }
               | T4 { p :: Float, y :: Bool, x :: Int }
               | T5

    e { x=e1, y=e2 }
      ===>
    let { x' = e1; y' = e2 } in
    case e of
       T1 _ _ z -> T1 x' y' z
       T4 p _ _ -> T4 p y' x'

  See Note [Record Updates] in GHC.Tc.Gen.Expr for more details.

  This is done in the typechecker, not the renamer, for two reasons:

    - (Until we implement GHC proposal #366)
      We need to know the type of the record to disambiguate its fields.

    - We use the type signature of the data constructor to provide IdSigs
      to the let-bound variables (x', y' in the example above). This is
      needed to accept programs such as

        data R b = MkR { f :: (forall a. a -> a) -> (Int,b), c :: Int }
        foo r = r { f = \ k -> (k 3, k 'x') }

      in which an updated field has a higher-rank type.
      See Wrinkle [Using IdSig] in Note [Record Updates] in GHC.Tc.Gen.Expr.

Note [Overloaded labels]
~~~~~~~~~~~~~~~~~~~~~~~~
For overloaded labels, note that we /only/ apply `fromLabel` to the
Symbol argument, so the resulting expression has type
    fromLabel @"foo" :: forall a. IsLabel "foo" a => a
Now ordinary Visible Type Application can be used to instantiate the 'a':
the user may have written (#foo @Int).

Notice that this all works fine in a kind-polymorphic setting (#19154).
Suppose we have
    fromLabel :: forall {k1} {k2} (a:k1). blah

Then we want to instantiate those inferred quantifiers k1,k2, before
type-applying to "foo", so we get
    fromLabel @Symbol @blah @"foo" ...

And those inferred kind quantifiers will indeed be instantiated when we
typecheck the renamed-syntax call (fromLabel @"foo").
-}

{-
************************************************************************
*                                                                      *
\subsubsection{Expressions}
*                                                                      *
************************************************************************
-}

rnExprs :: [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs :: [LHsExpr GhcPs] -> RnM ([XRec GhcRn (HsExpr GhcRn)], FreeVars)
rnExprs [LHsExpr GhcPs]
ls = [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> FreeVars
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
rnExprs' [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
ls FreeVars
forall a. UniqSet a
emptyUniqSet
 where
  rnExprs' :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> FreeVars
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
rnExprs' [] FreeVars
acc = ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
acc)
  rnExprs' (GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr:[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
exprs) FreeVars
acc =
   do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
        -- Now we do a "seq" on the free vars because typically it's small
        -- or empty, especially in very long lists of constants
      ; let  acc' :: FreeVars
acc' = FreeVars
acc FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr
      ; ([GenLocated SrcSpanAnnA (HsExpr GhcRn)]
exprs', FreeVars
fvExprs) <- FreeVars
acc' FreeVars
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
forall a b. a -> b -> b
`seq` [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> FreeVars
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
rnExprs' [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
exprs FreeVars
acc'
      ; ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsExpr GhcRn)], FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr'GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
exprs', FreeVars
fvExprs) }

-- Variables. We look up the variable and return the resulting name.

rnLExpr :: LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr :: LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr = (HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
forall a b c ann.
(a -> TcM (b, c))
-> GenLocated (SrcSpanAnn' ann) a
-> TcM (GenLocated (SrcSpanAnn' ann) b, c)
wrapLocFstMA HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr

rnExpr :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)

finishHsVar :: LocatedA Name -> RnM (HsExpr GhcRn, FreeVars)
-- Separated from rnExpr because it's also used
-- when renaming infix expressions
finishHsVar :: LocatedA Name -> TcM (HsExpr GhcRn, FreeVars)
finishHsVar (L SrcSpanAnnA
l Name
name)
 = do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
      ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
        Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkThLocalName Name
name
      ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> XRec GhcRn (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
l) Name
name), Name -> FreeVars
unitFV Name
name) }

rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
rnUnboundVar :: RdrName -> TcM (HsExpr GhcRn, FreeVars)
rnUnboundVar RdrName
v = do
  Bool
deferOutofScopeVariables <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_DeferOutOfScopeVariables
  -- See Note [Reporting unbound names] for difference between qualified and unqualified names.
  Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RdrName -> Bool
isUnqual RdrName
v Bool -> Bool -> Bool
|| Bool
deferOutofScopeVariables) (RdrName -> RnM Name
reportUnboundName RdrName
v RnM Name
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcRn -> RdrName -> HsExpr GhcRn
forall p. XUnboundVar p -> RdrName -> HsExpr p
HsUnboundVar XUnboundVar GhcRn
NoExtField
noExtField RdrName
v, FreeVars
emptyFVs)

rnExpr :: HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr (HsVar XVar GhcPs
_ (L SrcSpanAnnN
l RdrName
v))
  = do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; Maybe GreName
mb_name <- RdrName -> RnM (Maybe GreName)
lookupExprOccRn RdrName
v

       ; case Maybe GreName
mb_name of {
           Maybe GreName
Nothing -> RdrName -> TcM (HsExpr GhcRn, FreeVars)
rnUnboundVar RdrName
v ;
           Just (NormalGreName Name
name)
              | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nilDataConName -- Treat [] as an ExplicitList, so that
                                       -- OverloadedLists works correctly
                                       -- Note [Empty lists] in GHC.Hs.Expr
              , Extension -> DynFlags -> Bool
xopt Extension
LangExt.OverloadedLists DynFlags
dflags
              -> HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr (XExplicitList GhcPs -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn [])

              | Bool
otherwise
              -> LocatedA Name -> TcM (HsExpr GhcRn, FreeVars)
finishHsVar (SrcSpanAnnA -> Name -> LocatedA Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a ann. SrcSpanAnn' a -> SrcAnn ann
na2la SrcSpanAnnN
l) Name
name) ;
            Just (FieldGreName FieldLabel
fl)
              -> do { let sel_name :: Name
sel_name = FieldLabel -> Name
flSelector FieldLabel
fl
                    ; Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
                    ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
sel_name) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                        Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkThLocalName Name
sel_name
                    ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( XRecSel GhcRn -> FieldOcc GhcRn -> HsExpr GhcRn
forall p. XRecSel p -> FieldOcc p -> HsExpr p
HsRecSel XRecSel GhcRn
NoExtField
noExtField (XCFieldOcc GhcRn -> XRec GhcRn RdrName -> FieldOcc GhcRn
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc GhcRn
Name
sel_name (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
v) ), Name -> FreeVars
unitFV Name
sel_name)
                    }
         }
       }

rnExpr (HsIPVar XIPVar GhcPs
x HsIPName
v)
  = (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XIPVar GhcRn -> HsIPName -> HsExpr GhcRn
forall p. XIPVar p -> HsIPName -> HsExpr p
HsIPVar XIPVar GhcPs
XIPVar GhcRn
x HsIPName
v, FreeVars
emptyFVs)

rnExpr (HsUnboundVar XUnboundVar GhcPs
_ RdrName
v)
  = (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcRn -> RdrName -> HsExpr GhcRn
forall p. XUnboundVar p -> RdrName -> HsExpr p
HsUnboundVar XUnboundVar GhcRn
NoExtField
noExtField RdrName
v, FreeVars
emptyFVs)

-- HsOverLabel: see Note [Handling overloaded and rebindable constructs]
rnExpr (HsOverLabel XOverLabel GhcPs
_ SourceText
src FastString
v)
  = do { (Name
from_label, FreeVars
fvs) <- Name -> RnM (Name, FreeVars)
lookupSyntaxName Name
fromLabelClassOpName
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr (XOverLabel GhcRn -> SourceText -> FastString -> HsExpr GhcRn
forall p. XOverLabel p -> SourceText -> FastString -> HsExpr p
HsOverLabel XOverLabel GhcRn
EpAnn NoEpAnns
forall a. EpAnn a
noAnn SourceText
src FastString
v) (HsExpr GhcRn -> HsExpr GhcRn) -> HsExpr GhcRn -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$
                  XAppTypeE GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LHsToken "@" GhcRn
-> LHsWcType (NoGhcTc GhcRn)
-> HsExpr GhcRn
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
noExtField (Name -> XRec GhcRn (HsExpr GhcRn)
genLHsVar Name
from_label) LHsToken "@" GhcRn
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs GhcRn (LocatedAn AnnListItem (HsType GhcRn))
hs_ty_arg
                , FreeVars
fvs ) }
  where
    hs_ty_arg :: HsWildCardBndrs GhcRn (LocatedAn AnnListItem (HsType GhcRn))
hs_ty_arg = LocatedAn AnnListItem (HsType GhcRn)
-> HsWildCardBndrs GhcRn (LocatedAn AnnListItem (HsType GhcRn))
forall thing. thing -> HsWildCardBndrs GhcRn thing
mkEmptyWildCardBndrs (LocatedAn AnnListItem (HsType GhcRn)
 -> HsWildCardBndrs GhcRn (LocatedAn AnnListItem (HsType GhcRn)))
-> LocatedAn AnnListItem (HsType GhcRn)
-> HsWildCardBndrs GhcRn (LocatedAn AnnListItem (HsType GhcRn))
forall a b. (a -> b) -> a -> b
$ HsType GhcRn -> LocatedAn AnnListItem (HsType GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (HsType GhcRn -> LocatedAn AnnListItem (HsType GhcRn))
-> HsType GhcRn -> LocatedAn AnnListItem (HsType GhcRn)
forall a b. (a -> b) -> a -> b
$
                XTyLit GhcRn -> HsTyLit GhcRn -> HsType GhcRn
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcRn
NoExtField
noExtField (XStrTy GhcRn -> FastString -> HsTyLit GhcRn
forall pass. XStrTy pass -> FastString -> HsTyLit pass
HsStrTy XStrTy GhcRn
SourceText
NoSourceText FastString
v)

rnExpr (HsLit XLitE GhcPs
x lit :: HsLit GhcPs
lit@(HsString XHsString GhcPs
src FastString
s))
  = do { Bool
opt_OverloadedStrings <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedStrings
       ; if Bool
opt_OverloadedStrings then
            HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr (XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XLitE GhcPs
XOverLitE GhcPs
x (SourceText -> FastString -> HsOverLit GhcPs
mkHsIsString XHsString GhcPs
SourceText
src FastString
s))
         else do {
            ; HsLit GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall p. HsLit p -> IOEnv (Env TcGblEnv TcLclEnv) ()
rnLit HsLit GhcPs
lit
            ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
XLitE GhcRn
x (HsLit GhcPs -> HsLit GhcRn
forall (p1 :: Pass) (p2 :: Pass).
HsLit (GhcPass p1) -> HsLit (GhcPass p2)
convertLit HsLit GhcPs
lit), FreeVars
emptyFVs) } }

rnExpr (HsLit XLitE GhcPs
x HsLit GhcPs
lit)
  = do { HsLit GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall p. HsLit p -> IOEnv (Env TcGblEnv TcLclEnv) ()
rnLit HsLit GhcPs
lit
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
XLitE GhcRn
x(HsLit GhcPs -> HsLit GhcRn
forall (p1 :: Pass) (p2 :: Pass).
HsLit (GhcPass p1) -> HsLit (GhcPass p2)
convertLit HsLit GhcPs
lit), FreeVars
emptyFVs) }

rnExpr (HsOverLit XOverLitE GhcPs
x HsOverLit GhcPs
lit)
  = do { ((HsOverLit GhcRn
lit', Maybe (HsExpr GhcRn)
mb_neg), FreeVars
fvs) <- HsOverLit GhcPs
-> RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
forall t.
(XXOverLit t ~ DataConCantHappen) =>
HsOverLit t
-> RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
rnOverLit HsOverLit GhcPs
lit -- See Note [Negative zero]
       ; case Maybe (HsExpr GhcRn)
mb_neg of
              Maybe (HsExpr GhcRn)
Nothing -> (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcPs
XOverLitE GhcRn
x HsOverLit GhcRn
lit', FreeVars
fvs)
              Just HsExpr GhcRn
neg ->
                 (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
EpAnn NoEpAnns
noComments (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
noLocA HsExpr GhcRn
neg) (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
noLocA (XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcPs
XOverLitE GhcRn
x HsOverLit GhcRn
lit'))
                        , FreeVars
fvs ) }

rnExpr (HsApp XApp GhcPs
x LHsExpr GhcPs
fun LHsExpr GhcPs
arg)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
fun',FreeVars
fvFun) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
fun
       ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
arg
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
XApp GhcRn
x XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
fun' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }

rnExpr (HsAppType XAppTypeE GhcPs
_ LHsExpr GhcPs
fun LHsToken "@" GhcPs
at LHsWcType (NoGhcTc GhcPs)
arg)
  = do { Bool
type_app <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeApplications
       ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
type_app (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String -> LHsType GhcPs -> TcRnMessage
typeAppErr String
"type" (LHsType GhcPs -> TcRnMessage) -> LHsType GhcPs -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
arg
       ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
fun',FreeVars
fvFun) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
fun
       ; (HsWildCardBndrs GhcRn (LocatedAn AnnListItem (HsType GhcRn))
arg',FreeVars
fvArg) <- HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType HsDocContext
HsTypeCtx LHsWcType (NoGhcTc GhcPs)
LHsWcType GhcPs
arg
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppTypeE GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LHsToken "@" GhcRn
-> LHsWcType (NoGhcTc GhcRn)
-> HsExpr GhcRn
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
NoExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
fun' LHsToken "@" GhcPs
LHsToken "@" GhcRn
at LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs GhcRn (LocatedAn AnnListItem (HsType GhcRn))
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }

rnExpr (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
e1 LHsExpr GhcPs
op LHsExpr GhcPs
e2)
  = do  { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e1', FreeVars
fv_e1) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
e1
        ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2', FreeVars
fv_e2) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
e2
        ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
op', FreeVars
fv_op) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
op

        -- Deal with fixity
        -- When renaming code synthesised from "deriving" declarations
        -- we used to avoid fixity stuff, but we can't easily tell any
        -- more, so I've removed the test.  Adding HsPars in GHC.Tc.Deriv.Generate
        -- should prevent bad things happening.
        ; Fixity
fixity <- case GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' of
              L SrcSpanAnnA
_ (HsVar XVar GhcRn
_ (L SrcSpanAnnN
_ Name
n)) -> Name -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFixityRn Name
n
              L SrcSpanAnnA
_ (HsRecSel XRecSel GhcRn
_ FieldOcc GhcRn
f)    -> FieldOcc GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFieldFixityRn FieldOcc GhcRn
f
              GenLocated SrcSpanAnnA (HsExpr GhcRn)
_ -> Fixity -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText Int
minPrecedence FixityDirection
InfixL)
                   -- c.f. lookupFixity for unbound

        ; Bool
lexical_negation <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.LexicalNegation
        ; let negation_handling :: NegationHandling
negation_handling | Bool
lexical_negation = NegationHandling
KeepNegationIntact
                                | Bool
otherwise = NegationHandling
ReassociateNegation
        ; HsExpr GhcRn
final_e <- NegationHandling
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> Fixity
-> XRec GhcRn (HsExpr GhcRn)
-> RnM (HsExpr GhcRn)
mkOpAppRn NegationHandling
negation_handling XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e1' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' Fixity
fixity XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2'
        ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
final_e, FreeVars
fv_e1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_e2) }

rnExpr (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e SyntaxExpr GhcPs
_)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e', FreeVars
fv_e)         <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
e
       ; (SyntaxExprRn
neg_name, FreeVars
fv_neg) <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax Name
negateName
       ; HsExpr GhcRn
final_e            <- XRec GhcRn (HsExpr GhcRn) -> SyntaxExpr GhcRn -> RnM (HsExpr GhcRn)
mkNegAppRn XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e' SyntaxExpr GhcRn
SyntaxExprRn
neg_name
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
final_e, FreeVars
fv_e FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_neg) }

------------------------------------------
-- Record dot syntax

rnExpr (HsGetField XGetField GhcPs
_ LHsExpr GhcPs
e XRec GhcPs (DotFieldOcc GhcPs)
f)
 = do { (Name
getField, FreeVars
fv_getField) <- Name -> RnM (Name, FreeVars)
lookupSyntaxName Name
getFieldName
      ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e, FreeVars
fv_e) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
e
      ; let f' :: LocatedAn NoEpAnns (DotFieldOcc GhcRn)
f' = LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
rnDotFieldOcc XRec GhcPs (DotFieldOcc GhcPs)
LocatedAn NoEpAnns (DotFieldOcc GhcPs)
f
      ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr
                   (XGetField GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (DotFieldOcc GhcRn)
-> HsExpr GhcRn
forall p.
XGetField p -> LHsExpr p -> XRec p (DotFieldOcc p) -> HsExpr p
HsGetField XGetField GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e XRec GhcRn (DotFieldOcc GhcRn)
LocatedAn NoEpAnns (DotFieldOcc GhcRn)
f')
                   (Name
-> XRec GhcRn (HsExpr GhcRn)
-> LocatedAn NoEpAnns FieldLabelString
-> HsExpr GhcRn
mkGetField Name
getField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e ((DotFieldOcc GhcRn -> FieldLabelString)
-> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
-> LocatedAn NoEpAnns FieldLabelString
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString)
-> (DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString)
-> DotFieldOcc GhcRn
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcRn -> XRec GhcRn FieldLabelString
DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel) LocatedAn NoEpAnns (DotFieldOcc GhcRn)
f'))
               , FreeVars
fv_e FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_getField ) }

rnExpr (HsProjection XProjection GhcPs
_ NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
fs)
  = do { (Name
getField, FreeVars
fv_getField) <- Name -> RnM (Name, FreeVars)
lookupSyntaxName Name
getFieldName
       ; Name
circ <- RdrName -> RnM Name
lookupOccRn RdrName
compose_RDR
       ; let fs' :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcRn))
fs' = (LocatedAn NoEpAnns (DotFieldOcc GhcPs)
 -> LocatedAn NoEpAnns (DotFieldOcc GhcRn))
-> NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
-> NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcRn))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
rnDotFieldOcc NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
fs
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr
                    (XProjection GhcRn
-> NonEmpty (XRec GhcRn (DotFieldOcc GhcRn)) -> HsExpr GhcRn
forall p.
XProjection p -> NonEmpty (XRec p (DotFieldOcc p)) -> HsExpr p
HsProjection XProjection GhcRn
NoExtField
noExtField NonEmpty (XRec GhcRn (DotFieldOcc GhcRn))
NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcRn))
fs')
                    (Name
-> Name
-> NonEmpty (LocatedAn NoEpAnns FieldLabelString)
-> HsExpr GhcRn
mkProjection Name
getField Name
circ ((LocatedAn NoEpAnns (DotFieldOcc GhcRn)
 -> LocatedAn NoEpAnns FieldLabelString)
-> NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcRn))
-> NonEmpty (LocatedAn NoEpAnns FieldLabelString)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DotFieldOcc GhcRn -> FieldLabelString)
-> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
-> LocatedAn NoEpAnns FieldLabelString
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString)
-> (DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString)
-> DotFieldOcc GhcRn
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcRn -> XRec GhcRn FieldLabelString
DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel)) NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcRn))
fs'))
                , Name -> FreeVars
unitFV Name
circ FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_getField) }

------------------------------------------
-- Template Haskell extensions
rnExpr e :: HsExpr GhcPs
e@(HsTypedBracket XTypedBracket GhcPs
_ LHsExpr GhcPs
br_body)   = HsExpr GhcPs -> LHsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnTypedBracket HsExpr GhcPs
e LHsExpr GhcPs
br_body
rnExpr e :: HsExpr GhcPs
e@(HsUntypedBracket XUntypedBracket GhcPs
_ HsQuote GhcPs
br_body) = HsExpr GhcPs -> HsQuote GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnUntypedBracket HsExpr GhcPs
e HsQuote GhcPs
br_body

rnExpr (HsTypedSplice   XTypedSplice GhcPs
_ LHsExpr GhcPs
splice) = LHsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnTypedSplice LHsExpr GhcPs
splice
rnExpr (HsUntypedSplice XUntypedSplice GhcPs
_ HsUntypedSplice GhcPs
splice) = HsUntypedSplice GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnUntypedSpliceExpr HsUntypedSplice GhcPs
splice

---------------------------------------------
--      Sections
-- See Note [Parsing sections] in GHC.Parser
rnExpr (HsPar XPar GhcPs
x LHsToken "(" GhcPs
lpar (L SrcSpanAnnA
loc (section :: HsExpr GhcPs
section@(SectionL {}))) LHsToken ")" GhcPs
rpar)
  = do  { (HsExpr GhcRn
section', FreeVars
fvs) <- HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
section
        ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcRn
-> LHsToken "(" GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LHsToken ")" GhcRn
-> HsExpr GhcRn
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcPs
XPar GhcRn
x LHsToken "(" GhcPs
LHsToken "(" GhcRn
lpar (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsExpr GhcRn
section') LHsToken ")" GhcPs
LHsToken ")" GhcRn
rpar, FreeVars
fvs) }

rnExpr (HsPar XPar GhcPs
x LHsToken "(" GhcPs
lpar (L SrcSpanAnnA
loc (section :: HsExpr GhcPs
section@(SectionR {}))) LHsToken ")" GhcPs
rpar)
  = do  { (HsExpr GhcRn
section', FreeVars
fvs) <- HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
section
        ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcRn
-> LHsToken "(" GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LHsToken ")" GhcRn
-> HsExpr GhcRn
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcPs
XPar GhcRn
x LHsToken "(" GhcPs
LHsToken "(" GhcRn
lpar (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsExpr GhcRn
section') LHsToken ")" GhcPs
LHsToken ")" GhcRn
rpar, FreeVars
fvs) }

rnExpr (HsPar XPar GhcPs
x LHsToken "(" GhcPs
lpar LHsExpr GhcPs
e LHsToken ")" GhcPs
rpar)
  = do  { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e', FreeVars
fvs_e) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
e
        ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcRn
-> LHsToken "(" GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LHsToken ")" GhcRn
-> HsExpr GhcRn
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcPs
XPar GhcRn
x LHsToken "(" GhcPs
LHsToken "(" GhcRn
lpar XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e' LHsToken ")" GhcPs
LHsToken ")" GhcRn
rpar, FreeVars
fvs_e) }

rnExpr expr :: HsExpr GhcPs
expr@(SectionL {})
  = do  { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (HsExpr GhcPs -> TcRnMessage
sectionErr HsExpr GhcPs
expr); HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
expr }
rnExpr expr :: HsExpr GhcPs
expr@(SectionR {})
  = do  { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (HsExpr GhcPs -> TcRnMessage
sectionErr HsExpr GhcPs
expr); HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
expr }

---------------------------------------------
rnExpr (HsPragE XPragE GhcPs
x HsPragE GhcPs
prag LHsExpr GhcPs
expr)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPragE GhcRn
-> HsPragE GhcRn -> XRec GhcRn (HsExpr GhcRn) -> HsExpr GhcRn
forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
HsPragE XPragE GhcPs
XPragE GhcRn
x (HsPragE GhcPs -> HsPragE GhcRn
rn_prag HsPragE GhcPs
prag) XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvs_expr) }
  where
    rn_prag :: HsPragE GhcPs -> HsPragE GhcRn
    rn_prag :: HsPragE GhcPs -> HsPragE GhcRn
rn_prag (HsPragSCC XSCC GhcPs
x StringLiteral
ann) = XSCC GhcRn -> StringLiteral -> HsPragE GhcRn
forall p. XSCC p -> StringLiteral -> HsPragE p
HsPragSCC XSCC GhcPs
XSCC GhcRn
x StringLiteral
ann

rnExpr (HsLam XLam GhcPs
x MatchGroup GhcPs (LHsExpr GhcPs)
matches)
  = do { (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
matches', FreeVars
fvMatch) <- HsMatchContext GhcRn
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RnM
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)),
      FreeVars)
forall (body :: * -> *).
(Outputable (body GhcPs), AnnoBody body) =>
HsMatchContext GhcRn
-> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
-> MatchGroup GhcPs (LocatedA (body GhcPs))
-> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
LambdaExpr LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
rnLExpr MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
matches
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLam GhcRn
-> MatchGroup GhcRn (XRec GhcRn (HsExpr GhcRn)) -> HsExpr GhcRn
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
XLam GhcRn
x MatchGroup GhcRn (XRec GhcRn (HsExpr GhcRn))
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
matches', FreeVars
fvMatch) }

rnExpr (HsLamCase XLamCase GhcPs
x LamCaseVariant
lc_variant MatchGroup GhcPs (LHsExpr GhcPs)
matches)
  = do { (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
matches', FreeVars
fvs_ms) <- HsMatchContext GhcRn
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RnM
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)),
      FreeVars)
forall (body :: * -> *).
(Outputable (body GhcPs), AnnoBody body) =>
HsMatchContext GhcRn
-> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
-> MatchGroup GhcPs (LocatedA (body GhcPs))
-> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars)
rnMatchGroup (LamCaseVariant -> HsMatchContext GhcRn
forall p. LamCaseVariant -> HsMatchContext p
LamCaseAlt LamCaseVariant
lc_variant) LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
rnLExpr MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
matches
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLamCase GhcRn
-> LamCaseVariant
-> MatchGroup GhcRn (XRec GhcRn (HsExpr GhcRn))
-> HsExpr GhcRn
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcPs
XLamCase GhcRn
x LamCaseVariant
lc_variant MatchGroup GhcRn (XRec GhcRn (HsExpr GhcRn))
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
matches', FreeVars
fvs_ms) }

rnExpr (HsCase XCase GhcPs
_ LHsExpr GhcPs
expr MatchGroup GhcPs (LHsExpr GhcPs)
matches)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
new_expr, FreeVars
e_fvs) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
       ; (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
new_matches, FreeVars
ms_fvs) <- HsMatchContext GhcRn
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RnM
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)),
      FreeVars)
forall (body :: * -> *).
(Outputable (body GhcPs), AnnoBody body) =>
HsMatchContext GhcRn
-> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
-> MatchGroup GhcPs (LocatedA (body GhcPs))
-> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
CaseAlt LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
rnLExpr MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
matches
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCase GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> MatchGroup GhcRn (XRec GhcRn (HsExpr GhcRn))
-> HsExpr GhcRn
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
new_expr MatchGroup GhcRn (XRec GhcRn (HsExpr GhcRn))
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
new_matches, FreeVars
e_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
ms_fvs) }

rnExpr (HsLet XLet GhcPs
_ LHsToken "let" GhcPs
tkLet HsLocalBinds GhcPs
binds LHsToken "in" GhcPs
tkIn LHsExpr GhcPs
expr)
  = HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn -> FreeVars -> TcM (HsExpr GhcRn, FreeVars))
 -> TcM (HsExpr GhcRn, FreeVars))
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsLocalBinds GhcRn
binds' FreeVars
_ -> do
      { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr',FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
      ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLet GhcRn
-> LHsToken "let" GhcRn
-> HsLocalBinds GhcRn
-> LHsToken "in" GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet GhcRn
NoExtField
noExtField LHsToken "let" GhcPs
LHsToken "let" GhcRn
tkLet HsLocalBinds GhcRn
binds' LHsToken "in" GhcPs
LHsToken "in" GhcRn
tkIn XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvExpr) }

rnExpr (HsDo XDo GhcPs
_ HsDoFlavour
do_or_lc (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts))
 = do { (([(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts1, ()
_), FreeVars
fvs1) <-
          HsStmtContext GhcRn
-> (HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars))
-> [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> ([Name] -> RnM ((), FreeVars))
-> RnM
     (([(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)),
         FreeVars)],
       ()),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmtsWithFreeVars (HsDoFlavour -> HsStmtContext GhcRn
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
do_or_lc) HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
            (\ [Name]
_ -> ((), FreeVars) -> RnM ((), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), FreeVars
emptyFVs))
      ; ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
pp_stmts, FreeVars
fvs2) <- HsDoFlavour
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
postProcessStmtsForApplicativeDo HsDoFlavour
do_or_lc [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts1
      ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( XDo GhcRn
-> HsDoFlavour -> XRec GhcRn [ExprLStmt GhcRn] -> HsExpr GhcRn
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcRn
NoExtField
noExtField HsDoFlavour
do_or_lc (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
pp_stmts), FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 ) }

-- ExplicitList: see Note [Handling overloaded and rebindable constructs]
rnExpr (ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
exps)
  = do  { ([GenLocated SrcSpanAnnA (HsExpr GhcRn)]
exps', FreeVars
fvs) <- [LHsExpr GhcPs] -> RnM ([XRec GhcRn (HsExpr GhcRn)], FreeVars)
rnExprs [LHsExpr GhcPs]
exps
        ; Bool
opt_OverloadedLists <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedLists
        ; if Bool -> Bool
not Bool
opt_OverloadedLists
          then (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return  (XExplicitList GhcRn -> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcRn
NoExtField
noExtField [XRec GhcRn (HsExpr GhcRn)]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
exps', FreeVars
fvs)
          else
    do { (Name
from_list_n_name, FreeVars
fvs') <- Name -> RnM (Name, FreeVars)
lookupSyntaxName Name
fromListNName
       ; let rn_list :: HsExpr GhcRn
rn_list  = XExplicitList GhcRn -> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcRn
NoExtField
noExtField [XRec GhcRn (HsExpr GhcRn)]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
exps'
             lit_n :: IntegralLit
lit_n    = Int -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
exps)
             hs_lit :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
hs_lit   = IntegralLit -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall an. IntegralLit -> LocatedAn an (HsExpr GhcRn)
genHsIntegralLit IntegralLit
lit_n
             exp_list :: HsExpr GhcRn
exp_list = Name -> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
genHsApps Name
from_list_n_name [XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
hs_lit, HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan HsExpr GhcRn
rn_list]
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr HsExpr GhcRn
rn_list HsExpr GhcRn
exp_list
                , FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs') } }

rnExpr (ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
tup_args Boxity
boxity)
  = do { [HsTupArg GhcPs] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupleSection [HsTupArg GhcPs]
tup_args
       ; ([HsTupArg GhcRn]
tup_args', [FreeVars]
fvs) <- (HsTupArg GhcPs
 -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcRn, FreeVars))
-> [HsTupArg GhcPs]
-> IOEnv (Env TcGblEnv TcLclEnv) ([HsTupArg GhcRn], [FreeVars])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM HsTupArg GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcRn, FreeVars)
rnTupArg [HsTupArg GhcPs]
tup_args
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTuple GhcRn -> [HsTupArg GhcRn] -> Boxity -> HsExpr GhcRn
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcRn
NoExtField
noExtField [HsTupArg GhcRn]
tup_args' Boxity
boxity, [FreeVars] -> FreeVars
plusFVs [FreeVars]
fvs) }
  where
    rnTupArg :: HsTupArg GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcRn, FreeVars)
rnTupArg (Present XPresent GhcPs
x LHsExpr GhcPs
e) = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e',FreeVars
fvs) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
e
                                ; (HsTupArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPresent GhcRn -> XRec GhcRn (HsExpr GhcRn) -> HsTupArg GhcRn
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
XPresent GhcRn
x XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e', FreeVars
fvs) }
    rnTupArg (Missing XMissing GhcPs
_) = (HsTupArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XMissing GhcRn -> HsTupArg GhcRn
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcRn
NoExtField
noExtField, FreeVars
emptyFVs)

rnExpr (ExplicitSum XExplicitSum GhcPs
_ Int
alt Int
arity LHsExpr GhcPs
expr)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvs) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitSum GhcRn
-> Int -> Int -> XRec GhcRn (HsExpr GhcRn) -> HsExpr GhcRn
forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
ExplicitSum XExplicitSum GhcRn
NoExtField
noExtField Int
alt Int
arity XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvs) }

rnExpr (RecordCon { rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_con = XRec GhcPs (ConLikeP GhcPs)
con_id
                  , rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = rec_binds :: HsRecordBinds GhcPs
rec_binds@(HsRecFields { rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot = Maybe (XRec GhcPs RecFieldsDotDot)
dd }) })
  = do { con_lname :: GenLocated SrcSpanAnnN Name
con_lname@(L SrcSpanAnnN
_ Name
con_name) <- GenLocated SrcSpanAnnN RdrName
-> TcRn (GenLocated SrcSpanAnnN Name)
forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnConstr XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
con_id
       ; ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds, FreeVars
fvs)   <- HsRecFieldContext
-> (SrcSpan -> RdrName -> HsExpr GhcPs)
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RnM
     ([LHsRecField GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcPs))],
      FreeVars)
forall arg.
HsRecFieldContext
-> (SrcSpan -> RdrName -> arg)
-> HsRecFields GhcPs (LocatedA arg)
-> RnM ([LHsRecField GhcRn (LocatedA arg)], FreeVars)
rnHsRecFields (Name -> HsRecFieldContext
HsRecFieldCon Name
con_name) SrcSpan -> IdP GhcPs -> HsExpr GhcPs
SrcSpan -> RdrName -> HsExpr GhcPs
forall {p} {ann}.
(XVar p ~ NoExtField,
 XRec p (IdP p) ~ GenLocated (SrcAnn ann) (IdP p)) =>
SrcSpan -> IdP p -> HsExpr p
mk_hs_var HsRecordBinds GhcPs
HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
rec_binds
       ; ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
flds', [FreeVars]
fvss) <- (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      [FreeVars])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall {l} {lhs}.
GenLocated
  l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
rn_field [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds
       ; let rec_binds' :: HsRecFields GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
rec_binds' = HsRecFields { rec_flds :: [LHsRecField GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
rec_flds = [LHsRecField GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
flds', rec_dotdot :: Maybe (XRec GhcRn RecFieldsDotDot)
rec_dotdot = Maybe (XRec GhcPs RecFieldsDotDot)
Maybe (XRec GhcRn RecFieldsDotDot)
dd }
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordCon { rcon_ext :: XRecordCon GhcRn
rcon_ext = XRecordCon GhcRn
NoExtField
noExtField
                           , rcon_con :: XRec GhcRn (ConLikeP GhcRn)
rcon_con = XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN Name
con_lname, rcon_flds :: HsRecordBinds GhcRn
rcon_flds = HsRecordBinds GhcRn
HsRecFields GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
rec_binds' }
                , FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` [FreeVars] -> FreeVars
plusFVs [FreeVars]
fvss FreeVars -> Name -> FreeVars
`addOneFV` Name
con_name) }
  where
    mk_hs_var :: SrcSpan -> IdP p -> HsExpr p
mk_hs_var SrcSpan
l IdP p
n = XVar p -> XRec p (IdP p) -> HsExpr p
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar p
NoExtField
noExtField (SrcAnn ann -> IdP p -> GenLocated (SrcAnn ann) (IdP p)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) IdP p
n)
    rn_field :: GenLocated
  l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
rn_field (L l
l HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fld) = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg', FreeVars
fvs) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fld)
                            ; (GenLocated
   l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (l
-> HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated
     l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall l e. l -> e -> GenLocated l e
L l
l (HsFieldBind lhs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fld { hfbRHS = arg' }), FreeVars
fvs) }

rnExpr (RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr GhcPs
expr, rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds = Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rbinds })
  = case Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rbinds of
      Left [LHsRecUpdField GhcPs]
flds -> -- 'OverloadedRecordUpdate' is not in effect. Regular record update.
        do  { ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e, FreeVars
fv_e) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
              ; ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
rs, FreeVars
fv_rs) <- [LHsRecUpdField GhcPs] -> RnM ([LHsRecUpdField GhcRn], FreeVars)
rnHsRecUpdFields [LHsRecUpdField GhcPs]
flds
              ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( XRecordUpd GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> Either [LHsRecUpdField GhcRn] [LHsRecUpdProj GhcRn]
-> HsExpr GhcRn
forall p.
XRecordUpd p
-> LHsExpr p
-> Either [LHsRecUpdField p] [LHsRecUpdProj p]
-> HsExpr p
RecordUpd XRecordUpd GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a b. a -> Either a b
Left [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
rs), FreeVars
fv_e FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_rs )
            }
      Right [LHsRecUpdProj GhcPs]
flds ->  -- 'OverloadedRecordUpdate' is in effect. Record dot update desugaring.
        do { ; Extension
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
unlessXOptM Extension
LangExt.RebindableSyntax (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                 TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr TcRnMessage
TcRnNoRebindableSyntaxRecordDot
             ; let punnedFields :: [HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
   (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
punnedFields = [HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fld | (L SrcSpanAnnA
_ HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fld) <- [LHsRecUpdProj GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds, HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Bool
forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fld]
             ; Bool
punsEnabled <-Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.NamedFieldPuns
             ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
   (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
   (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
punnedFields Bool -> Bool -> Bool
|| Bool
punsEnabled) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                 TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr TcRnMessage
TcRnNoFieldPunsRecordDot
             ; (Name
getField, FreeVars
fv_getField) <- Name -> RnM (Name, FreeVars)
lookupSyntaxName Name
getFieldName
             ; (Name
setField, FreeVars
fv_setField) <- Name -> RnM (Name, FreeVars)
lookupSyntaxName Name
setFieldName
             ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e, FreeVars
fv_e) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
             ; ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
us, FreeVars
fv_us) <- [LHsRecUpdProj GhcPs] -> RnM ([LHsRecUpdProj GhcRn], FreeVars)
rnHsUpdProjs [LHsRecUpdProj GhcPs]
flds
             ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr
                          (XRecordUpd GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> Either [LHsRecUpdField GhcRn] [LHsRecUpdProj GhcRn]
-> HsExpr GhcRn
forall p.
XRecordUpd p
-> LHsExpr p
-> Either [LHsRecUpdField p] [LHsRecUpdProj p]
-> HsExpr p
RecordUpd XRecordUpd GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a b. b -> Either a b
Right [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
us))
                          (Name
-> Name
-> XRec GhcRn (HsExpr GhcRn)
-> [LHsRecUpdProj GhcRn]
-> HsExpr GhcRn
mkRecordDotUpd Name
getField Name
setField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e [LHsRecUpdProj GhcRn]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
us)
                         , [FreeVars] -> FreeVars
plusFVs [FreeVars
fv_getField, FreeVars
fv_setField, FreeVars
fv_e, FreeVars
fv_us] )
             }

rnExpr (ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
expr LHsSigWcType (NoGhcTc GhcPs)
pty)
  = do  { (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
pty', FreeVars
fvTy)    <- HsDocContext
-> LHsSigWcType GhcPs -> RnM (LHsSigWcType GhcRn, FreeVars)
rnHsSigWcType HsDocContext
ExprWithTySigCtx LHsSigWcType (NoGhcTc GhcPs)
LHsSigWcType GhcPs
pty
        ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvExpr) <- [Name]
-> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
-> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindSigTyVarsFV (LHsSigWcType GhcRn -> [Name]
hsWcScopedTvs LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
pty') (RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
 -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars))
-> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
-> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$
                             LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
        ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XExprWithTySig GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LHsSigWcType (NoGhcTc GhcRn)
-> HsExpr GhcRn
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr' LHsSigWcType (NoGhcTc GhcRn)
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
pty', FreeVars
fvExpr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvTy) }

-- HsIf: see Note [Handling overloaded and rebindable constructs]
-- Because of the coverage checker it is most convenient /not/ to
-- expand HsIf; unless we are in rebindable syntax.
rnExpr (HsIf XIf GhcPs
_ LHsExpr GhcPs
p LHsExpr GhcPs
b1 LHsExpr GhcPs
b2)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
p',  FreeVars
fvP)  <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
p
       ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
b1', FreeVars
fvB1) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
b1
       ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
b2', FreeVars
fvB2) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
b2
       ; let fvs_if :: FreeVars
fvs_if = [FreeVars] -> FreeVars
plusFVs [FreeVars
fvP, FreeVars
fvB1, FreeVars
fvB2]
             rn_if :: HsExpr GhcRn
rn_if  = XIf GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf XIf GhcRn
NoExtField
noExtField  XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
p' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
b1' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
b2'

       -- Deal with rebindable syntax
       -- See Note [Handling overloaded and rebindable constructs]
       ; Maybe Name
mb_ite <- RnM (Maybe Name)
lookupIfThenElse
       ; case Maybe Name
mb_ite of
            Maybe Name
Nothing  -- Non rebindable-syntax case
              -> (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
rn_if, FreeVars
fvs_if)

            Just Name
ite_name   -- Rebindable-syntax case
              -> do { let ds_if :: HsExpr GhcRn
ds_if = Name -> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
genHsApps Name
ite_name [XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
p', XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
b1', XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
b2']
                          fvs :: FreeVars
fvs   = [FreeVars] -> FreeVars
plusFVs [FreeVars
fvs_if, Name -> FreeVars
unitFV Name
ite_name]
                    ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr HsExpr GhcRn
rn_if HsExpr GhcRn
ds_if, FreeVars
fvs) } }

rnExpr (HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (LHsExpr GhcPs)]
alts)
  = do { ([GenLocated
   (Anno (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
   (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts', FreeVars
fvs) <- (GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> RnM
      (GenLocated
         (Anno (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars))
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> RnM
     ([GenLocated
         (Anno (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeVars)) -> f a -> RnM (f b, FreeVars)
mapFvRn (HsMatchContext GhcRn
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars))
-> LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RnM
     (LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)
forall (body :: * -> *).
AnnoBody body =>
HsMatchContext GhcRn
-> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
-> LGRHS GhcPs (LocatedA (body GhcPs))
-> RnM (LGRHS GhcRn (LocatedA (body GhcRn)), FreeVars)
rnGRHS HsMatchContext GhcRn
forall p. HsMatchContext p
IfAlt LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
rnLExpr) [LGRHS GhcPs (LHsExpr GhcPs)]
[GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
alts
       ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XMultiIf GhcRn
-> [LGRHS GhcRn (XRec GhcRn (HsExpr GhcRn))] -> HsExpr GhcRn
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf XMultiIf GhcRn
NoExtField
noExtField [LGRHS GhcRn (XRec GhcRn (HsExpr GhcRn))]
[GenLocated
   (Anno (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
   (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts', FreeVars
fvs) }

rnExpr (ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
seq)
  = do { Bool
opt_OverloadedLists <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedLists
       ; (ArithSeqInfo GhcRn
new_seq, FreeVars
fvs) <- ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq ArithSeqInfo GhcPs
seq
       ; if Bool
opt_OverloadedLists
           then do {
            ; (SyntaxExprRn
from_list_name, FreeVars
fvs') <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax Name
fromListName
            ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XArithSeq GhcRn
-> Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> HsExpr GhcRn
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq GhcRn
NoExtField
noExtField (SyntaxExprRn -> Maybe SyntaxExprRn
forall a. a -> Maybe a
Just SyntaxExprRn
from_list_name) ArithSeqInfo GhcRn
new_seq
                     , FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs') }
           else
            (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XArithSeq GhcRn
-> Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> HsExpr GhcRn
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq GhcRn
NoExtField
noExtField Maybe (SyntaxExpr GhcRn)
Maybe SyntaxExprRn
forall a. Maybe a
Nothing ArithSeqInfo GhcRn
new_seq, FreeVars
fvs) }

{-
************************************************************************
*                                                                      *
        Static values
*                                                                      *
************************************************************************

For the static form we check that it is not used in splices.
We also collect the free variables of the term which come from
this module. See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
-}

rnExpr e :: HsExpr GhcPs
e@(HsStatic XStatic GhcPs
_ LHsExpr GhcPs
expr) = do
    -- Normally, you wouldn't be able to construct a static expression without
    -- first enabling -XStaticPointers in the first place, since that extension
    -- is what makes the parser treat `static` as a keyword. But this is not a
    -- sufficient safeguard, as one can construct static expressions by another
    -- mechanism: Template Haskell (see #14204). To ensure that GHC is
    -- absolutely prepared to cope with static forms, we check for
    -- -XStaticPointers here as well.
    Extension
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
unlessXOptM Extension
LangExt.StaticPointers (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
      TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> TcRnMessage
TcRnIllegalStaticExpression HsExpr GhcPs
e
    (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr',FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
    ThStage
stage <- TcM ThStage
getStage
    case ThStage
stage of
      Splice SpliceType
_ -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> TcRnMessage
TcRnIllegalStaticFormInSplice HsExpr GhcPs
e
      ThStage
_ -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Module
mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
    let fvExpr' :: FreeVars
fvExpr' = (Name -> Bool) -> FreeVars -> FreeVars
filterNameSet (Module -> Name -> Bool
nameIsLocalOrFrom Module
mod) FreeVars
fvExpr
    (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XStatic GhcRn -> XRec GhcRn (HsExpr GhcRn) -> HsExpr GhcRn
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic XStatic GhcRn
FreeVars
fvExpr' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvExpr)

{-
************************************************************************
*                                                                      *
        Arrow notation
*                                                                      *
********************************************************************* -}

rnExpr (HsProc XProc GhcPs
x LPat GhcPs
pat LHsCmdTop GhcPs
body)
  = TcM (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. TcM a -> TcM a
newArrowScope (TcM (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$
    HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall a.
HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat (HsArrowMatchContext -> HsMatchContext GhcRn
forall p. HsArrowMatchContext -> HsMatchContext p
ArrowMatchCtxt HsArrowMatchContext
ProcExpr) LPat GhcPs
pat ((LPat GhcRn -> TcM (HsExpr GhcRn, FreeVars))
 -> TcM (HsExpr GhcRn, FreeVars))
-> (LPat GhcRn -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ LPat GhcRn
pat' -> do
      { (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
body',FreeVars
fvBody) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
body
      ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XProc GhcRn -> LPat GhcRn -> LHsCmdTop GhcRn -> HsExpr GhcRn
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
HsProc XProc GhcPs
XProc GhcRn
x LPat GhcRn
pat' LHsCmdTop GhcRn
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
body', FreeVars
fvBody) }

rnExpr HsExpr GhcPs
other = String -> SDoc -> TcM (HsExpr GhcRn, FreeVars)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rnExpr: unexpected expression" (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
other)
        -- HsWrap

{-
************************************************************************
*                                                                      *
        Operator sections
*                                                                      *
********************************************************************* -}


rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
-- See Note [Parsing sections] in GHC.Parser
-- Also see Note [Handling overloaded and rebindable constructs]

rnSection :: HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSection section :: HsExpr GhcPs
section@(SectionR XSectionR GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
expr)
  -- See Note [Left and right sections]
  = do  { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
op', FreeVars
fvs_op)     <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
op
        ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
        ; FixityDirection
-> HsExpr GhcPs
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkSectionPrec FixityDirection
InfixR HsExpr GhcPs
section XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr'
        ; let rn_section :: HsExpr GhcRn
rn_section = XSectionR GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR GhcPs
XSectionR GhcRn
x XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr'
              ds_section :: HsExpr GhcRn
ds_section = Name -> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
genHsApps Name
rightSectionName [XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op',XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr']
        ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr HsExpr GhcRn
rn_section HsExpr GhcRn
ds_section
                 , FreeVars
fvs_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_expr) }

rnSection section :: HsExpr GhcPs
section@(SectionL XSectionL GhcPs
x LHsExpr GhcPs
expr LHsExpr GhcPs
op)
  -- See Note [Left and right sections]
  = do  { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
        ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
op', FreeVars
fvs_op)     <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
op
        ; FixityDirection
-> HsExpr GhcPs
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkSectionPrec FixityDirection
InfixL HsExpr GhcPs
section XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr'
        ; Bool
postfix_ops <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.PostfixOperators
                        -- Note [Left and right sections]
        ; let rn_section :: HsExpr GhcRn
rn_section = XSectionL GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL GhcPs
XSectionL GhcRn
x XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op'
              ds_section :: HsExpr GhcRn
ds_section
                | Bool
postfix_ops = XApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
EpAnn NoEpAnns
forall a. EpAnn a
noAnn XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr'
                | Bool
otherwise   = Name -> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
genHsApps Name
leftSectionName
                                   [HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ XApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
EpAnn NoEpAnns
forall a. EpAnn a
noAnn XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr']
        ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr HsExpr GhcRn
rn_section HsExpr GhcRn
ds_section
                 , FreeVars
fvs_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_expr) }

rnSection HsExpr GhcPs
other = String -> SDoc -> TcM (HsExpr GhcRn, FreeVars)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rnSection" (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
other)

{- Note [Left and right sections]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dealing with left sections (x *) and right sections (* x) is
surprisingly fiddly.  We expand like this
     (`op` e) ==> rightSection op e
     (e `op`) ==> leftSection  (op e)

Using an auxiliary function in this way avoids the awkwardness of
generating a lambda, esp if `e` is a redex, so we *don't* want
to generate `(\x -> op x e)`. See Historical
Note [Desugaring operator sections]

Here are their definitions:
   leftSection :: forall r1 r2 n (a::TYPE r1) (b::TYPE r2).
                  (a %n-> b) -> a %n-> b
   leftSection f x = f x

   rightSection :: forall r1 r2 r3 n1 n2 (a::TYPE r1) (b::TYPE r2) (c::TYPE r3).
                   (a %n1 -> b %n2-> c) -> b %n2-> a %n1-> c
   rightSection f y x = f x y

Note the wrinkles:

* We do /not/ use lookupSyntaxName, which would make left and right
  section fall under RebindableSyntax.  Reason: it would be a user-
  facing change, and there are some tricky design choices (#19354).
  Plus, infix operator applications would be trickier to make
  rebindable, so it'd be inconsistent to do so for sections.

  TL;DR: we still use the renamer-expansion mechanism for operator
  sections, but only to eliminate special-purpose code paths in the
  renamer and desugarer.

* leftSection and rightSection must be representation-polymorphic, to allow
  (+# 4#) and (4# +#) to work. See
  Note [Wired-in Ids for rebindable syntax] in GHC.Types.Id.Make.

* leftSection and rightSection must be multiplicity-polymorphic.
  (Test linear/should_compile/OldList showed this up.)

* Because they are representation-polymorphic, we have to define them
  as wired-in Ids, with compulsory inlining.  See
  GHC.Types.Id.Make.leftSectionId, rightSectionId.

* leftSection is just ($) really; but unlike ($) it is
  representation-polymorphic in the result type, so we can write
  `(x +#)`, say.

* The type of leftSection must have an arrow in its first argument,
  because (x `ord`) should be rejected, because ord does not take two
  arguments

* It's important that we define leftSection in an eta-expanded way,
  (i.e. not leftSection f = f), so that
      (True `undefined`) `seq` ()
      = (leftSection (undefined True) `seq` ())
  evaluates to () and not undefined

* If PostfixOperators is ON, then we expand a left section like this:
      (e `op`)  ==>   op e
  with no auxiliary function at all.  Simple!

* leftSection and rightSection switch on ImpredicativeTypes locally,
  during Quick Look; see GHC.Tc.Gen.App.wantQuickLook. Consider
  test DeepSubsumption08:
     type Setter st t a b = forall f. Identical f => blah
     (.~) :: Setter s t a b -> b -> s -> t
     clear :: Setter a a' b (Maybe b') -> a -> a'
     clear = (.~ Nothing)
   The expansion look like (rightSection (.~) Nothing).  So we must
   instantiate `rightSection` first type argument to a polytype!
   Hence the special magic in App.wantQuickLook.

Historical Note [Desugaring operator sections]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This Note explains some historical trickiness in desugaring left and
right sections.  That trickiness has completely disappeared now that
we desugar to calls to 'leftSection` and `rightSection`, but I'm
leaving it here to remind us how nice the new story is.

Desugaring left sections with -XPostfixOperators is straightforward: convert
(expr `op`) to (op expr).

Without -XPostfixOperators it's a bit more tricky. At first it looks as if we
can convert

    (expr `op`)

naively to

    \x -> op expr x

But no!  expr might be a redex, and we can lose laziness badly this
way.  Consider

    map (expr `op`) xs

for example. If expr were a redex then eta-expanding naively would
result in multiple evaluations where the user might only have expected one.

So we convert instead to

    let y = expr in \x -> op y x

Also, note that we must do this for both right and (perhaps surprisingly) left
sections. Why are left sections necessary? Consider the program (found in #18151),

    seq (True `undefined`) ()

according to the Haskell Report this should reduce to () (as it specifies
desugaring via eta expansion). However, if we fail to eta expand we will rather
bottom. Consequently, we must eta expand even in the case of a left section.

If `expr` is actually just a variable, say, then the simplifier
will inline `y`, eliminating the redundant `let`.

Note that this works even in the case that `expr` is unlifted. In this case
bindNonRec will automatically do the right thing, giving us:

    case expr of y -> (\x -> op y x)

See #18151.

Note [Reporting unbound names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Faced with an out-of-scope `RdrName` there are two courses of action
A. Report an error immediately (and return a HsUnboundVar). This will halt GHC after the renamer is complete
B. Return a HsUnboundVar without reporting an error.  That will allow the typechecker to run, which in turn
   can give a better error message, notably giving the type of the variable via the "typed holes" mechanism.

When `-fdefer-out-of-scope-variables` is on we follow plan B.

When it is not, we follow plan B for unqualified names, and plan A for qualified names.

If a name is qualified, and out of scope, then by default an error will be raised
because the user was already more precise. They specified a specific qualification
and either
  * The qualification didn't exist, so that precision was wrong.
  * Or the qualification existed and the thing we were looking for wasn't where
    the qualification said it would be.

However we can still defer this error completely, and we do defer it if
`-fdefer-out-of-scope-variables` is enabled.

-}

{-
************************************************************************
*                                                                      *
        Field Labels
*                                                                      *
************************************************************************
-}

rnDotFieldOcc :: LocatedAn NoEpAnns (DotFieldOcc GhcPs) -> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
rnDotFieldOcc :: LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
rnDotFieldOcc (L SrcAnn NoEpAnns
l (DotFieldOcc XCDotFieldOcc GhcPs
x XRec GhcPs FieldLabelString
label)) = SrcAnn NoEpAnns
-> DotFieldOcc GhcRn -> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l (XCDotFieldOcc GhcRn
-> XRec GhcRn FieldLabelString -> DotFieldOcc GhcRn
forall p.
XCDotFieldOcc p -> XRec p FieldLabelString -> DotFieldOcc p
DotFieldOcc XCDotFieldOcc GhcPs
XCDotFieldOcc GhcRn
x XRec GhcPs FieldLabelString
XRec GhcRn FieldLabelString
label)

rnFieldLabelStrings :: FieldLabelStrings GhcPs -> FieldLabelStrings GhcRn
rnFieldLabelStrings :: FieldLabelStrings GhcPs -> FieldLabelStrings GhcRn
rnFieldLabelStrings (FieldLabelStrings [XRec GhcPs (DotFieldOcc GhcPs)]
fls) = [XRec GhcRn (DotFieldOcc GhcRn)] -> FieldLabelStrings GhcRn
forall p. [XRec p (DotFieldOcc p)] -> FieldLabelStrings p
FieldLabelStrings ((LocatedAn NoEpAnns (DotFieldOcc GhcPs)
 -> LocatedAn NoEpAnns (DotFieldOcc GhcRn))
-> [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> [LocatedAn NoEpAnns (DotFieldOcc GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
rnDotFieldOcc [XRec GhcPs (DotFieldOcc GhcPs)]
[LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
fls)

{-
************************************************************************
*                                                                      *
        Arrow commands
*                                                                      *
************************************************************************
-}

rnCmdArgs :: [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs :: [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [] = ([GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)], FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)], FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
emptyFVs)
rnCmdArgs (LHsCmdTop GhcPs
arg:[LHsCmdTop GhcPs]
args)
  = do { (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
arg',FreeVars
fvArg) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg
       ; ([GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)]
args',FreeVars
fvArgs) <- [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [LHsCmdTop GhcPs]
args
       ; ([GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)], FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)], FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
arg'GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
-> [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)]
-> [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)]
forall a. a -> [a] -> [a]
:[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)]
args', FreeVars
fvArg FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArgs) }

rnCmdTop :: LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop :: LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop = (HsCmdTop GhcPs -> TcM (HsCmdTop GhcRn, FreeVars))
-> GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn), FreeVars)
forall a b c ann.
(a -> TcM (b, c))
-> GenLocated (SrcSpanAnn' ann) a
-> TcM (GenLocated (SrcSpanAnn' ann) b, c)
wrapLocFstMA HsCmdTop GhcPs -> TcM (HsCmdTop GhcRn, FreeVars)
rnCmdTop'
 where
  rnCmdTop' :: HsCmdTop GhcPs -> RnM (HsCmdTop GhcRn, FreeVars)
  rnCmdTop' :: HsCmdTop GhcPs -> TcM (HsCmdTop GhcRn, FreeVars)
rnCmdTop' (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd)
   = do { (GenLocated SrcSpanAnnA (HsCmd GhcRn)
cmd', FreeVars
fvCmd) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
cmd
        ; let cmd_names :: [Name]
cmd_names = [Name
arrAName, Name
composeAName, Name
firstAName] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
                          FreeVars -> [Name]
nameSetElemsStable (HsCmd GhcRn -> FreeVars
methodNamesCmd (GenLocated SrcSpanAnnA (HsCmd GhcRn) -> HsCmd GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsCmd GhcRn)
cmd'))
        -- Generate the rebindable syntax for the monad
        ; ([HsExpr GhcRn]
cmd_names', FreeVars
cmd_fvs) <- [Name] -> RnM ([HsExpr GhcRn], FreeVars)
lookupSyntaxNames [Name]
cmd_names

        ; (HsCmdTop GhcRn, FreeVars) -> TcM (HsCmdTop GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdTop GhcRn -> LHsCmd GhcRn -> HsCmdTop GhcRn
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop ([Name]
cmd_names [Name] -> [HsExpr GhcRn] -> [(Name, HsExpr GhcRn)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [HsExpr GhcRn]
cmd_names') LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
cmd',
                  FreeVars
fvCmd FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
cmd_fvs) }

rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd = (HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsCmd GhcRn), FreeVars)
forall a b c ann.
(a -> TcM (b, c))
-> GenLocated (SrcSpanAnn' ann) a
-> TcM (GenLocated (SrcSpanAnn' ann) b, c)
wrapLocFstMA HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars)
rnCmd

rnCmd :: HsCmd GhcPs -> RnM (HsCmd GhcRn, FreeVars)

rnCmd :: HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars)
rnCmd (HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
arrow LHsExpr GhcPs
arg HsArrAppType
ho Bool
rtl)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
arrow',FreeVars
fvArrow) <- IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
select_arrow_scope (LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
arrow)
       ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
arg
       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsArrAppType
-> Bool
-> HsCmd GhcRn
forall id.
XCmdArrApp id
-> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
HsCmdArrApp XCmdArrApp GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
arrow' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg' HsArrAppType
ho Bool
rtl,
                 FreeVars
fvArrow FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
  where
    select_arrow_scope :: IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
select_arrow_scope IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
tc = case HsArrAppType
ho of
        HsArrAppType
HsHigherOrderApp -> IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
tc
        HsArrAppType
HsFirstOrderApp  -> IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
tc
        -- See Note [Escaping the arrow scope] in GHC.Tc.Types
        -- Before renaming 'arrow', use the environment of the enclosing
        -- proc for the (-<) case.
        -- Local bindings, inside the enclosing proc, are not in scope
        -- inside 'arrow'.  In the higher-order case (-<<), they are.

-- infix form
rnCmd (HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
op LexicalFixity
_ (Just Fixity
_) [LHsCmdTop GhcPs
arg1, LHsCmdTop GhcPs
arg2])
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
op',FreeVars
fv_op) <- IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope (LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
op)
       ; let L SrcSpanAnnA
_ (HsVar XVar GhcRn
_ (L SrcSpanAnnN
_ Name
op_name)) = GenLocated SrcSpanAnnA (HsExpr GhcRn)
op'
       ; (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
arg1',FreeVars
fv_arg1) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg1
       ; (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
arg2',FreeVars
fv_arg2) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg2
        -- Deal with fixity
       ; Fixity
fixity <- Name -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFixityRn Name
op_name
       ; HsCmd GhcRn
final_e <- LHsCmdTop GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> Fixity
-> LHsCmdTop GhcRn
-> RnM (HsCmd GhcRn)
mkOpFormRn LHsCmdTop GhcRn
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
arg1' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' Fixity
fixity LHsCmdTop GhcRn
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
arg2'
       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsCmd GhcRn
final_e, FreeVars
fv_arg1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_arg2) }

rnCmd (HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcPs]
cmds)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
op',FreeVars
fvOp) <- IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope (LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
op)
       ; ([GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)]
cmds',FreeVars
fvCmds) <- [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [LHsCmdTop GhcPs]
cmds
       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( XCmdArrForm GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcRn]
-> HsCmd GhcRn
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op' LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcRn]
[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)]
cmds'
                , FreeVars
fvOp FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvCmds) }

rnCmd (HsCmdApp XCmdApp GhcPs
x LHsCmd GhcPs
fun LHsExpr GhcPs
arg)
  = do { (GenLocated SrcSpanAnnA (HsCmd GhcRn)
fun',FreeVars
fvFun) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd  LHsCmd GhcPs
fun
       ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
arg
       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdApp GhcRn
-> LHsCmd GhcRn -> XRec GhcRn (HsExpr GhcRn) -> HsCmd GhcRn
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp XCmdApp GhcPs
XCmdApp GhcRn
x LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
fun' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }

rnCmd (HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
matches)
  = do { (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
matches', FreeVars
fvMatch) <- HsMatchContext GhcRn
-> (GenLocated SrcSpanAnnA (HsCmd GhcPs)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsCmd GhcRn), FreeVars))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> RnM
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)), FreeVars)
forall (body :: * -> *).
(Outputable (body GhcPs), AnnoBody body) =>
HsMatchContext GhcRn
-> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
-> MatchGroup GhcPs (LocatedA (body GhcPs))
-> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars)
rnMatchGroup (HsArrowMatchContext -> HsMatchContext GhcRn
forall p. HsArrowMatchContext -> HsMatchContext p
ArrowMatchCtxt HsArrowMatchContext
KappaExpr) LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsCmd GhcRn), FreeVars)
rnLCmd MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
matches
       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLam GhcRn -> MatchGroup GhcRn (LHsCmd GhcRn) -> HsCmd GhcRn
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam XCmdLam GhcRn
NoExtField
noExtField MatchGroup GhcRn (LHsCmd GhcRn)
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
matches', FreeVars
fvMatch) }

rnCmd (HsCmdPar XCmdPar GhcPs
x LHsToken "(" GhcPs
lpar LHsCmd GhcPs
e LHsToken ")" GhcPs
rpar)
  = do  { (GenLocated SrcSpanAnnA (HsCmd GhcRn)
e', FreeVars
fvs_e) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
e
        ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdPar GhcRn
-> LHsToken "(" GhcRn
-> LHsCmd GhcRn
-> LHsToken ")" GhcRn
-> HsCmd GhcRn
forall id.
XCmdPar id
-> LHsToken "(" id -> LHsCmd id -> LHsToken ")" id -> HsCmd id
HsCmdPar XCmdPar GhcPs
XCmdPar GhcRn
x LHsToken "(" GhcPs
LHsToken "(" GhcRn
lpar LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
e' LHsToken ")" GhcPs
LHsToken ")" GhcRn
rpar, FreeVars
fvs_e) }

rnCmd (HsCmdCase XCmdCase GhcPs
_ LHsExpr GhcPs
expr MatchGroup GhcPs (LHsCmd GhcPs)
matches)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
new_expr, FreeVars
e_fvs) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
       ; (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
new_matches, FreeVars
ms_fvs) <- HsMatchContext GhcRn
-> (GenLocated SrcSpanAnnA (HsCmd GhcPs)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsCmd GhcRn), FreeVars))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> RnM
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)), FreeVars)
forall (body :: * -> *).
(Outputable (body GhcPs), AnnoBody body) =>
HsMatchContext GhcRn
-> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
-> MatchGroup GhcPs (LocatedA (body GhcPs))
-> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars)
rnMatchGroup (HsArrowMatchContext -> HsMatchContext GhcRn
forall p. HsArrowMatchContext -> HsMatchContext p
ArrowMatchCtxt HsArrowMatchContext
ArrowCaseAlt) LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsCmd GhcRn), FreeVars)
rnLCmd MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
matches
       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdCase GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> MatchGroup GhcRn (LHsCmd GhcRn)
-> HsCmd GhcRn
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase XCmdCase GhcRn
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
new_expr MatchGroup GhcRn (LHsCmd GhcRn)
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
new_matches
                , FreeVars
e_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
ms_fvs) }

rnCmd (HsCmdLamCase XCmdLamCase GhcPs
x LamCaseVariant
lc_variant MatchGroup GhcPs (LHsCmd GhcPs)
matches)
  = do { (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
new_matches, FreeVars
ms_fvs) <-
           HsMatchContext GhcRn
-> (GenLocated SrcSpanAnnA (HsCmd GhcPs)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsCmd GhcRn), FreeVars))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> RnM
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)), FreeVars)
forall (body :: * -> *).
(Outputable (body GhcPs), AnnoBody body) =>
HsMatchContext GhcRn
-> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
-> MatchGroup GhcPs (LocatedA (body GhcPs))
-> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars)
rnMatchGroup (HsArrowMatchContext -> HsMatchContext GhcRn
forall p. HsArrowMatchContext -> HsMatchContext p
ArrowMatchCtxt (HsArrowMatchContext -> HsMatchContext GhcRn)
-> HsArrowMatchContext -> HsMatchContext GhcRn
forall a b. (a -> b) -> a -> b
$ LamCaseVariant -> HsArrowMatchContext
ArrowLamCaseAlt LamCaseVariant
lc_variant) LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsCmd GhcRn), FreeVars)
rnLCmd MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
matches
       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLamCase GhcRn
-> LamCaseVariant -> MatchGroup GhcRn (LHsCmd GhcRn) -> HsCmd GhcRn
forall id.
XCmdLamCase id
-> LamCaseVariant -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLamCase XCmdLamCase GhcPs
XCmdLamCase GhcRn
x LamCaseVariant
lc_variant MatchGroup GhcRn (LHsCmd GhcRn)
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
new_matches, FreeVars
ms_fvs) }

rnCmd (HsCmdIf XCmdIf GhcPs
_ SyntaxExpr GhcPs
_ LHsExpr GhcPs
p LHsCmd GhcPs
b1 LHsCmd GhcPs
b2)
  = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
p', FreeVars
fvP) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
p
       ; (GenLocated SrcSpanAnnA (HsCmd GhcRn)
b1', FreeVars
fvB1) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
b1
       ; (GenLocated SrcSpanAnnA (HsCmd GhcRn)
b2', FreeVars
fvB2) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
b2

       ; Maybe Name
mb_ite <- RnM (Maybe Name)
lookupIfThenElse
       ; let (SyntaxExprRn
ite, FreeVars
fvITE) = case Maybe Name
mb_ite of
                Just Name
ite_name -> (Name -> SyntaxExprRn
mkRnSyntaxExpr Name
ite_name, Name -> FreeVars
unitFV Name
ite_name)
                Maybe Name
Nothing       -> (SyntaxExprRn
NoSyntaxExprRn,          FreeVars
emptyFVs)

       ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdIf GhcRn
-> SyntaxExpr GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> LHsCmd GhcRn
-> LHsCmd GhcRn
-> HsCmd GhcRn
forall id.
XCmdIf id
-> SyntaxExpr id
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcRn
NoExtField
noExtField SyntaxExpr GhcRn
SyntaxExprRn
ite XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
p' LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
b1' LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
b2', [FreeVars] -> FreeVars
plusFVs [FreeVars
fvITE, FreeVars
fvP, FreeVars
fvB1, FreeVars
fvB2])}

rnCmd (HsCmdLet XCmdLet GhcPs
_ LHsToken "let" GhcPs
tkLet HsLocalBinds GhcPs
binds LHsToken "in" GhcPs
tkIn LHsCmd GhcPs
cmd)
  = HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsCmd GhcRn, FreeVars))
-> TcM (HsCmd GhcRn, FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn -> FreeVars -> TcM (HsCmd GhcRn, FreeVars))
 -> TcM (HsCmd GhcRn, FreeVars))
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsCmd GhcRn, FreeVars))
-> TcM (HsCmd GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ HsLocalBinds GhcRn
binds' FreeVars
_ -> do
      { (GenLocated SrcSpanAnnA (HsCmd GhcRn)
cmd',FreeVars
fvExpr) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
cmd
      ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLet GhcRn
-> LHsToken "let" GhcRn
-> HsLocalBinds GhcRn
-> LHsToken "in" GhcRn
-> LHsCmd GhcRn
-> HsCmd GhcRn
forall id.
XCmdLet id
-> LHsToken "let" id
-> HsLocalBinds id
-> LHsToken "in" id
-> LHsCmd id
-> HsCmd id
HsCmdLet XCmdLet GhcRn
NoExtField
noExtField LHsToken "let" GhcPs
LHsToken "let" GhcRn
tkLet HsLocalBinds GhcRn
binds' LHsToken "in" GhcPs
LHsToken "in" GhcRn
tkIn LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
cmd', FreeVars
fvExpr) }

rnCmd (HsCmdDo XCmdDo GhcPs
_ (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
stmts))
  = do  { (([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts', ()
_), FreeVars
fvs) <-
            HsStmtContext GhcRn
-> (HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars))
-> [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> ([Name] -> RnM ((), FreeVars))
-> RnM
     (([LStmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))], ()),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (LocatedA (body GhcRn))], thing), FreeVars)
rnStmts HsStmtContext GhcRn
forall p. HsStmtContext p
ArrowExpr HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars)
rnCmd [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
stmts (\ [Name]
_ -> ((), FreeVars) -> RnM ((), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), FreeVars
emptyFVs))
        ; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( XCmdDo GhcRn -> XRec GhcRn [CmdLStmt GhcRn] -> HsCmd GhcRn
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo XCmdDo GhcRn
NoExtField
noExtField (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts'), FreeVars
fvs ) }

---------------------------------------------------
type CmdNeeds = FreeVars        -- Only inhabitants are
                                --      appAName, choiceAName, loopAName

-- find what methods the Cmd needs (loop, choice, apply)
methodNamesLCmd :: LHsCmd GhcRn -> CmdNeeds
methodNamesLCmd :: LHsCmd GhcRn -> FreeVars
methodNamesLCmd = HsCmd GhcRn -> FreeVars
methodNamesCmd (HsCmd GhcRn -> FreeVars)
-> (GenLocated SrcSpanAnnA (HsCmd GhcRn) -> HsCmd GhcRn)
-> GenLocated SrcSpanAnnA (HsCmd GhcRn)
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsCmd GhcRn) -> HsCmd GhcRn
forall l e. GenLocated l e -> e
unLoc

methodNamesCmd :: HsCmd GhcRn -> CmdNeeds

methodNamesCmd :: HsCmd GhcRn -> FreeVars
methodNamesCmd (HsCmdArrApp XCmdArrApp GhcRn
_ XRec GhcRn (HsExpr GhcRn)
_arrow XRec GhcRn (HsExpr GhcRn)
_arg HsArrAppType
HsFirstOrderApp Bool
_rtl)
  = FreeVars
emptyFVs
methodNamesCmd (HsCmdArrApp XCmdArrApp GhcRn
_ XRec GhcRn (HsExpr GhcRn)
_arrow XRec GhcRn (HsExpr GhcRn)
_arg HsArrAppType
HsHigherOrderApp Bool
_rtl)
  = Name -> FreeVars
unitFV Name
appAName
methodNamesCmd (HsCmdArrForm {}) = FreeVars
emptyFVs

methodNamesCmd (HsCmdPar XCmdPar GhcRn
_ LHsToken "(" GhcRn
_ LHsCmd GhcRn
c LHsToken ")" GhcRn
_) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c

methodNamesCmd (HsCmdIf XCmdIf GhcRn
_ SyntaxExpr GhcRn
_ XRec GhcRn (HsExpr GhcRn)
_ LHsCmd GhcRn
c1 LHsCmd GhcRn
c2)
  = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c1 FreeVars -> FreeVars -> FreeVars
`plusFV` LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c2 FreeVars -> Name -> FreeVars
`addOneFV` Name
choiceAName

methodNamesCmd (HsCmdLet XCmdLet GhcRn
_ LHsToken "let" GhcRn
_ HsLocalBinds GhcRn
_ LHsToken "in" GhcRn
_ LHsCmd GhcRn
c)      = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c
methodNamesCmd (HsCmdDo XCmdDo GhcRn
_ (L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts))   = [CmdLStmt GhcRn] -> FreeVars
methodNamesStmts [CmdLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts
methodNamesCmd (HsCmdApp XCmdApp GhcRn
_ LHsCmd GhcRn
c XRec GhcRn (HsExpr GhcRn)
_)          = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c
methodNamesCmd (HsCmdLam XCmdLam GhcRn
_ MatchGroup GhcRn (LHsCmd GhcRn)
match)        = MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch MatchGroup GhcRn (LHsCmd GhcRn)
match

methodNamesCmd (HsCmdCase XCmdCase GhcRn
_ XRec GhcRn (HsExpr GhcRn)
_ MatchGroup GhcRn (LHsCmd GhcRn)
matches)
  = MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch MatchGroup GhcRn (LHsCmd GhcRn)
matches FreeVars -> Name -> FreeVars
`addOneFV` Name
choiceAName
methodNamesCmd (HsCmdLamCase XCmdLamCase GhcRn
_ LamCaseVariant
_ MatchGroup GhcRn (LHsCmd GhcRn)
matches)
  = MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch MatchGroup GhcRn (LHsCmd GhcRn)
matches FreeVars -> Name -> FreeVars
`addOneFV` Name
choiceAName

--methodNamesCmd _ = emptyFVs
   -- Other forms can't occur in commands, but it's not convenient
   -- to error here so we just do what's convenient.
   -- The type checker will complain later

---------------------------------------------------
methodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
ms })
  = [FreeVars] -> FreeVars
plusFVs ((GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
 -> FreeVars)
-> [GenLocated
      SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> FreeVars
forall {l}.
GenLocated l (Match GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> FreeVars
do_one [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
ms)
 where
    do_one :: GenLocated l (Match GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> FreeVars
do_one (L l
_ (Match { m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
grhss })) = GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs GRHSs GhcRn (LHsCmd GhcRn)
GRHSs GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
grhss

-------------------------------------------------
-- gaw 2004
methodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs (GRHSs XCGRHSs GhcRn (LHsCmd GhcRn)
_ [LGRHS GhcRn (LHsCmd GhcRn)]
grhss HsLocalBinds GhcRn
_) = [FreeVars] -> FreeVars
plusFVs ((LocatedAn
   NoEpAnns (GRHS GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
 -> FreeVars)
-> [LocatedAn
      NoEpAnns (GRHS GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map LocatedAn NoEpAnns (GRHS GhcRn (LHsCmd GhcRn)) -> FreeVars
LocatedAn
  NoEpAnns (GRHS GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> FreeVars
methodNamesGRHS [LGRHS GhcRn (LHsCmd GhcRn)]
[LocatedAn
   NoEpAnns (GRHS GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
grhss)

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

methodNamesGRHS :: LocatedAn NoEpAnns (GRHS GhcRn (LHsCmd GhcRn)) -> CmdNeeds
methodNamesGRHS :: LocatedAn NoEpAnns (GRHS GhcRn (LHsCmd GhcRn)) -> FreeVars
methodNamesGRHS (L SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcRn (LHsCmd GhcRn)
_ [ExprLStmt GhcRn]
_ LHsCmd GhcRn
rhs)) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
rhs

---------------------------------------------------
methodNamesStmts :: [LStmtLR GhcRn GhcRn (LHsCmd GhcRn)] -> FreeVars
methodNamesStmts :: [CmdLStmt GhcRn] -> FreeVars
methodNamesStmts [CmdLStmt GhcRn]
stmts = [FreeVars] -> FreeVars
plusFVs ((GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
 -> FreeVars)
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map CmdLStmt GhcRn -> FreeVars
GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> FreeVars
methodNamesLStmt [CmdLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts)

---------------------------------------------------
methodNamesLStmt :: LStmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesLStmt :: CmdLStmt GhcRn -> FreeVars
methodNamesLStmt = StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
-> FreeVars
methodNamesStmt (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
 -> FreeVars)
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
    -> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))
forall l e. GenLocated l e -> e
unLoc

methodNamesStmt :: StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesStmt :: StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesStmt (LastStmt XLastStmt GhcRn GhcRn (LHsCmd GhcRn)
_ LHsCmd GhcRn
cmd Maybe Bool
_ SyntaxExpr GhcRn
_)           = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
cmd
methodNamesStmt (BodyStmt XBodyStmt GhcRn GhcRn (LHsCmd GhcRn)
_ LHsCmd GhcRn
cmd SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_)           = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
cmd
methodNamesStmt (BindStmt XBindStmt GhcRn GhcRn (LHsCmd GhcRn)
_ LPat GhcRn
_ LHsCmd GhcRn
cmd)             = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
cmd
methodNamesStmt (RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts }) =
  [CmdLStmt GhcRn] -> FreeVars
methodNamesStmts [CmdLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts FreeVars -> Name -> FreeVars
`addOneFV` Name
loopAName
methodNamesStmt (LetStmt {})                   = FreeVars
emptyFVs
methodNamesStmt (ParStmt {})                   = FreeVars
emptyFVs
methodNamesStmt (TransStmt {})                 = FreeVars
emptyFVs
methodNamesStmt ApplicativeStmt{}              = FreeVars
emptyFVs
   -- ParStmt and TransStmt can't occur in commands, but it's not
   -- convenient to error here so we just do what's convenient

{-
************************************************************************
*                                                                      *
        Arithmetic sequences
*                                                                      *
************************************************************************
-}

rnArithSeq :: ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq :: ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq (From LHsExpr GhcPs
expr)
 = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr
      ; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcRn (HsExpr GhcRn) -> ArithSeqInfo GhcRn
forall id. LHsExpr id -> ArithSeqInfo id
From XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr', FreeVars
fvExpr) }

rnArithSeq (FromThen LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2)
 = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr1
      ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr2', FreeVars
fvExpr2) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr2
      ; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn) -> ArithSeqInfo GhcRn
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr1' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr2', FreeVars
fvExpr1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr2) }

rnArithSeq (FromTo LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2)
 = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr1
      ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr2', FreeVars
fvExpr2) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr2
      ; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn) -> ArithSeqInfo GhcRn
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr1' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr2', FreeVars
fvExpr1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr2) }

rnArithSeq (FromThenTo LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2 LHsExpr GhcPs
expr3)
 = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr1
      ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr2', FreeVars
fvExpr2) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr2
      ; (GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr3', FreeVars
fvExpr3) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
expr3
      ; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> ArithSeqInfo GhcRn
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr1' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr2' XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr3',
                [FreeVars] -> FreeVars
plusFVs [FreeVars
fvExpr1, FreeVars
fvExpr2, FreeVars
fvExpr3]) }

{-
************************************************************************
*                                                                      *
\subsubsection{@Stmt@s: in @do@ expressions}
*                                                                      *
************************************************************************
-}

{-
Note [Deterministic ApplicativeDo and RecursiveDo desugaring]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Both ApplicativeDo and RecursiveDo need to create tuples not
present in the source text.

For ApplicativeDo we create:

  (a,b,c) <- (\c b a -> (a,b,c)) <$>

For RecursiveDo we create:

  mfix (\ ~(a,b,c) -> do ...; return (a',b',c'))

The order of the components in those tuples needs to be stable
across recompilations, otherwise they can get optimized differently
and we end up with incompatible binaries.
To get a stable order we use nameSetElemsStable.
See Note [Deterministic UniqFM] to learn more about nondeterminism.
-}

type AnnoBody body
  = ( Outputable (body GhcPs)
    )

-- | Rename some Stmts
rnStmts :: AnnoBody body
        => HsStmtContext GhcRn
        -> (body GhcPs -> RnM (body GhcRn, FreeVars))
           -- ^ How to rename the body of each statement (e.g. rnLExpr)
        -> [LStmt GhcPs (LocatedA (body GhcPs))]
           -- ^ Statements
        -> ([Name] -> RnM (thing, FreeVars))
           -- ^ if these statements scope over something, this renames it
           -- and returns the result.
        -> RnM (([LStmt GhcRn (LocatedA (body GhcRn))], thing), FreeVars)
rnStmts :: forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (LocatedA (body GhcRn))], thing), FreeVars)
rnStmts HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [LStmt GhcPs (LocatedA (body GhcPs))]
stmts [Name] -> RnM (thing, FreeVars)
thing_inside
 = do { (([(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts', thing
thing), FreeVars
fvs) <- HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmtsWithFreeVars HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [LStmt GhcPs (LocatedA (body GhcPs))]
stmts [Name] -> RnM (thing, FreeVars)
thing_inside
      ; (([GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([GenLocated
          SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((((GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)
 -> GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
 FreeVars)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall a b. (a, b) -> a
fst [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts', thing
thing), FreeVars
fvs) }

-- | maybe rearrange statements according to the ApplicativeDo transformation
postProcessStmtsForApplicativeDo
  :: HsDoFlavour
  -> [(ExprLStmt GhcRn, FreeVars)]
  -> RnM ([ExprLStmt GhcRn], FreeVars)
postProcessStmtsForApplicativeDo :: HsDoFlavour
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
postProcessStmtsForApplicativeDo HsDoFlavour
ctxt [(ExprLStmt GhcRn, FreeVars)]
stmts
  = do {
       -- rearrange the statements using ApplicativeStmt if
       -- -XApplicativeDo is on.  Also strip out the FreeVars attached
       -- to each Stmt body.
         Bool
ado_is_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.ApplicativeDo
       ; let is_do_expr :: Bool
is_do_expr | DoExpr{} <- HsDoFlavour
ctxt = Bool
True
                        | Bool
otherwise = Bool
False
       -- don't apply the transformation inside TH brackets, because
       -- GHC.HsToCore.Quote does not handle ApplicativeDo.
       ; Bool
in_th_bracket <- ThStage -> Bool
isBrackStage (ThStage -> Bool) -> TcM ThStage -> TcRnIf TcGblEnv TcLclEnv Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcM ThStage
getStage
       ; if Bool
ado_is_on Bool -> Bool -> Bool
&& Bool
is_do_expr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
in_th_bracket
            then do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"ppsfa" ([(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> SDoc
forall a. Outputable a => a -> SDoc
ppr [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts)
                    ; HsDoFlavour
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
rearrangeForApplicativeDo HsDoFlavour
ctxt [(ExprLStmt GhcRn, FreeVars)]
stmts }
            else HsStmtContext GhcRn
-> [(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)),
     FreeVars)]
-> RnM
     ([LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))], FreeVars)
forall (body :: * -> *).
HsStmtContext GhcRn
-> [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
noPostProcessStmts (HsDoFlavour -> HsStmtContext GhcRn
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) [(ExprLStmt GhcRn, FreeVars)]
[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
stmts }

-- | strip the FreeVars annotations from statements
noPostProcessStmts
  :: HsStmtContext GhcRn
  -> [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
  -> RnM ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
noPostProcessStmts :: forall (body :: * -> *).
HsStmtContext GhcRn
-> [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
noPostProcessStmts HsStmtContext GhcRn
_ [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
stmts = ([GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (((GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)
 -> GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
 FreeVars)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall a b. (a, b) -> a
fst [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
[(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts, FreeVars
emptyNameSet)


rnStmtsWithFreeVars :: AnnoBody body
        => HsStmtContext GhcRn
        -> ((body GhcPs) -> RnM ((body GhcRn), FreeVars))
        -> [LStmt GhcPs (LocatedA (body GhcPs))]
        -> ([Name] -> RnM (thing, FreeVars))
        -> RnM ( ([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing)
               , FreeVars)
-- Each Stmt body is annotated with its FreeVars, so that
-- we can rearrange statements for ApplicativeDo.
--
-- Variables bound by the Stmts, and mentioned in thing_inside,
-- do not appear in the result FreeVars

rnStmtsWithFreeVars :: forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmtsWithFreeVars HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
_ [] [Name] -> RnM (thing, FreeVars)
thing_inside
  = do { HsStmtContext GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkEmptyStmts HsStmtContext GhcRn
ctxt
       ; (thing
thing, FreeVars
fvs) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
       ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([], thing
thing), FreeVars
fvs) }

rnStmtsWithFreeVars mDoExpr :: HsStmtContext GhcRn
mDoExpr@(HsDoStmt MDoExpr{}) body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody ([LStmt GhcPs (LocatedA (body GhcPs))]
-> Maybe
     (NonEmpty
        (GenLocated
           SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))))
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
-> Maybe
     (NonEmpty
        (GenLocated
           SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty -> Just NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
stmts) [Name] -> RnM (thing, FreeVars)
thing_inside    -- Deal with mdo
  = -- Behave like do { rec { ...all but last... }; last }
    do { (([(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts1, ([(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts2, thing
thing)), FreeVars
fvs)
           <- HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmt HsStmtContext GhcRn
mDoExpr body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
 -> GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
-> StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
forall a b. (a -> b) -> a -> b
$ EpAnn AnnList
-> LocatedL [LStmt GhcPs (LocatedA (body GhcPs))]
-> StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
forall (idL :: Pass) bodyR.
(Anno
   [GenLocated
      (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
      (StmtLR (GhcPass idL) GhcPs bodyR)]
 ~ SrcSpanAnnL) =>
EpAnn AnnList
-> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt EpAnn AnnList
forall a. EpAnn a
noAnn ([GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA (NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
forall a. NonEmpty a -> [a]
NE.init NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
stmts))) (([Name]
  -> IOEnv
       (Env TcGblEnv TcLclEnv)
       (([(GenLocated
             SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
           FreeVars)],
         thing),
        FreeVars))
 -> RnM
      (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
        ([(GenLocated
             SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
           FreeVars)],
         thing)),
       FreeVars))
-> ([Name]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
_ ->
              do { GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
last_stmt' <- HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
checkLastStmt HsStmtContext GhcRn
mDoExpr (NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
forall a. NonEmpty a -> a
NE.last NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
stmts)
                 ; HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmt HsStmtContext GhcRn
mDoExpr body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
last_stmt' [Name] -> RnM (thing, FreeVars)
thing_inside }
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts1 [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
forall a. [a] -> [a] -> [a]
++ [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts2), thing
thing), FreeVars
fvs) }

rnStmtsWithFreeVars HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody (lstmt :: LStmt GhcPs (LocatedA (body GhcPs))
lstmt@(L SrcSpanAnnA
loc StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
_) : [LStmt GhcPs (LocatedA (body GhcPs))]
lstmts) [Name] -> RnM (thing, FreeVars)
thing_inside
  | [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LStmt GhcPs (LocatedA (body GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
lstmts
  = SrcSpanAnnA
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (RnM
   (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
    FreeVars)
 -> RnM
      (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
       FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall a b. (a -> b) -> a -> b
$
    do { GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
lstmt' <- HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
checkLastStmt HsStmtContext GhcRn
ctxt LStmt GhcPs (LocatedA (body GhcPs))
lstmt
       ; HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
lstmt' [Name] -> RnM (thing, FreeVars)
thing_inside }

  | Bool
otherwise
  = do { (([(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts1, ([(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts2, thing
thing)), FreeVars
fvs)
            <- SrcSpanAnnA
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc                  (IOEnv
   (Env TcGblEnv TcLclEnv)
   (([(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
       FreeVars)],
     ([(GenLocated
          SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
        FreeVars)],
      thing)),
    FreeVars)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        ([(GenLocated
             SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
           FreeVars)],
         thing)),
       FreeVars))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
forall a b. (a -> b) -> a -> b
$
               do { HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkStmt HsStmtContext GhcRn
ctxt LStmt GhcPs (LocatedA (body GhcPs))
lstmt
                  ; HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody LStmt GhcPs (LocatedA (body GhcPs))
lstmt (([Name]
  -> IOEnv
       (Env TcGblEnv TcLclEnv)
       (([(GenLocated
             SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
           FreeVars)],
         thing),
        FreeVars))
 -> RnM
      (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
        ([(GenLocated
             SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
           FreeVars)],
         thing)),
       FreeVars))
-> ([Name]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
       ([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing)),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs1 ->
                    HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmtsWithFreeVars HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [LStmt GhcPs (LocatedA (body GhcPs))]
lstmts  (([Name] -> RnM (thing, FreeVars))
 -> RnM
      (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
       FreeVars))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs2 ->
                    [Name] -> RnM (thing, FreeVars)
thing_inside ([Name]
bndrs1 [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
bndrs2) }
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts1 [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
forall a. [a] -> [a] -> [a]
++ [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts2), thing
thing), FreeVars
fvs) }

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

{-
Note [Failing pattern matches in Stmts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Many things desugar to HsStmts including monadic things like `do` and `mdo`
statements, pattern guards, and list comprehensions (see 'HsStmtContext' for an
exhaustive list). How we deal with pattern match failure is context-dependent.

 * In the case of list comprehensions and pattern guards we don't need any
   'fail' function; the desugarer ignores the fail function of 'BindStmt'
   entirely. So, for list comprehensions, the fail function is set to 'Nothing'
   for clarity.

* In the case of monadic contexts (e.g. monad comprehensions, do, and mdo
   expressions) we want pattern match failure to be desugared to the
   'fail' function (from MonadFail type class).

At one point we failed to make this distinction, leading to #11216.
-}

rnStmt :: AnnoBody body
       => HsStmtContext GhcRn
       -> (body GhcPs -> RnM (body GhcRn, FreeVars))
          -- ^ How to rename the body of the statement
       -> LStmt GhcPs (LocatedA (body GhcPs))
          -- ^ The statement
       -> ([Name] -> RnM (thing, FreeVars))
          -- ^ Rename the stuff that this statement scopes over
       -> RnM ( ([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing)
              , FreeVars)
-- Variables bound by the Stmt, and mentioned in thing_inside,
-- do not appear in the result FreeVars

rnStmt :: forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> LStmt GhcPs (LocatedA (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody (L SrcSpanAnnA
loc (LastStmt XLastStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ (L SrcSpanAnnA
lb body GhcPs
body) Maybe Bool
noret SyntaxExpr GhcPs
_)) [Name] -> RnM (thing, FreeVars)
thing_inside
  = do  { (body GhcRn
body', FreeVars
fv_expr) <- body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody body GhcPs
body
        ; (SyntaxExprRn
ret_op, FreeVars
fvs1) <- if HsStmtContext GhcRn -> Bool
forall id. HsStmtContext id -> Bool
isMonadCompContext HsStmtContext GhcRn
ctxt
                            then HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
returnMName
                            else (SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExpr GhcRn
SyntaxExprRn
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr, FreeVars
emptyFVs)
                            -- The 'return' in a LastStmt is used only
                            -- for MonadComp; and we don't want to report
                            -- "non in scope: return" in other cases
                            -- #15607

        ; (thing
thing,  FreeVars
fvs3) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XLastStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> LocatedA (body GhcRn)
-> Maybe Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcRn GhcRn (LocatedA (body GhcRn))
NoExtField
noExtField (SrcSpanAnnA -> body GhcRn -> LocatedA (body GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lb body GhcRn
body') Maybe Bool
noret SyntaxExpr GhcRn
SyntaxExprRn
ret_op), FreeVars
fv_expr)]
                  , thing
thing), FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }

rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody (L SrcSpanAnnA
loc (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ (L SrcSpanAnnA
lb body GhcPs
body) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) [Name] -> RnM (thing, FreeVars)
thing_inside
  = do  { (body GhcRn
body', FreeVars
fv_expr) <- body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody body GhcPs
body
        ; (SyntaxExprRn
then_op, FreeVars
fvs1)  <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
thenMName

        ; (SyntaxExprRn
guard_op, FreeVars
fvs2) <- if HsStmtContext GhcRn -> Bool
forall id. HsStmtContext id -> Bool
isComprehensionContext HsStmtContext GhcRn
ctxt
                              then HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
guardMName
                              else (SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExpr GhcRn
SyntaxExprRn
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr, FreeVars
emptyFVs)
                              -- Only list/monad comprehensions use 'guard'
                              -- Also for sub-stmts of same eg [ e | x<-xs, gd | blah ]
                              -- Here "gd" is a guard

        ; (thing
thing, FreeVars
fvs3)    <- [Name] -> RnM (thing, FreeVars)
thing_inside []
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XBodyStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> LocatedA (body GhcRn)
-> SyntaxExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcRn GhcRn (LocatedA (body GhcRn))
NoExtField
noExtField (SrcSpanAnnA -> body GhcRn -> LocatedA (body GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lb body GhcRn
body') SyntaxExpr GhcRn
SyntaxExprRn
then_op SyntaxExpr GhcRn
SyntaxExprRn
guard_op), FreeVars
fv_expr)]
                  , thing
thing), FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }

rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody (L SrcSpanAnnA
loc (BindStmt XBindStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LPat GhcPs
pat (L SrcSpanAnnA
lb body GhcPs
body))) [Name] -> RnM (thing, FreeVars)
thing_inside
  = do  { (body GhcRn
body', FreeVars
fv_expr) <- body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody body GhcPs
body
                -- The binders do not scope over the expression
        ; (SyntaxExprRn
bind_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
bindMName

        ; (Maybe SyntaxExprRn
fail_op, FreeVars
fvs2) <- LPat GhcPs
-> HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
monadFailOp LPat GhcPs
pat HsStmtContext GhcRn
ctxt

        ; HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a.
HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
forall p. HsStmtContext p -> HsMatchContext p
StmtCtxt HsStmtContext GhcRn
ctxt) LPat GhcPs
pat ((LPat GhcRn
  -> IOEnv
       (Env TcGblEnv TcLclEnv)
       (([(GenLocated
             SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
           FreeVars)],
         thing),
        FreeVars))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing),
       FreeVars))
-> (LPat GhcRn
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \ LPat GhcRn
pat' -> do
        { (thing
thing, FreeVars
fvs3) <- [Name] -> RnM (thing, FreeVars)
thing_inside (CollectFlag GhcRn -> LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders LPat GhcRn
pat')
        ; let xbsrn :: XBindStmtRn
xbsrn = XBindStmtRn { xbsrn_bindOp :: SyntaxExpr GhcRn
xbsrn_bindOp = SyntaxExpr GhcRn
SyntaxExprRn
bind_op, xbsrn_failOp :: Maybe (SyntaxExpr GhcRn)
xbsrn_failOp = Maybe (SyntaxExpr GhcRn)
Maybe SyntaxExprRn
fail_op }
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (( [( SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XBindStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> LPat GhcRn
-> LocatedA (body GhcRn)
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt GhcRn GhcRn (LocatedA (body GhcRn))
XBindStmtRn
xbsrn LPat GhcRn
pat' (SrcSpanAnnA -> body GhcRn -> LocatedA (body GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lb body GhcRn
body')), FreeVars
fv_expr )]
                  , thing
thing),
                  FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }}
       -- fv_expr shouldn't really be filtered by the rnPatsAndThen
        -- but it does not matter because the names are unique

rnStmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ (L SrcSpanAnnA
loc (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ HsLocalBinds GhcPs
binds)) [Name] -> RnM (thing, FreeVars)
thing_inside
  =     HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn
    -> FreeVars
    -> RnM
         (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
          FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn
  -> FreeVars
  -> RnM
       (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
        FreeVars))
 -> RnM
      (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
       FreeVars))
-> (HsLocalBinds GhcRn
    -> FreeVars
    -> RnM
         (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
          FreeVars))
-> RnM
     (([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)], thing),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsLocalBinds GhcRn
binds' FreeVars
bind_fvs -> do
        { (thing
thing, FreeVars
fvs) <- [Name] -> RnM (thing, FreeVars)
thing_inside (CollectFlag GhcRn -> HsLocalBinds GhcRn -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcRn
binds')
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XLetStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> HsLocalBinds GhcRn -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcRn GhcRn (LocatedA (body GhcRn))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn HsLocalBinds GhcRn
binds'), FreeVars
bind_fvs)], thing
thing)
                 , FreeVars
fvs) }

rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody (L SrcSpanAnnA
loc (RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
rec_stmts })) [Name] -> RnM (thing, FreeVars)
thing_inside
  = do  { (SyntaxExprRn
return_op, FreeVars
fvs1)  <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
returnMName
        ; (SyntaxExprRn
mfix_op,   FreeVars
fvs2)  <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
mfixName
        ; (SyntaxExprRn
bind_op,   FreeVars
fvs3)  <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
bindMName
        ; let empty_rec_stmt :: StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
empty_rec_stmt = (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall bodyR.
(Anno
   [GenLocated
      (Anno (StmtLR GhcRn GhcRn bodyR)) (StmtLR GhcRn GhcRn bodyR)]
 ~ SrcSpanAnnL) =>
StmtLR GhcRn GhcRn bodyR
forall {body :: * -> *}. StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
emptyRecStmtName :: StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
                                { recS_ret_fn  = return_op
                                , recS_mfix_fn = mfix_op
                                , recS_bind_fn = bind_op }

        -- Step1: Bring all the binders of the mdo into scope
        -- (Remember that this also removes the binders from the
        -- finally-returned free-vars.)
        -- And rename each individual stmt, making a
        -- singleton segment.  At this stage the FwdRefs field
        -- isn't finished: it's empty for all except a BindStmt
        -- for which it's the fwd refs within the bind itself
        -- (This set may not be empty, because we're in a recursive
        -- context.)
        ; HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall (body :: * -> *) a.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
    -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnRecStmtsAndThen HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [LStmt GhcPs (LocatedA (body GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
rec_stmts   (([Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
  -> IOEnv
       (Env TcGblEnv TcLclEnv)
       (([(GenLocated
             SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
           FreeVars)],
         thing),
        FreeVars))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (([(GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
          FreeVars)],
        thing),
       FreeVars))
-> ([Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(GenLocated
               SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
             FreeVars)],
           thing),
          FreeVars))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
segs -> do
        { let bndrs :: [Name]
bndrs = FreeVars -> [Name]
nameSetElemsStable (FreeVars -> [Name]) -> FreeVars -> [Name]
forall a b. (a -> b) -> a -> b
$
                        ((FreeVars, FreeVars, FreeVars,
  GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))
 -> FreeVars -> FreeVars)
-> FreeVars
-> [(FreeVars, FreeVars, FreeVars,
     GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
-> FreeVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FreeVars -> FreeVars -> FreeVars
unionNameSet (FreeVars -> FreeVars -> FreeVars)
-> ((FreeVars, FreeVars, FreeVars,
     GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))
    -> FreeVars)
-> (FreeVars, FreeVars, FreeVars,
    GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))
-> FreeVars
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(FreeVars
ds,FreeVars
_,FreeVars
_,GenLocated SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
_) -> FreeVars
ds))
                              FreeVars
emptyNameSet
                              [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
[(FreeVars, FreeVars, FreeVars,
  GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
segs
          -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]
        ; (thing
thing, FreeVars
fvs_later) <- [Name] -> RnM (thing, FreeVars)
thing_inside [Name]
bndrs
        -- In interactive mode, all variables could be used later. So we pass whether
        -- we are in GHCi along to segmentRecStmts. See Note [What is "used later" in a rec stmt]
        ; Bool
is_interactive <- Module -> Bool
isInteractiveModule (Module -> Bool) -> (TcGblEnv -> Module) -> TcGblEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcGblEnv -> Module
tcg_mod (TcGblEnv -> Bool)
-> IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
-> TcRnIf TcGblEnv TcLclEnv Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
        ; let
             ([LStmt GhcRn (LocatedA (body GhcRn))]
rec_stmts', FreeVars
fvs) = SrcSpan
-> HsStmtContext GhcRn
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
-> (FreeVars, Bool)
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
forall (body :: * -> *).
SrcSpan
-> HsStmtContext GhcRn
-> Stmt GhcRn (LocatedA (body GhcRn))
-> [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
-> (FreeVars, Bool)
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
segmentRecStmts (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) HsStmtContext GhcRn
ctxt StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
empty_rec_stmt [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
segs (FreeVars
fvs_later, Bool
is_interactive)
        -- We aren't going to try to group RecStmts with
        -- ApplicativeDo, so attaching empty FVs is fine.
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( (([GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))]
-> [FreeVars]
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LStmt GhcRn (LocatedA (body GhcRn))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))]
rec_stmts' (FreeVars -> [FreeVars]
forall a. a -> [a]
repeat FreeVars
emptyNameSet)), thing
thing)
                 , FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) } }

rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
_ (L SrcSpanAnnA
loc (ParStmt XParStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
segs HsExpr GhcPs
_ SyntaxExpr GhcPs
_)) [Name] -> RnM (thing, FreeVars)
thing_inside
  = do  { (HsExpr GhcRn
mzip_op, FreeVars
fvs1)   <- HsStmtContext GhcRn -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext GhcRn
ctxt Name
mzipName
        ; (SyntaxExprRn
bind_op, FreeVars
fvs2)   <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
bindMName
        ; (SyntaxExprRn
return_op, FreeVars
fvs3) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
returnMName
        ; (([ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs4) <- HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall thing.
HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts (HsStmtContext GhcRn -> HsStmtContext GhcRn
forall p. HsStmtContext p -> HsStmtContext p
ParStmtCtxt HsStmtContext GhcRn
ctxt) SyntaxExpr GhcRn
SyntaxExprRn
return_op [ParStmtBlock GhcPs GhcPs]
segs [Name] -> RnM (thing, FreeVars)
thing_inside
        ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XParStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> [ParStmtBlock GhcRn GhcRn]
-> HsExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt XParStmt GhcRn GhcRn (LocatedA (body GhcRn))
NoExtField
noExtField [ParStmtBlock GhcRn GhcRn]
segs' HsExpr GhcRn
mzip_op SyntaxExpr GhcRn
SyntaxExprRn
bind_op), FreeVars
fvs4)], thing
thing)
                 , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs4) }

rnStmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
_ (L SrcSpanAnnA
loc (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [ExprLStmt GhcPs]
stmts, trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_by = Maybe (LHsExpr GhcPs)
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 GhcPs
using })) [Name] -> RnM (thing, FreeVars)
thing_inside
  = do { -- Rename the 'using' expression in the context before the transform is begun
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)
using', FreeVars
fvs1) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
using

         -- Rename the stmts and the 'by' expression
         -- Keep track of the variables mentioned in the 'by' expression
       ; (([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts', (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
by', [Name]
used_bndrs, thing
thing)), FreeVars
fvs2)
             <- HsStmtContext GhcRn
-> (HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars))
-> [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> ([Name]
    -> RnM
         ((Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing),
          FreeVars))
-> RnM
     (([LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))],
       (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing)),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (LocatedA (body GhcRn))], thing), FreeVars)
rnStmts (HsStmtContext GhcRn -> HsStmtContext GhcRn
forall p. HsStmtContext p -> HsStmtContext p
TransStmtCtxt HsStmtContext GhcRn
ctxt) HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr [ExprLStmt GhcPs]
[LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts (([Name]
  -> RnM
       ((Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing),
        FreeVars))
 -> RnM
      (([LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))],
        (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing)),
       FreeVars))
-> ([Name]
    -> RnM
         ((Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing),
          FreeVars))
-> RnM
     (([LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))],
       (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing)),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs ->
                do { (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
by',   FreeVars
fvs_by) <- (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RnM (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)
forall a b.
(a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
mapMaybeFvRn LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsExpr GhcRn), FreeVars)
rnLExpr Maybe (LHsExpr GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
by
                   ; (thing
thing, FreeVars
fvs_thing) <- [Name] -> RnM (thing, FreeVars)
thing_inside [Name]
bndrs
                   ; let fvs :: FreeVars
fvs = FreeVars
fvs_by FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_thing
                         used_bndrs :: [Name]
used_bndrs = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> FreeVars -> Bool
`elemNameSet` FreeVars
fvs) [Name]
bndrs
                         -- The paper (Fig 5) has a bug here; we must treat any free variable
                         -- of the "thing inside", **or of the by-expression**, as used
                   ; ((Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing),
 FreeVars)
-> RnM
     ((Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)), [Name], thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
by', [Name]
used_bndrs, thing
thing), FreeVars
fvs) }

       -- Lookup `return`, `(>>=)` and `liftM` for monad comprehensions
       ; (SyntaxExprRn
return_op, FreeVars
fvs3) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
returnMName
       ; (SyntaxExprRn
bind_op,   FreeVars
fvs4) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
bindMName
       ; (HsExpr GhcRn
fmap_op,   FreeVars
fvs5) <- case TransForm
form of
                                TransForm
ThenForm -> (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
forall (p :: Pass). HsExpr (GhcPass p)
noExpr, FreeVars
emptyFVs)
                                TransForm
_        -> HsStmtContext GhcRn -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext GhcRn
ctxt Name
fmapName

       ; let all_fvs :: FreeVars
all_fvs  = FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3
                             FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs4 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs5
             bndr_map :: [(Name, Name)]
bndr_map = [Name]
used_bndrs [Name] -> [Name] -> [(Name, Name)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Name]
used_bndrs
             -- See Note [TransStmt binder map] in GHC.Hs.Expr

       ; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"rnStmt: implicitly rebound these used binders:" ([(Name, Name)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(Name, Name)]
bndr_map)
       ; (([(GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
    FreeVars)],
  thing),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (TransStmt { trS_ext :: XTransStmt GhcRn GhcRn (LocatedA (body GhcRn))
trS_ext = XTransStmt GhcRn GhcRn (LocatedA (body GhcRn))
NoExtField
noExtField
                                    , trS_stmts :: [ExprLStmt GhcRn]
trS_stmts = [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts', trS_bndrs :: [(IdP GhcRn, IdP GhcRn)]
trS_bndrs = [(IdP GhcRn, IdP GhcRn)]
[(Name, Name)]
bndr_map
                                    , trS_by :: Maybe (XRec GhcRn (HsExpr GhcRn))
trS_by = Maybe (XRec GhcRn (HsExpr GhcRn))
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
by', trS_using :: XRec GhcRn (HsExpr GhcRn)
trS_using = XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
using', trS_form :: TransForm
trS_form = TransForm
form
                                    , trS_ret :: SyntaxExpr GhcRn
trS_ret = SyntaxExpr GhcRn
SyntaxExprRn
return_op, trS_bind :: SyntaxExpr GhcRn
trS_bind = SyntaxExpr GhcRn
SyntaxExprRn
bind_op
                                    , trS_fmap :: HsExpr GhcRn
trS_fmap = HsExpr GhcRn
fmap_op }), FreeVars
fvs2)], thing
thing), FreeVars
all_fvs) }

rnStmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ (L SrcSpanAnnA
_ ApplicativeStmt{}) [Name] -> RnM (thing, FreeVars)
_ =
  String
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (([(GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
         FreeVars)],
       thing),
      FreeVars)
forall a. HasCallStack => String -> a
panic String
"rnStmt: ApplicativeStmt"

rnParallelStmts :: forall thing. HsStmtContext GhcRn
                -> SyntaxExpr GhcRn
                -> [ParStmtBlock GhcPs GhcPs]
                -> ([Name] -> RnM (thing, FreeVars))
                -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-- Note [Renaming parallel Stmts]
rnParallelStmts :: forall thing.
HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts HsStmtContext GhcRn
ctxt SyntaxExpr GhcRn
return_op [ParStmtBlock GhcPs GhcPs]
segs [Name] -> RnM (thing, FreeVars)
thing_inside
  = do { LocalRdrEnv
orig_lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; LocalRdrEnv
-> [Name]
-> [ParStmtBlock GhcPs GhcPs]
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rn_segs LocalRdrEnv
orig_lcl_env [] [ParStmtBlock GhcPs GhcPs]
segs }
  where
    rn_segs :: LocalRdrEnv
            -> [Name] -> [ParStmtBlock GhcPs GhcPs]
            -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
    rn_segs :: LocalRdrEnv
-> [Name]
-> [ParStmtBlock GhcPs GhcPs]
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rn_segs LocalRdrEnv
_ [Name]
bndrs_so_far []
      = do { let ([Name]
bndrs', [NonEmpty Name]
dups) = (Name -> Name -> Ordering) -> [Name] -> ([Name], [NonEmpty Name])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups Name -> Name -> Ordering
cmpByOcc [Name]
bndrs_so_far
           ; (NonEmpty Name -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [NonEmpty Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ NonEmpty Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupErr [NonEmpty Name]
dups
           ; (thing
thing, FreeVars
fvs) <- [Name] -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)
forall a. [Name] -> RnM a -> RnM a
bindLocalNames [Name]
bndrs' ([Name] -> RnM (thing, FreeVars)
thing_inside [Name]
bndrs')
           ; (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([], thing
thing), FreeVars
fvs) }

    rn_segs LocalRdrEnv
env [Name]
bndrs_so_far (ParStmtBlock XParStmtBlock GhcPs GhcPs
x [ExprLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_ : [ParStmtBlock GhcPs GhcPs]
segs)
      = do { (([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts', ([Name]
used_bndrs, [ParStmtBlock GhcRn GhcRn]
segs', thing
thing)), FreeVars
fvs)
                    <- HsStmtContext GhcRn
-> (HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars))
-> [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> ([Name]
    -> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
     (([LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))],
       ([Name], [ParStmtBlock GhcRn GhcRn], thing)),
      FreeVars)
forall (body :: * -> *) thing.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (LocatedA (body GhcRn))], thing), FreeVars)
rnStmts HsStmtContext GhcRn
ctxt HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr [ExprLStmt GhcPs]
[LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts (([Name]
  -> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
 -> RnM
      (([LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))],
        ([Name], [ParStmtBlock GhcRn GhcRn], thing)),
       FreeVars))
-> ([Name]
    -> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
     (([LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))],
       ([Name], [ParStmtBlock GhcRn GhcRn], thing)),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs ->
                       LocalRdrEnv
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a. LocalRdrEnv -> RnM a -> RnM a
setLocalRdrEnv LocalRdrEnv
env       (RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
 -> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a b. (a -> b) -> a -> b
$ do
                       { (([ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs) <- LocalRdrEnv
-> [Name]
-> [ParStmtBlock GhcPs GhcPs]
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rn_segs LocalRdrEnv
env ([Name]
bndrs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
bndrs_so_far) [ParStmtBlock GhcPs GhcPs]
segs
                       ; let used_bndrs :: [Name]
used_bndrs = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> FreeVars -> Bool
`elemNameSet` FreeVars
fvs) [Name]
bndrs
                       ; (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([Name]
used_bndrs, [ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs) }

           ; let seg' :: ParStmtBlock GhcRn GhcRn
seg' = XParStmtBlock GhcRn GhcRn
-> [ExprLStmt GhcRn]
-> [IdP GhcRn]
-> SyntaxExpr GhcRn
-> ParStmtBlock GhcRn GhcRn
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock GhcPs GhcPs
XParStmtBlock GhcRn GhcRn
x [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts' [IdP GhcRn]
[Name]
used_bndrs SyntaxExpr GhcRn
return_op
           ; (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ParStmtBlock GhcRn GhcRn
seg'ParStmtBlock GhcRn GhcRn
-> [ParStmtBlock GhcRn GhcRn] -> [ParStmtBlock GhcRn GhcRn]
forall a. a -> [a] -> [a]
:[ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs) }

    cmpByOcc :: Name -> Name -> Ordering
cmpByOcc Name
n1 Name
n2 = Name -> OccName
nameOccName Name
n1 OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Name -> OccName
nameOccName Name
n2
    dupErr :: NonEmpty Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupErr NonEmpty Name
vs = TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ Name -> TcRnMessage
TcRnListComprehensionDuplicateBinding (NonEmpty Name -> Name
forall a. NonEmpty a -> a
NE.head NonEmpty Name
vs)

lookupQualifiedDoStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
-- Like lookupStmtName, but respects QualifiedDo
lookupQualifiedDoStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
n
  = case HsStmtContext GhcRn -> Maybe ModuleName
forall p. HsStmtContext p -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext GhcRn
ctxt of
      Maybe ModuleName
Nothing -> HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
n
      Just ModuleName
modName ->
        (Name -> SyntaxExprRn)
-> (Name, FreeVars) -> (SyntaxExprRn, FreeVars)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr (HsExpr GhcRn -> SyntaxExprRn)
-> (Name -> HsExpr GhcRn) -> Name -> SyntaxExprRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdP GhcRn -> HsExpr GhcRn
Name -> HsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar) ((Name, FreeVars) -> (SyntaxExprRn, FreeVars))
-> RnM (Name, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> ModuleName -> RnM (Name, FreeVars)
lookupNameWithQualifier Name
n ModuleName
modName

lookupStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
-- Like lookupSyntax, but respects contexts
lookupStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
n
  | HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
ctxt
  = Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax Name
n
  | Bool
otherwise
  = (SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SyntaxExprRn
mkRnSyntaxExpr Name
n, FreeVars
emptyFVs)

lookupStmtNamePoly :: HsStmtContext GhcRn -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly :: HsStmtContext GhcRn -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext GhcRn
ctxt Name
name
  | HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
ctxt
  = do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if Bool
rebindable_on
         then do { Name
fm <- RdrName -> RnM Name
lookupOccRn (Name -> RdrName
nameRdrName Name
name)
                 ; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> XRec GhcRn (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (Name -> GenLocated SrcSpanAnnN Name
forall a an. a -> LocatedAn an a
noLocA Name
fm), Name -> FreeVars
unitFV Name
fm) }
         else TcM (HsExpr GhcRn, FreeVars)
not_rebindable }
  | Bool
otherwise
  = TcM (HsExpr GhcRn, FreeVars)
not_rebindable
  where
    not_rebindable :: TcM (HsExpr GhcRn, FreeVars)
not_rebindable = (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> XRec GhcRn (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (Name -> GenLocated SrcSpanAnnN Name
forall a an. a -> LocatedAn an a
noLocA Name
name), FreeVars
emptyFVs)

-- | Is this a context where we respect RebindableSyntax?
-- but ListComp are never rebindable
-- Neither is ArrowExpr, which has its own desugarer in GHC.HsToCore.Arrows
rebindableContext :: HsStmtContext GhcRn -> Bool
rebindableContext :: HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
ctxt = case HsStmtContext GhcRn
ctxt of
  HsDoStmt HsDoFlavour
flavour -> HsDoFlavour -> Bool
rebindableDoStmtContext HsDoFlavour
flavour
  HsStmtContext GhcRn
ArrowExpr -> Bool
False
  PatGuard {} -> Bool
False


  ParStmtCtxt   HsStmtContext GhcRn
c -> HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
c     -- Look inside to
  TransStmtCtxt HsStmtContext GhcRn
c -> HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
c     -- the parent context

rebindableDoStmtContext :: HsDoFlavour -> Bool
rebindableDoStmtContext :: HsDoFlavour -> Bool
rebindableDoStmtContext HsDoFlavour
flavour = case HsDoFlavour
flavour of
  HsDoFlavour
ListComp -> Bool
False
  DoExpr Maybe ModuleName
m -> Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModuleName
m
  MDoExpr Maybe ModuleName
m -> Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModuleName
m
  HsDoFlavour
MonadComp -> Bool
True
  HsDoFlavour
GhciStmtCtxt -> Bool
True   -- I suppose?

{-
Note [Renaming parallel Stmts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Renaming parallel statements is painful.  Given, say
     [ a+c | a <- as, bs <- bss
           | c <- bs, a <- ds ]
Note that
  (a) In order to report "Defined but not used" about 'bs', we must
      rename each group of Stmts with a thing_inside whose FreeVars
      include at least {a,c}

  (b) We want to report that 'a' is illegally bound in both branches

  (c) The 'bs' in the second group must obviously not be captured by
      the binding in the first group

To satisfy (a) we nest the segments.
To satisfy (b) we check for duplicates just before thing_inside.
To satisfy (c) we reset the LocalRdrEnv each time.

************************************************************************
*                                                                      *
\subsubsection{mdo expressions}
*                                                                      *
************************************************************************
-}

type FwdRefs = NameSet
type Segment stmts = (Defs,
                      Uses,     -- May include defs
                      FwdRefs,  -- A subset of uses that are
                                --   (a) used before they are bound in this segment, or
                                --   (b) used here, and bound in subsequent segments
                      stmts)    -- Either Stmt or [Stmt]


-- wrapper that does both the left- and right-hand sides
rnRecStmtsAndThen :: AnnoBody body
                  => HsStmtContext GhcRn
                  -> (body GhcPs -> RnM (body GhcRn, FreeVars))
                  -> [LStmt GhcPs (LocatedA (body GhcPs))]
                         -- assumes that the FreeVars returned includes
                         -- the FreeVars of the Segments
                  -> ([Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
                      -> RnM (a, FreeVars))
                  -> RnM (a, FreeVars)
rnRecStmtsAndThen :: forall (body :: * -> *) a.
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> ([Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
    -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnRecStmtsAndThen HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [LStmt GhcPs (LocatedA (body GhcPs))]
s [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
-> RnM (a, FreeVars)
cont
  = do  { -- (A) Make the mini fixity env for all of the stmts
          MiniFixityEnv
fix_env <- [LFixitySig GhcPs] -> RnM MiniFixityEnv
makeMiniFixityEnv ([LStmt GhcPs (LocatedA (body GhcPs))] -> [LFixitySig GhcPs]
forall body. [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs]
collectRecStmtsFixities [LStmt GhcPs (LocatedA (body GhcPs))]
s)

          -- (B) Do the LHSes
        ; [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
new_lhs_and_fv <- MiniFixityEnv
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
forall (body :: * -> *).
AnnoBody body =>
MiniFixityEnv
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
rn_rec_stmts_lhs MiniFixityEnv
fix_env [LStmt GhcPs (LocatedA (body GhcPs))]
s

          --    ...bring them and their fixities into scope
        ; let bound_names :: [IdP GhcRn]
bound_names = CollectFlag GhcRn
-> [LStmtLR GhcRn GhcPs (LocatedA (body GhcPs))] -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders (((GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)
 -> GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))))
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
     FreeVars)]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))
forall a b. (a, b) -> a
fst [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
new_lhs_and_fv)
              -- Fake uses of variables introduced implicitly (warning suppression, see #4404)
              rec_uses :: [(SrcSpan, [Name])]
rec_uses = [LStmtLR GhcRn GhcPs (LocatedA (body GhcPs))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
lStmtsImplicits (((GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)
 -> GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))))
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
     FreeVars)]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))
forall a b. (a, b) -> a
fst [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
new_lhs_and_fv)
              implicit_uses :: FreeVars
implicit_uses = [Name] -> FreeVars
mkNameSet ([Name] -> FreeVars) -> [Name] -> FreeVars
forall a b. (a -> b) -> a -> b
$ ((SrcSpan, [Name]) -> [Name]) -> [(SrcSpan, [Name])] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SrcSpan, [Name]) -> [Name]
forall a b. (a, b) -> b
snd ([(SrcSpan, [Name])] -> [Name]) -> [(SrcSpan, [Name])] -> [Name]
forall a b. (a -> b) -> a -> b
$ [(SrcSpan, [Name])]
rec_uses
        ; [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [IdP GhcRn]
[Name]
bound_names (RnM (a, FreeVars) -> RnM (a, FreeVars))
-> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$
          MiniFixityEnv -> [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities MiniFixityEnv
fix_env [IdP GhcRn]
[Name]
bound_names (RnM (a, FreeVars) -> RnM (a, FreeVars))
-> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ do

          -- (C) do the right-hand-sides and thing-inside
        { [Segment
   (GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
segs <- HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [Name]
-> [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
-> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [Name]
-> [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
-> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
rn_rec_stmts HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [IdP GhcRn]
[Name]
bound_names [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
[(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
new_lhs_and_fv
        ; (a
res, FreeVars
fvs) <- [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
-> RnM (a, FreeVars)
cont [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
[Segment
   (GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
segs
        ; ((SrcSpan, [Name]) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [(SrcSpan, [Name])] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(SrcSpan
loc, [Name]
ns) -> SrcSpan
-> FreeVars -> Maybe [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkUnusedRecordWildcard SrcSpan
loc FreeVars
fvs ([Name] -> Maybe [Name]
forall a. a -> Maybe a
Just [Name]
ns))
                [(SrcSpan, [Name])]
rec_uses
        ; [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedLocalBinds [IdP GhcRn]
[Name]
bound_names (FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`unionNameSet` FreeVars
implicit_uses)
        ; (a, FreeVars) -> RnM (a, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, FreeVars
fvs) }}

-- get all the fixity decls in any Let stmt
collectRecStmtsFixities :: [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs]
collectRecStmtsFixities :: forall body. [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs]
collectRecStmtsFixities [LStmtLR GhcPs GhcPs body]
l =
    (GenLocated
   (Anno (StmtLR GhcPs GhcPs body)) (StmtLR GhcPs GhcPs body)
 -> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
 -> [GenLocated SrcSpanAnnA (FixitySig GhcPs)])
-> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
-> [GenLocated
      (Anno (StmtLR GhcPs GhcPs body)) (StmtLR GhcPs GhcPs body)]
-> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ GenLocated
  (Anno (StmtLR GhcPs GhcPs body)) (StmtLR GhcPs GhcPs body)
s -> \[GenLocated SrcSpanAnnA (FixitySig GhcPs)]
acc -> case GenLocated
  (Anno (StmtLR GhcPs GhcPs body)) (StmtLR GhcPs GhcPs body)
s of
            (L Anno (StmtLR GhcPs GhcPs body)
_ (LetStmt XLetStmt GhcPs GhcPs body
_ (HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
_ [LSig GhcPs]
sigs)))) ->
              (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
 -> [GenLocated SrcSpanAnnA (FixitySig GhcPs)])
-> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ GenLocated SrcSpanAnnA (Sig GhcPs)
sig -> \ [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
acc -> case GenLocated SrcSpanAnnA (Sig GhcPs)
sig of
                                         (L SrcSpanAnnA
loc (FixSig XFixSig GhcPs
_ FixitySig GhcPs
s)) -> (SrcSpanAnnA
-> FixitySig GhcPs -> GenLocated SrcSpanAnnA (FixitySig GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc FixitySig GhcPs
s) GenLocated SrcSpanAnnA (FixitySig GhcPs)
-> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
-> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
acc
                                         GenLocated SrcSpanAnnA (Sig GhcPs)
_ -> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
acc) [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
acc [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs
            GenLocated
  (Anno (StmtLR GhcPs GhcPs body)) (StmtLR GhcPs GhcPs body)
_ -> [GenLocated SrcSpanAnnA (FixitySig GhcPs)]
acc) [] [LStmtLR GhcPs GhcPs body]
[GenLocated
   (Anno (StmtLR GhcPs GhcPs body)) (StmtLR GhcPs GhcPs body)]
l

-- left-hand sides

rn_rec_stmt_lhs :: AnnoBody body => MiniFixityEnv
                -> LStmt GhcPs (LocatedA (body GhcPs))
                   -- rename LHS, and return its FVs
                   -- Warning: we will only need the FreeVars below in the case of a BindStmt,
                   -- so we don't bother to compute it accurately in the other cases
                -> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]

rn_rec_stmt_lhs :: forall (body :: * -> *).
AnnoBody body =>
MiniFixityEnv
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpanAnnA
loc (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LocatedA (body GhcPs)
body SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b))
  = [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpanAnnA
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XBodyStmt GhcRn GhcPs (LocatedA (body GhcPs))
-> LocatedA (body GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcRn GhcPs (LocatedA (body GhcPs))
NoExtField
noExtField LocatedA (body GhcPs)
body SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b), FreeVars
emptyFVs)]

rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpanAnnA
loc (LastStmt XLastStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LocatedA (body GhcPs)
body Maybe Bool
noret SyntaxExpr GhcPs
a))
  = [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpanAnnA
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XLastStmt GhcRn GhcPs (LocatedA (body GhcPs))
-> LocatedA (body GhcPs)
-> Maybe Bool
-> SyntaxExpr GhcPs
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcRn GhcPs (LocatedA (body GhcPs))
NoExtField
noExtField LocatedA (body GhcPs)
body Maybe Bool
noret SyntaxExpr GhcPs
a), FreeVars
emptyFVs)]

rn_rec_stmt_lhs MiniFixityEnv
fix_env (L SrcSpanAnnA
loc (BindStmt XBindStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LPat GhcPs
pat LocatedA (body GhcPs)
body))
  = do
      -- should the ctxt be MDo instead?
      (GenLocated SrcSpanAnnA (Pat GhcRn)
pat', FreeVars
fv_pat) <- NameMaker -> LPat GhcPs -> RnM (LPat GhcRn, FreeVars)
rnBindPat (MiniFixityEnv -> NameMaker
localRecNameMaker MiniFixityEnv
fix_env) LPat GhcPs
pat
      [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpanAnnA
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XBindStmt GhcRn GhcPs (LocatedA (body GhcPs))
-> LPat GhcRn
-> LocatedA (body GhcPs)
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt GhcRn GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
pat' LocatedA (body GhcPs)
body), FreeVars
fv_pat)]

rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpanAnnA
_ (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ binds :: HsLocalBinds GhcPs
binds@(HsIPBinds {})))
  = TcRnMessage
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. TcRnMessage -> TcRn a
failWith (Either (HsLocalBinds GhcPs) (HsLocalBindsLR GhcRn GhcPs)
-> TcRnMessage
badIpBinds (HsLocalBinds GhcPs
-> Either (HsLocalBinds GhcPs) (HsLocalBindsLR GhcRn GhcPs)
forall a b. a -> Either a b
Left HsLocalBinds GhcPs
binds))


rn_rec_stmt_lhs MiniFixityEnv
fix_env (L SrcSpanAnnA
loc (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ (HsValBinds XHsValBinds GhcPs GhcPs
x HsValBindsLR GhcPs GhcPs
binds)))
    = do ([Name]
_bound_names, HsValBindsLR GhcRn GhcPs
binds') <- MiniFixityEnv
-> HsValBindsLR GhcPs GhcPs
-> RnM ([Name], HsValBindsLR GhcRn GhcPs)
rnLocalValBindsLHS MiniFixityEnv
fix_env HsValBindsLR GhcPs GhcPs
binds
         [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpanAnnA
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XLetStmt GhcRn GhcPs (LocatedA (body GhcPs))
-> HsLocalBindsLR GhcRn GhcPs
-> StmtLR GhcRn GhcPs (LocatedA (body GhcPs))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcRn GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (XHsValBinds GhcRn GhcPs
-> HsValBindsLR GhcRn GhcPs -> HsLocalBindsLR GhcRn GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
XHsValBinds GhcRn GhcPs
x HsValBindsLR GhcRn GhcPs
binds')),
                 -- Warning: this is bogus; see function invariant
                 FreeVars
emptyFVs
                 )]

-- XXX Do we need to do something with the return and mfix names?
rn_rec_stmt_lhs MiniFixityEnv
fix_env (L SrcSpanAnnA
_ (RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
stmts }))  -- Flatten Rec inside Rec
    = MiniFixityEnv
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(XRec GhcRn (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall (body :: * -> *).
AnnoBody body =>
MiniFixityEnv
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
rn_rec_stmts_lhs MiniFixityEnv
fix_env [LStmt GhcPs (LocatedA (body GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
stmts

rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs (LocatedA (body GhcPs))
stmt@(L SrcSpanAnnA
_ (ParStmt {}))       -- Syntactically illegal in mdo
  = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rn_rec_stmt" (GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
stmt)

rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs (LocatedA (body GhcPs))
stmt@(L SrcSpanAnnA
_ (TransStmt {}))     -- Syntactically illegal in mdo
  = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rn_rec_stmt" (GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
stmt)

rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs (LocatedA (body GhcPs))
stmt@(L SrcSpanAnnA
_ (ApplicativeStmt {})) -- Shouldn't appear yet
  = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rn_rec_stmt" (GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
stmt)

rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpanAnnA
_ (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_)))
  = String
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. HasCallStack => String -> a
panic String
"rn_rec_stmt LetStmt EmptyLocalBinds"

rn_rec_stmts_lhs :: AnnoBody body => MiniFixityEnv
                 -> [LStmt GhcPs (LocatedA (body GhcPs))]
                 -> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
rn_rec_stmts_lhs :: forall (body :: * -> *).
AnnoBody body =>
MiniFixityEnv
-> [LStmt GhcPs (LocatedA (body GhcPs))]
-> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
rn_rec_stmts_lhs MiniFixityEnv
fix_env [LStmt GhcPs (LocatedA (body GhcPs))]
stmts
  = do { [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
ls <- (GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      [(GenLocated
          SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
        FreeVars)])
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM (MiniFixityEnv
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
forall (body :: * -> *).
AnnoBody body =>
MiniFixityEnv
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
rn_rec_stmt_lhs MiniFixityEnv
fix_env) [LStmt GhcPs (LocatedA (body GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
stmts
       ; let boundNames :: [IdP GhcRn]
boundNames = CollectFlag GhcRn
-> [LStmtLR GhcRn GhcPs (LocatedA (body GhcPs))] -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders (((GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)
 -> GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))))
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
     FreeVars)]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs)))
forall a b. (a, b) -> a
fst [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
ls)
            -- First do error checking: we need to check for dups here because we
            -- don't bind all of the variables from the Stmt at once
            -- with bindLocatedLocals.
       ; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupNames [IdP GhcRn]
[Name]
boundNames
       ; [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
       FreeVars)]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
ls }


-- right-hand-sides

rn_rec_stmt :: AnnoBody body =>
               HsStmtContext GhcRn
            -> (body GhcPs -> RnM (body GhcRn, FreeVars))
            -> [Name]
            -> (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
            -> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
        -- Rename a Stmt that is inside a RecStmt (or mdo)
        -- Assumes all binders are already in scope
        -- Turns each stmt into a singleton Stmt
rn_rec_stmt :: forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [Name]
-> (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
rn_rec_stmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [Name]
_ (L SrcSpanAnnA
loc (LastStmt XLastStmt GhcRn GhcPs (LocatedA (body GhcPs))
_ (L SrcSpanAnnA
lb body GhcPs
body) Maybe Bool
noret SyntaxExpr GhcPs
_), FreeVars
_)
  = do  { (body GhcRn
body', FreeVars
fv_expr) <- body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody body GhcPs
body
        ; (SyntaxExprRn
ret_op, FreeVars
fvs1)   <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext GhcRn
ctxt Name
returnMName
        ; [(FreeVars, FreeVars, FreeVars,
  GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FreeVars
emptyNameSet, FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1, FreeVars
emptyNameSet,
                   SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XLastStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> LocatedA (body GhcRn)
-> Maybe Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcRn GhcRn (LocatedA (body GhcRn))
NoExtField
noExtField (SrcSpanAnnA -> body GhcRn -> LocatedA (body GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lb body GhcRn
body') Maybe Bool
noret SyntaxExpr GhcRn
SyntaxExprRn
ret_op))] }

rn_rec_stmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [Name]
_ (L SrcSpanAnnA
loc (BodyStmt XBodyStmt GhcRn GhcPs (LocatedA (body GhcPs))
_ (L SrcSpanAnnA
lb body GhcPs
body) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_), FreeVars
_)
  = do { (body GhcRn
body', FreeVars
fvs) <- body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody body GhcPs
body
       ; (SyntaxExprRn
then_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext GhcRn
ctxt Name
thenMName
       ; [(FreeVars, FreeVars, FreeVars,
  GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FreeVars
emptyNameSet, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1, FreeVars
emptyNameSet,
                 SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XBodyStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> LocatedA (body GhcRn)
-> SyntaxExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcRn GhcRn (LocatedA (body GhcRn))
NoExtField
noExtField (SrcSpanAnnA -> body GhcRn -> LocatedA (body GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lb body GhcRn
body') SyntaxExpr GhcRn
SyntaxExprRn
then_op SyntaxExpr GhcRn
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr))] }

rn_rec_stmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [Name]
_ (L SrcSpanAnnA
loc (BindStmt XBindStmt GhcRn GhcPs (LocatedA (body GhcPs))
_ LPat GhcRn
pat' (L SrcSpanAnnA
lb body GhcPs
body)), FreeVars
fv_pat)
  = do { (body GhcRn
body', FreeVars
fv_expr) <- body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody body GhcPs
body
       ; (SyntaxExprRn
bind_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext GhcRn
ctxt Name
bindMName

       ; (Maybe SyntaxExprRn
fail_op, FreeVars
fvs2) <- HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
forall p.
HsStmtContext p -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
getMonadFailOp HsStmtContext GhcRn
ctxt

       ; let bndrs :: FreeVars
bndrs = [Name] -> FreeVars
mkNameSet (CollectFlag GhcRn -> LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders LPat GhcRn
pat')
             fvs :: FreeVars
fvs   = FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_pat FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2
       ; let xbsrn :: XBindStmtRn
xbsrn = XBindStmtRn { xbsrn_bindOp :: SyntaxExpr GhcRn
xbsrn_bindOp = SyntaxExpr GhcRn
SyntaxExprRn
bind_op, xbsrn_failOp :: Maybe (SyntaxExpr GhcRn)
xbsrn_failOp = Maybe (SyntaxExpr GhcRn)
Maybe SyntaxExprRn
fail_op }
       ; [(FreeVars, FreeVars, FreeVars,
  GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FreeVars
bndrs, FreeVars
fvs, FreeVars
bndrs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
fvs,
                  SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XBindStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> LPat GhcRn
-> LocatedA (body GhcRn)
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt GhcRn GhcRn (LocatedA (body GhcRn))
XBindStmtRn
xbsrn LPat GhcRn
pat' (SrcSpanAnnA -> body GhcRn -> LocatedA (body GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lb body GhcRn
body')))] }

rn_rec_stmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ [Name]
_ (L SrcSpanAnnA
_ (LetStmt XLetStmt GhcRn GhcPs (LocatedA (body GhcPs))
_ binds :: HsLocalBindsLR GhcRn GhcPs
binds@(HsIPBinds {})), FreeVars
_)
  = TcRnMessage
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. TcRnMessage -> TcRn a
failWith (Either (HsLocalBinds GhcPs) (HsLocalBindsLR GhcRn GhcPs)
-> TcRnMessage
badIpBinds (HsLocalBindsLR GhcRn GhcPs
-> Either (HsLocalBinds GhcPs) (HsLocalBindsLR GhcRn GhcPs)
forall a b. b -> Either a b
Right HsLocalBindsLR GhcRn GhcPs
binds))

rn_rec_stmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ [Name]
all_bndrs (L SrcSpanAnnA
loc (LetStmt XLetStmt GhcRn GhcPs (LocatedA (body GhcPs))
_ (HsValBinds XHsValBinds GhcRn GhcPs
x HsValBindsLR GhcRn GhcPs
binds')), FreeVars
_)
  = do { (HsValBinds GhcRn
binds', DefUses
du_binds) <- FreeVars
-> HsValBindsLR GhcRn GhcPs -> RnM (HsValBinds GhcRn, DefUses)
rnLocalValBindsRHS ([Name] -> FreeVars
mkNameSet [Name]
all_bndrs) HsValBindsLR GhcRn GhcPs
binds'
           -- fixities and unused are handled above in rnRecStmtsAndThen
       ; let fvs :: FreeVars
fvs = DefUses -> FreeVars
allUses DefUses
du_binds
       ; [(FreeVars, FreeVars, FreeVars,
  GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(DefUses -> FreeVars
duDefs DefUses
du_binds, FreeVars
fvs, FreeVars
emptyNameSet,
                 SrcSpanAnnA
-> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XLetStmt GhcRn GhcRn (LocatedA (body GhcRn))
-> HsLocalBinds GhcRn -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcRn GhcRn (LocatedA (body GhcRn))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (XHsValBinds GhcRn GhcRn -> HsValBinds GhcRn -> HsLocalBinds GhcRn
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcRn GhcPs
XHsValBinds GhcRn GhcRn
x HsValBinds GhcRn
binds')))] }

-- no RecStmt case because they get flattened above when doing the LHSes
rn_rec_stmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
stmt@(L SrcSpanAnnA
_ (RecStmt {}), FreeVars
_)
  = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rn_rec_stmt: RecStmt" ((GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
-> SDoc
forall a. Outputable a => a -> SDoc
ppr (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
(GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
stmt)

rn_rec_stmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
stmt@(L SrcSpanAnnA
_ (ParStmt {}), FreeVars
_)       -- Syntactically illegal in mdo
  = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rn_rec_stmt: ParStmt" ((GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
-> SDoc
forall a. Outputable a => a -> SDoc
ppr (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
(GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
stmt)

rn_rec_stmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
stmt@(L SrcSpanAnnA
_ (TransStmt {}), FreeVars
_)     -- Syntactically illegal in mdo
  = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rn_rec_stmt: TransStmt" ((GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
-> SDoc
forall a. Outputable a => a -> SDoc
ppr (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
(GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
stmt)

rn_rec_stmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ [Name]
_ (L SrcSpanAnnA
_ (LetStmt XLetStmt GhcRn GhcPs (LocatedA (body GhcPs))
_ (EmptyLocalBinds XEmptyLocalBinds GhcRn GhcPs
_)), FreeVars
_)
  = String
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. HasCallStack => String -> a
panic String
"rn_rec_stmt: LetStmt EmptyLocalBinds"

rn_rec_stmt HsStmtContext GhcRn
_ body GhcPs -> RnM (body GhcRn, FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
stmt@(L SrcSpanAnnA
_ (ApplicativeStmt {}), FreeVars
_)
  = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(FreeVars, FreeVars, FreeVars,
       GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rn_rec_stmt: ApplicativeStmt" ((GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
-> SDoc
forall a. Outputable a => a -> SDoc
ppr (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
(GenLocated
   SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
 FreeVars)
stmt)

rn_rec_stmts :: AnnoBody body
             => HsStmtContext GhcRn
             -> (body GhcPs -> RnM (body GhcRn, FreeVars))
             -> [Name]
             -> [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
             -> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
rn_rec_stmts :: forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [Name]
-> [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
-> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
rn_rec_stmts HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [Name]
bndrs [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
stmts
  = do { [[Segment
    (GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]]
segs_s <- ((GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      [Segment
         (GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))])
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
     FreeVars)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [[Segment
         (GenLocated
            SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]]
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 (HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [Name]
-> (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> (body GhcPs -> RnM (body GhcRn, FreeVars))
-> [Name]
-> (LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
rn_rec_stmt HsStmtContext GhcRn
ctxt body GhcPs -> RnM (body GhcRn, FreeVars)
rnBody [Name]
bndrs) [(LStmtLR GhcRn GhcPs (LocatedA (body GhcPs)), FreeVars)]
[(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcPs (LocatedA (body GhcPs))),
  FreeVars)]
stmts
       ; [Segment
   (GenLocated
      SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [Segment
        (GenLocated
           SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment
    (GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]]
-> [Segment
      (GenLocated
         SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment
    (GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))))]]
segs_s) }

---------------------------------------------
segmentRecStmts :: SrcSpan -> HsStmtContext GhcRn
                -> Stmt GhcRn (LocatedA (body GhcRn))
                -> [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
                -> (FreeVars, Bool)
                    -- ^ The free variables used in later statements.
                    -- If the boolean is 'True', this might be an underestimate
                    -- because we are in GHCi, and might thus be missing some "used later"
                    -- FVs. See Note [What is "used later" in a rec stmt]
                -> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)

segmentRecStmts :: forall (body :: * -> *).
SrcSpan
-> HsStmtContext GhcRn
-> Stmt GhcRn (LocatedA (body GhcRn))
-> [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
-> (FreeVars, Bool)
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
segmentRecStmts SrcSpan
loc HsStmtContext GhcRn
ctxt Stmt GhcRn (LocatedA (body GhcRn))
empty_rec_stmt [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
segs (FreeVars
fvs_later, Bool
might_be_more_fvs_later)
  | [Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
[Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
segs
  = ([], FreeVars
final_fv_uses)

  | HsDoStmt (MDoExpr Maybe ModuleName
_) <- HsStmtContext GhcRn
ctxt
  = Stmt GhcRn (LocatedA (body GhcRn))
-> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
-> FreeVars
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
forall (body :: * -> *).
Stmt GhcRn (LocatedA (body GhcRn))
-> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
-> FreeVars
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
segsToStmts Stmt GhcRn (LocatedA (body GhcRn))
empty_rec_stmt [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
grouped_segs FreeVars
fvs_later
               -- Step 4: Turn the segments into Stmts
                --         Use RecStmt when and only when there are fwd refs
                --         Also gather up the uses from the end towards the
                --         start, so we can tell the RecStmt which things are
                --         used 'after' the RecStmt

  | Bool
otherwise
  = ([ SrcSpanAnnA
-> Stmt GhcRn (LocatedA (body GhcRn))
-> GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (Stmt GhcRn (LocatedA (body GhcRn))
 -> GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))
-> Stmt GhcRn (LocatedA (body GhcRn))
-> GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
forall a b. (a -> b) -> a -> b
$
       Stmt GhcRn (LocatedA (body GhcRn))
empty_rec_stmt { recS_stmts = noLocA ss
                      , recS_later_ids = nameSetElemsStable final_fvs_later
                      , recS_rec_ids   = nameSetElemsStable
                                           (defs `intersectNameSet` uses) }]
          -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]
    , FreeVars
uses FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
final_fv_uses)

  where
    (FreeVars
final_fv_uses, FreeVars
final_fvs_later)
      | Bool
might_be_more_fvs_later
      = (FreeVars
defs, FreeVars
defs)
        -- If there might be more uses later (e.g. we are in GHCi and have not
        -- yet seen the whole rec statement), conservatively assume that everything
        -- will be used later (as is possible).
      | Bool
otherwise
      = ( FreeVars
uses FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_later
        , FreeVars
defs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
fvs_later )

    ([FreeVars]
defs_s, [FreeVars]
uses_s, [FreeVars]
_, [GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
ss) = [Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
-> ([FreeVars], [FreeVars], [FreeVars],
    [GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
[Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
segs
    defs :: FreeVars
defs = [FreeVars] -> FreeVars
plusFVs [FreeVars]
defs_s
    uses :: FreeVars
uses = [FreeVars] -> FreeVars
plusFVs [FreeVars]
uses_s

                -- Step 2: Fill in the fwd refs.
                --         The segments are all singletons, but their fwd-ref
                --         field mentions all the things used by the segment
                --         that are bound after their use
    segs_w_fwd_refs :: [Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
segs_w_fwd_refs = [Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
-> [Segment
      (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
forall a. [Segment a] -> [Segment a]
addFwdRefs [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
[Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
segs

                -- Step 3: Group together the segments to make bigger segments
                --         Invariant: in the result, no segment uses a variable
                --                    bound in a later segment
    grouped_segs :: [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
grouped_segs = HsStmtContext GhcRn
-> [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
-> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
forall body.
HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext GhcRn
ctxt [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]
[Segment
   (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn))))]
segs_w_fwd_refs

----------------------------
addFwdRefs :: [Segment a] -> [Segment a]
-- So far the segments only have forward refs *within* the Stmt
--      (which happens for bind:  x <- ...x...)
-- This function adds the cross-seg fwd ref info

addFwdRefs :: forall a. [Segment a] -> [Segment a]
addFwdRefs [Segment a]
segs
  = ([Segment a], FreeVars) -> [Segment a]
forall a b. (a, b) -> a
fst ((Segment a -> ([Segment a], FreeVars) -> ([Segment a], FreeVars))
-> ([Segment a], FreeVars)
-> [Segment a]
-> ([Segment a], FreeVars)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Segment a -> ([Segment a], FreeVars) -> ([Segment a], FreeVars)
forall {d}.
(FreeVars, FreeVars, FreeVars, d)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
mk_seg ([], FreeVars
emptyNameSet) [Segment a]
segs)
  where
    mk_seg :: (FreeVars, FreeVars, FreeVars, d)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
mk_seg (FreeVars
defs, FreeVars
uses, FreeVars
fwds, d
stmts) ([(FreeVars, FreeVars, FreeVars, d)]
segs, FreeVars
later_defs)
        = ((FreeVars, FreeVars, FreeVars, d)
new_seg (FreeVars, FreeVars, FreeVars, d)
-> [(FreeVars, FreeVars, FreeVars, d)]
-> [(FreeVars, FreeVars, FreeVars, d)]
forall a. a -> [a] -> [a]
: [(FreeVars, FreeVars, FreeVars, d)]
segs, FreeVars
all_defs)
        where
          new_seg :: (FreeVars, FreeVars, FreeVars, d)
new_seg = (FreeVars
defs, FreeVars
uses, FreeVars
new_fwds, d
stmts)
          all_defs :: FreeVars
all_defs = FreeVars
later_defs FreeVars -> FreeVars -> FreeVars
`unionNameSet` FreeVars
defs
          new_fwds :: FreeVars
new_fwds = FreeVars
fwds FreeVars -> FreeVars -> FreeVars
`unionNameSet` (FreeVars
uses FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
later_defs)
                -- Add the downstream fwd refs here

{-
Note [Segmenting mdo]
~~~~~~~~~~~~~~~~~~~~~
NB. June 7 2012: We only glom segments that appear in an explicit mdo;
and leave those found in "do rec"'s intact.  See
https://gitlab.haskell.org/ghc/ghc/issues/4148 for the discussion
leading to this design choice.  Hence the test in segmentRecStmts.

Note [Glomming segments]
~~~~~~~~~~~~~~~~~~~~~~~~
Glomming the singleton segments of an mdo into minimal recursive groups.

At first I thought this was just strongly connected components, but
there's an important constraint: the order of the stmts must not change.

Consider
     mdo { x <- ...y...
           p <- z
           y <- ...x...
           q <- x
           z <- y
           r <- x }

Here, the first stmt mention 'y', which is bound in the third.
But that means that the innocent second stmt (p <- z) gets caught
up in the recursion.  And that in turn means that the binding for
'z' has to be included... and so on.

Start at the tail { r <- x }
Now add the next one { z <- y ; r <- x }
Now add one more     { q <- x ; z <- y ; r <- x }
Now one more... but this time we have to group a bunch into rec
     { rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
Now one more, which we can add on without a rec
     { p <- z ;
       rec { y <- ...x... ; q <- x ; z <- y } ;
       r <- x }
Finally we add the last one; since it mentions y we have to
glom it together with the first two groups
     { rec { x <- ...y...; p <- z ; y <- ...x... ;
             q <- x ; z <- y } ;
       r <- x }

Note [What is "used later" in a rec stmt]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We desugar a recursive Stmt to something like

  (a,_,c) <- mfix (\(a,b,_) -> do { ... ; return (a,b,c) })
  ...stuff after the rec...

The knot-tied tuple must contain
* All the variables that are used before they are bound in the `rec` block
* All the variables that are used after the entire `rec` block

In the case of GHCi, however, we don't know what variables will be used
after the `rec` (#20206).  For example, we might have
    ghci>  rec { x <- e1; y <- e2 }
    ghci>  print x
    ghci>  print y

So we have to assume that *all* the variables bound in the `rec` are used
afterwards.  We pass a Boolean to segmentRecStmts to signal such a situation,
in which case that function conservatively assumes that everything might well
be used later.
-}

glomSegments :: HsStmtContext GhcRn
             -> [Segment (LStmt GhcRn body)]
             -> [Segment [LStmt GhcRn body]]
                                  -- Each segment has a non-empty list of Stmts
-- See Note [Glomming segments]

glomSegments :: forall body.
HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext GhcRn
_ [] = []
glomSegments HsStmtContext GhcRn
ctxt ((FreeVars
defs,FreeVars
uses,FreeVars
fwds,LStmt GhcRn body
stmt) : [Segment (LStmt GhcRn body)]
segs)
        -- Actually stmts will always be a singleton
  = (FreeVars
seg_defs, FreeVars
seg_uses, FreeVars
seg_fwds, [GenLocated
   (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]
seg_stmts)  Segment
  [GenLocated
     (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]
-> [Segment
      [GenLocated
         (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
-> [Segment
      [GenLocated
         (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
forall a. a -> [a] -> [a]
: [Segment
   [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
others
  where
    segs' :: [(FreeVars, FreeVars, FreeVars, [LStmt GhcRn body])]
segs'            = HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)]
-> [(FreeVars, FreeVars, FreeVars, [LStmt GhcRn body])]
forall body.
HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext GhcRn
ctxt [Segment (LStmt GhcRn body)]
segs
    ([Segment
   [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
extras, [Segment
   [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
others) = FreeVars
-> [Segment
      [GenLocated
         (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
-> ([Segment
       [GenLocated
          (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]],
    [Segment
       [GenLocated
          (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]])
forall a. FreeVars -> [Segment a] -> ([Segment a], [Segment a])
grab FreeVars
uses [(FreeVars, FreeVars, FreeVars, [LStmt GhcRn body])]
[Segment
   [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
segs'
    ([FreeVars]
ds, [FreeVars]
us, [FreeVars]
fs, [[GenLocated
    (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
ss) = [Segment
   [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
-> ([FreeVars], [FreeVars], [FreeVars],
    [[GenLocated
        (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [Segment
   [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
extras

    seg_defs :: FreeVars
seg_defs  = [FreeVars] -> FreeVars
plusFVs [FreeVars]
ds FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
defs
    seg_uses :: FreeVars
seg_uses  = [FreeVars] -> FreeVars
plusFVs [FreeVars]
us FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
uses
    seg_fwds :: FreeVars
seg_fwds  = [FreeVars] -> FreeVars
plusFVs [FreeVars]
fs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fwds
    seg_stmts :: [GenLocated
   (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]
seg_stmts = LStmt GhcRn body
GenLocated
  (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)
stmt GenLocated
  (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)
-> [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]
-> [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]
forall a. a -> [a] -> [a]
: [[GenLocated
    (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
-> [GenLocated
      (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenLocated
    (Anno (StmtLR GhcRn GhcRn body)) (StmtLR GhcRn GhcRn body)]]
ss

    grab :: NameSet             -- The client
         -> [Segment a]
         -> ([Segment a],       -- Needed by the 'client'
             [Segment a])       -- Not needed by the client
        -- The result is simply a split of the input
    grab :: forall a. FreeVars -> [Segment a] -> ([Segment a], [Segment a])
grab FreeVars
uses [Segment a]
dus
        = ([Segment a] -> [Segment a]
forall a. [a] -> [a]
reverse [Segment a]
yeses, [Segment a] -> [Segment a]
forall a. [a] -> [a]
reverse [Segment a]
noes)
        where
          ([Segment a]
noes, [Segment a]
yeses)           = (Segment a -> Bool) -> [Segment a] -> ([Segment a], [Segment a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Segment a -> Bool
not_needed ([Segment a] -> [Segment a]
forall a. [a] -> [a]
reverse [Segment a]
dus)
          not_needed :: Segment a -> Bool
not_needed (FreeVars
defs,FreeVars
_,FreeVars
_,a
_) = FreeVars -> FreeVars -> Bool
disjointNameSet FreeVars
defs FreeVars
uses

----------------------------------------------------
segsToStmts :: Stmt GhcRn (LocatedA (body GhcRn))
                                  -- A RecStmt with the SyntaxOps filled in
            -> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
                                  -- Each Segment has a non-empty list of Stmts
            -> FreeVars           -- Free vars used 'later'
            -> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)

segsToStmts :: forall (body :: * -> *).
Stmt GhcRn (LocatedA (body GhcRn))
-> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
-> FreeVars
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
segsToStmts Stmt GhcRn (LocatedA (body GhcRn))
_ [] FreeVars
fvs_later = ([], FreeVars
fvs_later)
segsToStmts Stmt GhcRn (LocatedA (body GhcRn))
empty_rec_stmt ((FreeVars
defs, FreeVars
uses, FreeVars
fwds, [LStmt GhcRn (LocatedA (body GhcRn))]
ss) : [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
segs) FreeVars
fvs_later
  = Bool
-> ([GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))],
    FreeVars)
-> ([GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))],
    FreeVars)
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not ([GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LStmt GhcRn (LocatedA (body GhcRn))]
[GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
ss))
    (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
new_stmt GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
-> [GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
-> [GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
forall a. a -> [a] -> [a]
: [LStmt GhcRn (LocatedA (body GhcRn))]
[GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
later_stmts, FreeVars
later_uses FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
uses)
  where
    ([LStmt GhcRn (LocatedA (body GhcRn))]
later_stmts, FreeVars
later_uses) = Stmt GhcRn (LocatedA (body GhcRn))
-> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
-> FreeVars
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
forall (body :: * -> *).
Stmt GhcRn (LocatedA (body GhcRn))
-> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
-> FreeVars
-> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars)
segsToStmts Stmt GhcRn (LocatedA (body GhcRn))
empty_rec_stmt [Segment [LStmt GhcRn (LocatedA (body GhcRn))]]
segs FreeVars
fvs_later
    new_stmt :: GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
new_stmt | Bool
non_rec   = [GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
-> GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
forall a. HasCallStack => [a] -> a
head [LStmt GhcRn (LocatedA (body GhcRn))]
[GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
ss
             | Bool
otherwise = SrcSpanAnnA
-> Stmt GhcRn (LocatedA (body GhcRn))
-> GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
-> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc ([GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
-> GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))
forall a. HasCallStack => [a] -> a
head [LStmt GhcRn (LocatedA (body GhcRn))]
[GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
ss)) Stmt GhcRn (LocatedA (body GhcRn))
rec_stmt
    rec_stmt :: Stmt GhcRn (LocatedA (body GhcRn))
rec_stmt = Stmt GhcRn (LocatedA (body GhcRn))
empty_rec_stmt { recS_stmts     = noLocA ss
                              , recS_later_ids = nameSetElemsStable used_later
                              , recS_rec_ids   = nameSetElemsStable fwds }
          -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]
    non_rec :: Bool
non_rec    = [GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
-> Bool
forall a. [a] -> Bool
isSingleton [LStmt GhcRn (LocatedA (body GhcRn))]
[GenLocated SrcSpanAnnA (Stmt GhcRn (LocatedA (body GhcRn)))]
ss Bool -> Bool -> Bool
&& FreeVars -> Bool
isEmptyNameSet FreeVars
fwds
    used_later :: FreeVars
used_later = FreeVars
defs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
later_uses
                                -- The ones needed after the RecStmt

{-
************************************************************************
*                                                                      *
ApplicativeDo
*                                                                      *
************************************************************************

Note [ApplicativeDo]
~~~~~~~~~~~~~~~~~~~~
= Example =

For a sequence of statements

 do
     x <- A
     y <- B x
     z <- C
     return (f x y z)

We want to transform this to

  (\(x,y) z -> f x y z) <$> (do x <- A; y <- B x; return (x,y)) <*> C

It would be easy to notice that "y <- B x" and "z <- C" are
independent and do something like this:

 do
     x <- A
     (y,z) <- (,) <$> B x <*> C
     return (f x y z)

But this isn't enough! A and C were also independent, and this
transformation loses the ability to do A and C in parallel.

The algorithm works by first splitting the sequence of statements into
independent "segments", and a separate "tail" (the final statement). In
our example above, the segments would be

     [ x <- A
     , y <- B x ]

     [ z <- C ]

and the tail is:

     return (f x y z)

Then we take these segments and make an Applicative expression from them:

     (\(x,y) z -> return (f x y z))
       <$> do { x <- A; y <- B x; return (x,y) }
       <*> C

Finally, we recursively apply the transformation to each segment, to
discover any nested parallelism.

= Syntax & spec =

  expr ::= ... | do {stmt_1; ..; stmt_n} expr | ...

  stmt ::= pat <- expr
         | (arg_1 | ... | arg_n)  -- applicative composition, n>=1
         | ...                    -- other kinds of statement (e.g. let)

  arg ::= pat <- expr
        | {stmt_1; ..; stmt_n} {var_1..var_n}

(note that in the actual implementation,the expr in a do statement is
represented by a LastStmt as the final stmt, this is just a
representational issue and may change later.)

== Transformation to introduce applicative stmts ==

ado {} tail = tail
ado {pat <- expr} {return expr'} = (mkArg(pat <- expr)); return expr'
ado {one} tail = one : tail
ado stmts tail
  | n == 1 = ado before (ado after tail)
    where (before,after) = split(stmts_1)
  | n > 1  = (mkArg(stmts_1) | ... | mkArg(stmts_n)); tail
  where
    {stmts_1 .. stmts_n} = segments(stmts)

segments(stmts) =
  -- divide stmts into segments with no interdependencies

mkArg({pat <- expr}) = (pat <- expr)
mkArg({stmt_1; ...; stmt_n}) =
  {stmt_1; ...; stmt_n} {vars(stmt_1) u .. u vars(stmt_n)}

split({stmt_1; ..; stmt_n) =
  ({stmt_1; ..; stmt_i}, {stmt_i+1; ..; stmt_n})
  -- 1 <= i <= n
  -- i is a good place to insert a bind

== Desugaring for do ==

dsDo {} expr = expr

dsDo {pat <- rhs; stmts} expr =
   rhs >>= \pat -> dsDo stmts expr

dsDo {(arg_1 | ... | arg_n)} (return expr) =
  (\argpat (arg_1) .. argpat(arg_n) -> expr)
     <$> argexpr(arg_1)
     <*> ...
     <*> argexpr(arg_n)

dsDo {(arg_1 | ... | arg_n); stmts} expr =
  join (\argpat (arg_1) .. argpat(arg_n) -> dsDo stmts expr)
     <$> argexpr(arg_1)
     <*> ...
     <*> argexpr(arg_n)

== Special cases ==

If a do-expression contains only "return E" or "return $ E" plus
zero or more let-statements, we replace the "return" with "pure".
See Section 3.6 of the paper.

= Relevant modules in the rest of the compiler =

ApplicativeDo touches a few phases in the compiler:

* Renamer: The journey begins here in the renamer, where do-blocks are
  scheduled as outlined above and transformed into applicative
  combinators.  However, the code is still represented as a do-block
  with special forms of applicative statements. This allows us to
  recover the original do-block when e.g. printing type errors, where
  we don't want to show any of the applicative combinators since they
  don't exist in the source code.
  See ApplicativeStmt and ApplicativeArg in HsExpr.

* Typechecker: ApplicativeDo passes through the typechecker much like any
  other form of expression. The only crux is that the typechecker has to
  be aware of the special ApplicativeDo statements in the do-notation, and
  typecheck them appropriately.
  Relevant module: GHC.Tc.Gen.Match

* Desugarer: Any do-block which contains applicative statements is desugared
  as outlined above, to use the Applicative combinators.
  Relevant module: GHC.HsToCore.Expr

-}

-- | The 'Name's of @return@ and @pure@. These may not be 'returnName' and
-- 'pureName' due to @QualifiedDo@ or @RebindableSyntax@.
data MonadNames = MonadNames { MonadNames -> Name
return_name, MonadNames -> Name
pure_name :: Name }

instance Outputable MonadNames where
  ppr :: MonadNames -> SDoc
ppr (MonadNames {return_name :: MonadNames -> Name
return_name=Name
return_name,pure_name :: MonadNames -> Name
pure_name=Name
pure_name}) =
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat
    [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"MonadNames { return_name = "
    ,Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
return_name
    ,String -> SDoc
forall doc. IsLine doc => String -> doc
text String
", pure_name = "
    ,Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
pure_name
    ,String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"}"
    ]

-- | rearrange a list of statements using ApplicativeDoStmt.  See
-- Note [ApplicativeDo].
rearrangeForApplicativeDo
  :: HsDoFlavour
  -> [(ExprLStmt GhcRn, FreeVars)]
  -> RnM ([ExprLStmt GhcRn], FreeVars)

rearrangeForApplicativeDo :: HsDoFlavour
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
rearrangeForApplicativeDo HsDoFlavour
_ [] = ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
emptyNameSet)
-- If the do-block contains a single @return@ statement, change it to
-- @pure@ if ApplicativeDo is turned on. See Note [ApplicativeDo].
rearrangeForApplicativeDo HsDoFlavour
ctxt [(ExprLStmt GhcRn
one,FreeVars
_)] = do
  (Name
return_name, FreeVars
_) <- HsStmtContext Any -> Name -> RnM (Name, FreeVars)
forall p. HsStmtContext p -> Name -> RnM (Name, FreeVars)
lookupQualifiedDoName (HsDoFlavour -> HsStmtContext Any
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
returnMName
  (Name
pure_name, FreeVars
_)   <- HsStmtContext Any -> Name -> RnM (Name, FreeVars)
forall p. HsStmtContext p -> Name -> RnM (Name, FreeVars)
lookupQualifiedDoName (HsDoFlavour -> HsStmtContext Any
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
pureAName
  let pure_expr :: HsExpr GhcRn
pure_expr = IdP GhcRn -> HsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar IdP GhcRn
Name
pure_name
  let monad_names :: MonadNames
monad_names = MonadNames { return_name :: Name
return_name = Name
return_name
                               , pure_name :: Name
pure_name   = Name
pure_name }
  ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
  FreeVars)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      ([GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
       FreeVars))
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
    FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a b. (a -> b) -> a -> b
$ case MonadNames
-> [ExprLStmt GhcRn]
-> Maybe (HsExpr GhcRn)
-> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn
one] (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just HsExpr GhcRn
pure_expr) of
    (Bool
False, [ExprLStmt GhcRn]
one') -> ([ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
one', FreeVars
emptyNameSet)
    (Bool
True, [ExprLStmt GhcRn]
_) -> ([ExprLStmt GhcRn
GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
one], FreeVars
emptyNameSet)
rearrangeForApplicativeDo HsDoFlavour
ctxt [(ExprLStmt GhcRn, FreeVars)]
stmts0 = do
  Bool
optimal_ado <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_OptimalApplicativeDo
  let stmt_tree :: ExprStmtTree
stmt_tree | Bool
optimal_ado = [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts
                | Bool
otherwise = [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts
  String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"rearrangeForADo" (StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> SDoc
forall a. Outputable a => a -> SDoc
ppr ExprStmtTree
StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_tree)
  (Name
return_name, FreeVars
_) <- HsStmtContext Any -> Name -> RnM (Name, FreeVars)
forall p. HsStmtContext p -> Name -> RnM (Name, FreeVars)
lookupQualifiedDoName (HsDoFlavour -> HsStmtContext Any
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
returnMName
  (Name
pure_name, FreeVars
_)   <- HsStmtContext Any -> Name -> RnM (Name, FreeVars)
forall p. HsStmtContext p -> Name -> RnM (Name, FreeVars)
lookupQualifiedDoName (HsDoFlavour -> HsStmtContext Any
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
pureAName
  let monad_names :: MonadNames
monad_names = MonadNames { return_name :: Name
return_name = Name
return_name
                               , pure_name :: Name
pure_name   = Name
pure_name }
  MonadNames
-> HsDoFlavour
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt ExprStmtTree
stmt_tree [ExprLStmt GhcRn
GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
last] FreeVars
last_fvs
  where
    ([(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts,(GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
last,FreeVars
last_fvs)) = [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> ([(GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)],
    (GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars))
forall {a}. [a] -> ([a], a)
findLast [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts0
    findLast :: [a] -> ([a], a)
findLast [] = String -> ([a], a)
forall a. HasCallStack => String -> a
error String
"findLast"
    findLast [a
last] = ([],a
last)
    findLast (a
x:[a]
xs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest,a
last) where ([a]
rest,a
last) = [a] -> ([a], a)
findLast [a]
xs

-- | A tree of statements using a mixture of applicative and bind constructs.
data StmtTree a
  = StmtTreeOne a
  | StmtTreeBind (StmtTree a) (StmtTree a)
  | StmtTreeApplicative [StmtTree a]

instance Outputable a => Outputable (StmtTree a) where
  ppr :: StmtTree a -> SDoc
ppr (StmtTreeOne a
x)          = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StmtTreeOne" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x)
  ppr (StmtTreeBind StmtTree a
x StmtTree a
y)       = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StmtTreeBind")
                                            Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [StmtTree a -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtTree a
x, StmtTree a -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtTree a
y]))
  ppr (StmtTreeApplicative [StmtTree a]
xs) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StmtTreeApplicative")
                                            Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((StmtTree a -> SDoc) -> [StmtTree a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map StmtTree a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [StmtTree a]
xs)))

flattenStmtTree :: StmtTree a -> [a]
flattenStmtTree :: forall a. StmtTree a -> [a]
flattenStmtTree StmtTree a
t = StmtTree a -> [a] -> [a]
forall {a}. StmtTree a -> [a] -> [a]
go StmtTree a
t []
 where
  go :: StmtTree a -> [a] -> [a]
go (StmtTreeOne a
a) [a]
as = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
  go (StmtTreeBind StmtTree a
l StmtTree a
r) [a]
as = StmtTree a -> [a] -> [a]
go StmtTree a
l (StmtTree a -> [a] -> [a]
go StmtTree a
r [a]
as)
  go (StmtTreeApplicative [StmtTree a]
ts) [a]
as = (StmtTree a -> [a] -> [a]) -> [a] -> [StmtTree a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr StmtTree a -> [a] -> [a]
go [a]
as [StmtTree a]
ts

type ExprStmtTree = StmtTree (ExprLStmt GhcRn, FreeVars)
type Cost = Int

-- | Turn a sequence of statements into an ExprStmtTree using a
-- heuristic algorithm.  /O(n^2)/
mkStmtTreeHeuristic :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(ExprLStmt GhcRn, FreeVars)
one] = (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (ExprLStmt GhcRn, FreeVars)
(GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
one
mkStmtTreeHeuristic [(ExprLStmt GhcRn, FreeVars)]
stmts =
  case [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
segments [(ExprLStmt GhcRn, FreeVars)]
stmts of
    [[(ExprLStmt GhcRn, FreeVars)]
one] -> [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
split [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
one
    [[(ExprLStmt GhcRn, FreeVars)]]
segs -> [StmtTree
   (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)]
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. [StmtTree a] -> StmtTree a
StmtTreeApplicative (([(GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)]
 -> StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars))
-> [[(GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
-> [StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars)]
forall a b. (a -> b) -> [a] -> [b]
map [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
split [[(ExprLStmt GhcRn, FreeVars)]]
[[(GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)]]
segs)
 where
  split :: [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
split [(GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
one] = (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
one
  split [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts =
    StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. StmtTree a -> StmtTree a -> StmtTree a
StmtTreeBind ([(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(ExprLStmt GhcRn, FreeVars)]
before) ([(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(ExprLStmt GhcRn, FreeVars)]
after)
    where ([(ExprLStmt GhcRn, FreeVars)]
before, [(ExprLStmt GhcRn, FreeVars)]
after) = [(ExprLStmt GhcRn, FreeVars)]
-> ([(ExprLStmt GhcRn, FreeVars)], [(ExprLStmt GhcRn, FreeVars)])
splitSegment [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts

-- | Turn a sequence of statements into an ExprStmtTree optimally,
-- using dynamic programming.  /O(n^3)/
mkStmtTreeOptimal :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal [(ExprLStmt GhcRn, FreeVars)]
stmts =
  Bool -> ExprStmtTree -> ExprStmtTree
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not ([(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts)) (ExprStmtTree -> ExprStmtTree) -> ExprStmtTree -> ExprStmtTree
forall a b. (a -> b) -> a -> b
$ -- the empty case is handled by the caller;
                              -- we don't support empty StmtTrees.
  (StmtTree
   (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars),
 Int)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a b. (a, b) -> a
fst (Array (Int, Int) (ExprStmtTree, Int)
Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
arr Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
-> (Int, Int)
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
0,Int
n))
  where
    n :: Int
n = [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    stmt_arr :: Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr = (Int, Int)
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> Array
     Int
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
n) [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts

    -- lazy cache of optimal trees for subsequences of the input
    arr :: Array (Int,Int) (ExprStmtTree, Cost)
    arr :: Array (Int, Int) (ExprStmtTree, Int)
arr = ((Int, Int), (Int, Int))
-> [((Int, Int),
     (StmtTree
        (GenLocated
           SrcSpanAnnA
           (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         FreeVars),
      Int))]
-> Array
     (Int, Int)
     (StmtTree
        (GenLocated
           SrcSpanAnnA
           (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         FreeVars),
      Int)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int
0,Int
0),(Int
n,Int
n))
             [ ((Int
lo,Int
hi), Int
-> Int
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
tree Int
lo Int
hi)
             | Int
lo <- [Int
0..Int
n]
             , Int
hi <- [Int
lo..Int
n] ]

    -- compute the optimal tree for the sequence [lo..hi]
    tree :: Int
-> Int
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
tree Int
lo Int
hi
      | Int
hi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lo = ((GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> Int
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1)
      | Bool
otherwise =
         case [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
segments [ Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> Int
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
i | Int
i <- [Int
lo..Int
hi] ] of
           [] -> String
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
forall a. HasCallStack => String -> a
panic String
"mkStmtTree"
           [[(ExprLStmt GhcRn, FreeVars)]
_one] -> Int -> Int -> (ExprStmtTree, Int)
split Int
lo Int
hi
           [[(ExprLStmt GhcRn, FreeVars)]]
segs -> ([StmtTree
   (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)]
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. [StmtTree a] -> StmtTree a
StmtTreeApplicative [StmtTree
   (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)]
trees, [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
costs)
             where
               bounds :: [(Int, Int)]
bounds = ((Int, Int)
 -> [(GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]
 -> (Int, Int))
-> (Int, Int)
-> [[(GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
-> [(Int, Int)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Int
_,Int
hi) [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
a -> (Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
a)) (Int
0,Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [[(ExprLStmt GhcRn, FreeVars)]]
[[(GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)]]
segs
               ([StmtTree
   (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)]
trees,[Int]
costs) = [(StmtTree
    (GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars),
  Int)]
-> ([StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars)],
    [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Int, Int)
 -> (StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int))
-> [(Int, Int)]
-> [(StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
 -> Int
 -> (StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int))
-> (Int, Int)
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> (ExprStmtTree, Int)
Int
-> Int
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
split) ([(Int, Int)] -> [(Int, Int)]
forall a. HasCallStack => [a] -> [a]
tail [(Int, Int)]
bounds))

    -- find the best place to split the segment [lo..hi]
    split :: Int -> Int -> (ExprStmtTree, Cost)
    split :: Int -> Int -> (ExprStmtTree, Int)
split Int
lo Int
hi
      | Int
hi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lo = ((GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> Int
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1)
      | Bool
otherwise = (StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. StmtTree a -> StmtTree a -> StmtTree a
StmtTreeBind StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
before StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
after, Int
c1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c2)
        where
         -- As per the paper, for a sequence s1...sn, we want to find
         -- the split with the minimum cost, where the cost is the
         -- sum of the cost of the left and right subsequences.
         --
         -- As an optimisation (also in the paper) if the cost of
         -- s1..s(n-1) is different from the cost of s2..sn, we know
         -- that the optimal solution is the lower of the two.  Only
         -- in the case that these two have the same cost do we need
         -- to do the exhaustive search.
         --
         ((StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
before,Int
c1),(StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
after,Int
c2))
           | Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
           = (((GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> Int
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1),
              ((GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> Int
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
hi), Int
1))
           | Int
left_cost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
right_cost
           = ((StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
left,Int
left_cost), ((GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> Int
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
hi), Int
1))
           | Int
left_cost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
right_cost
           = (((GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
stmt_arr Array
  Int
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> Int
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1), (StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
right,Int
right_cost))
           | Bool
otherwise = (((StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int),
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int))
 -> ((StmtTree
        (GenLocated
           SrcSpanAnnA
           (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         FreeVars),
      Int),
     (StmtTree
        (GenLocated
           SrcSpanAnnA
           (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         FreeVars),
      Int))
 -> Ordering)
-> [((StmtTree
        (GenLocated
           SrcSpanAnnA
           (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         FreeVars),
      Int),
     (StmtTree
        (GenLocated
           SrcSpanAnnA
           (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         FreeVars),
      Int))]
-> ((StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int),
    (StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((((StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int),
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int))
 -> Int)
-> ((StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int),
    (StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int))
-> ((StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int),
    (StmtTree
       (GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        FreeVars),
     Int))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((StmtTree
    (GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars),
  Int),
 (StmtTree
    (GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars),
  Int))
-> Int
forall {a} {a} {a}. Num a => ((a, a), (a, a)) -> a
cost) [((StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int),
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int))]
alternatives
           where
             (StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
left, Int
left_cost) = Array (Int, Int) (ExprStmtTree, Int)
Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
arr Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
-> (Int, Int)
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
lo,Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
             (StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
right, Int
right_cost) = Array (Int, Int) (ExprStmtTree, Int)
Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
arr Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
-> (Int, Int)
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
hi)
             cost :: ((a, a), (a, a)) -> a
cost ((a
_,a
c1),(a
_,a
c2)) = a
c1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
c2
             alternatives :: [((StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int),
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int))]
alternatives = [ (Array (Int, Int) (ExprStmtTree, Int)
Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
arr Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
-> (Int, Int)
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
lo,Int
k), Array (Int, Int) (ExprStmtTree, Int)
Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
arr Array
  (Int, Int)
  (StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars),
   Int)
-> (Int, Int)
-> (StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars),
    Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
hi))
                            | Int
k <- [Int
lo .. Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]


-- | Turn the ExprStmtTree back into a sequence of statements, using
-- ApplicativeStmt where necessary.
stmtTreeToStmts
  :: MonadNames
  -> HsDoFlavour
  -> ExprStmtTree
  -> [ExprLStmt GhcRn]             -- ^ the "tail"
  -> FreeVars                     -- ^ free variables of the tail
  -> RnM ( [ExprLStmt GhcRn]       -- ( output statements,
         , FreeVars )             -- , things we needed

-- If we have a single bind, and we can do it without a join, transform
-- to an ApplicativeStmt.  This corresponds to the rule
--   dsBlock [pat <- rhs] (return expr) = expr <$> rhs
-- In the spec, but we do it here rather than in the desugarer,
-- because we need the typechecker to typecheck the <$> form rather than
-- the bind form, which would give rise to a Monad constraint.
--
-- If we have a single let, and the last statement is @return E@ or @return $ E@,
-- change the @return@ to @pure@.
stmtTreeToStmts :: MonadNames
-> HsDoFlavour
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt (StmtTreeOne (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
xbs LPat GhcRn
pat GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhs), FreeVars
_))
                [ExprLStmt GhcRn]
tail FreeVars
_tail_fvs
  | Bool -> Bool
not (LPat GhcRn -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern LPat GhcRn
pat), (Bool
False,[ExprLStmt GhcRn]
tail') <- MonadNames
-> [ExprLStmt GhcRn]
-> Maybe (HsExpr GhcRn)
-> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn]
tail Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing
  -- See Note [ApplicativeDo and strict patterns]
  = HsDoFlavour
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsDoFlavour
ctxt [ApplicativeArgOne
                            { xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = XBindStmtRn -> Maybe (SyntaxExpr GhcRn)
xbsrn_failOp XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
XBindStmtRn
xbs
                            , app_arg_pattern :: LPat GhcRn
app_arg_pattern  = LPat GhcRn
pat
                            , arg_expr :: XRec GhcRn (HsExpr GhcRn)
arg_expr         = XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhs
                            , is_body_stmt :: Bool
is_body_stmt     = Bool
False
                            }]
                      Bool
False [ExprLStmt GhcRn]
tail'
stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt (StmtTreeOne (L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhs SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_),FreeVars
_))
                [ExprLStmt GhcRn]
tail FreeVars
_tail_fvs
  | (Bool
False,[ExprLStmt GhcRn]
tail') <- MonadNames
-> [ExprLStmt GhcRn]
-> Maybe (HsExpr GhcRn)
-> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn]
tail Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing
  = HsDoFlavour
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsDoFlavour
ctxt
      [ApplicativeArgOne
       { xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = Maybe SyntaxExprRn
XApplicativeArgOne GhcRn
forall a. Maybe a
Nothing
       , app_arg_pattern :: LPat GhcRn
app_arg_pattern  = LPat GhcRn
nlWildPatName
       , arg_expr :: XRec GhcRn (HsExpr GhcRn)
arg_expr         = XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhs
       , is_body_stmt :: Bool
is_body_stmt     = Bool
True
       }] Bool
False [ExprLStmt GhcRn]
tail'
stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt (StmtTreeOne (let_stmt :: ExprLStmt GhcRn
let_stmt@(L SrcSpanAnnA
_ LetStmt{}),FreeVars
_))
                [ExprLStmt GhcRn]
tail FreeVars
_tail_fvs = do
  (HsExpr GhcRn
pure_expr, FreeVars
_) <- HsStmtContext Any -> Name -> TcM (HsExpr GhcRn, FreeVars)
forall p. HsStmtContext p -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr (HsDoFlavour -> HsStmtContext Any
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
pureAName
  ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
  FreeVars)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      ([GenLocated
          SrcSpanAnnA
          (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
       FreeVars))
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
    FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a b. (a -> b) -> a -> b
$ case MonadNames
-> [ExprLStmt GhcRn]
-> Maybe (HsExpr GhcRn)
-> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn]
tail (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just HsExpr GhcRn
pure_expr) of
    (Bool
False, [ExprLStmt GhcRn]
tail') -> (ExprLStmt GhcRn
GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
let_stmt GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
tail', FreeVars
emptyNameSet)
    (Bool
True, [ExprLStmt GhcRn]
_) -> (ExprLStmt GhcRn
GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
let_stmt GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
tail, FreeVars
emptyNameSet)

stmtTreeToStmts MonadNames
_monad_names HsDoFlavour
_ctxt (StmtTreeOne (ExprLStmt GhcRn
s,FreeVars
_)) [ExprLStmt GhcRn]
tail FreeVars
_tail_fvs =
  ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprLStmt GhcRn
GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
s GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
tail, FreeVars
emptyNameSet)

stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt (StmtTreeBind ExprStmtTree
before ExprStmtTree
after) [ExprLStmt GhcRn]
tail FreeVars
tail_fvs = do
  ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts1, FreeVars
fvs1) <- MonadNames
-> HsDoFlavour
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt ExprStmtTree
after [ExprLStmt GhcRn]
tail FreeVars
tail_fvs
  let tail1_fvs :: FreeVars
tail1_fvs = [FreeVars] -> FreeVars
unionNameSets (FreeVars
tail_fvs FreeVars -> [FreeVars] -> [FreeVars]
forall a. a -> [a] -> [a]
: ((GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)
 -> FreeVars)
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> FreeVars
forall a b. (a, b) -> b
snd (StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. StmtTree a -> [a]
flattenStmtTree ExprStmtTree
StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
after))
  ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts2, FreeVars
fvs2) <- MonadNames
-> HsDoFlavour
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt ExprStmtTree
before [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts1 FreeVars
tail1_fvs
  ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts2, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2)

stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt (StmtTreeApplicative [ExprStmtTree]
trees) [ExprLStmt GhcRn]
tail FreeVars
tail_fvs = do
   [(ApplicativeArg GhcRn, FreeVars)]
pairs <- (StmtTree
   (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
 -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars))
-> [StmtTree
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(ApplicativeArg GhcRn, FreeVars)]
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 (HsDoFlavour
-> FreeVars
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
stmtTreeArg HsDoFlavour
ctxt FreeVars
tail_fvs) [ExprStmtTree]
[StmtTree
   (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)]
trees
   DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
   let ([ApplicativeArg GhcRn]
stmts', [FreeVars]
fvss) = [(ApplicativeArg GhcRn, FreeVars)]
-> ([ApplicativeArg GhcRn], [FreeVars])
forall a b. [(a, b)] -> ([a], [b])
unzip [(ApplicativeArg GhcRn, FreeVars)]
pairs
   let (Bool
need_join, [GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
tail') =
     -- See Note [ApplicativeDo and refutable patterns]
         if (ApplicativeArg GhcRn -> Bool) -> [ApplicativeArg GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (DynFlags -> ApplicativeArg GhcRn -> Bool
hasRefutablePattern DynFlags
dflags) [ApplicativeArg GhcRn]
stmts'
         then (Bool
True, [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
tail)
         else MonadNames
-> [ExprLStmt GhcRn]
-> Maybe (HsExpr GhcRn)
-> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn]
tail Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing

   ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts, FreeVars
fvs) <- HsDoFlavour
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsDoFlavour
ctxt [ApplicativeArg GhcRn]
stmts' Bool
need_join [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
tail'
   ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts, [FreeVars] -> FreeVars
unionNameSets (FreeVars
fvsFreeVars -> [FreeVars] -> [FreeVars]
forall a. a -> [a] -> [a]
:[FreeVars]
fvss))
 where
   stmtTreeArg :: HsDoFlavour
-> FreeVars
-> StmtTree
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
stmtTreeArg HsDoFlavour
_ctxt FreeVars
_tail_fvs (StmtTreeOne (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
xbs LPat GhcRn
pat GenLocated SrcSpanAnnA (HsExpr GhcRn)
exp), FreeVars
_))
     = (ApplicativeArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicativeArgOne
               { xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = XBindStmtRn -> Maybe (SyntaxExpr GhcRn)
xbsrn_failOp XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
XBindStmtRn
xbs
               , app_arg_pattern :: LPat GhcRn
app_arg_pattern  = LPat GhcRn
pat
               , arg_expr :: XRec GhcRn (HsExpr GhcRn)
arg_expr         = XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
exp
               , is_body_stmt :: Bool
is_body_stmt     = Bool
False
               }, FreeVars
emptyFVs)
   stmtTreeArg HsDoFlavour
_ctxt FreeVars
_tail_fvs (StmtTreeOne (L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ GenLocated SrcSpanAnnA (HsExpr GhcRn)
exp SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_), FreeVars
_)) =
     (ApplicativeArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicativeArgOne
             { xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = Maybe SyntaxExprRn
XApplicativeArgOne GhcRn
forall a. Maybe a
Nothing
             , app_arg_pattern :: LPat GhcRn
app_arg_pattern  = LPat GhcRn
nlWildPatName
             , arg_expr :: XRec GhcRn (HsExpr GhcRn)
arg_expr         = XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
exp
             , is_body_stmt :: Bool
is_body_stmt     = Bool
True
             }, FreeVars
emptyFVs)
   stmtTreeArg HsDoFlavour
ctxt FreeVars
tail_fvs StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
tree = do
     let stmts :: [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts = StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. StmtTree a -> [a]
flattenStmtTree StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
tree
         pvarset :: FreeVars
pvarset = [Name] -> FreeVars
mkNameSet (((GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)
 -> [Name])
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CollectFlag GhcRn
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> [Name])
-> ((GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)
    -> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ((GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a b. (a, b) -> a
fst) [(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts)
                     FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
tail_fvs
         pvars :: [Name]
pvars = FreeVars -> [Name]
nameSetElemsStable FreeVars
pvarset
           -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]
         pat :: LPat GhcRn
pat = [IdP GhcRn] -> LPat GhcRn
mkBigLHsVarPatTup [IdP GhcRn]
[Name]
pvars
         tup :: XRec GhcRn (HsExpr GhcRn)
tup = [IdP GhcRn] -> XExplicitTuple GhcRn -> XRec GhcRn (HsExpr GhcRn)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkBigLHsVarTup [IdP GhcRn]
[Name]
pvars XExplicitTuple GhcRn
NoExtField
noExtField
     ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts',FreeVars
fvs2) <- MonadNames
-> HsDoFlavour
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsDoFlavour
ctxt ExprStmtTree
StmtTree
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)
tree [] FreeVars
pvarset
     (HsExpr GhcRn
mb_ret, FreeVars
fvs1) <-
        if | L SrcSpanAnnA
_ ApplicativeStmt{} <- [GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. HasCallStack => [a] -> a
last [GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts' ->
             (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
tup, FreeVars
emptyNameSet)
           | Bool
otherwise -> do
             -- Need 'pureAName' and not 'returnMName' here, so that it requires
             -- 'Applicative' and not 'Monad' whenever possible (until #20540 is fixed).
             (HsExpr GhcRn
ret, FreeVars
_) <- HsStmtContext Any -> Name -> TcM (HsExpr GhcRn, FreeVars)
forall p. HsStmtContext p -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr (HsDoFlavour -> HsStmtContext Any
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
pureAName
             let expr :: HsExpr GhcRn
expr = XApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
EpAnn NoEpAnns
noComments (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
noLocA HsExpr GhcRn
ret) XRec GhcRn (HsExpr GhcRn)
tup
             (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
expr, FreeVars
emptyFVs)
     (ApplicativeArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ApplicativeArgMany
              { xarg_app_arg_many :: XApplicativeArgMany GhcRn
xarg_app_arg_many = XApplicativeArgMany GhcRn
NoExtField
noExtField
              , app_stmts :: [ExprLStmt GhcRn]
app_stmts         = [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts'
              , final_expr :: HsExpr GhcRn
final_expr        = HsExpr GhcRn
mb_ret
              , bv_pattern :: LPat GhcRn
bv_pattern        = LPat GhcRn
pat
              , stmt_context :: HsDoFlavour
stmt_context      = HsDoFlavour
ctxt
              }
            , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2)


-- | Divide a sequence of statements into segments, where no segment
-- depends on any variables defined by a statement in another segment.
segments
  :: [(ExprLStmt GhcRn, FreeVars)]
  -> [[(ExprLStmt GhcRn, FreeVars)]]
segments :: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
segments [(ExprLStmt GhcRn, FreeVars)]
stmts = [[(GenLocated
     (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)]]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
forall {a :: Pass} {b} {b}.
[[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
-> [[(GenLocated
        (Anno (StmtLR (GhcPass a) (GhcPass a) b))
        (StmtLR (GhcPass a) (GhcPass a) b),
      b)]]
merge ([[(GenLocated
      (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)]]
 -> [[(GenLocated
         (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars)]])
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
forall a b. (a -> b) -> a -> b
$ [[(GenLocated
     (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)]]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
forall a. [a] -> [a]
reverse ([[(GenLocated
      (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)]]
 -> [[(GenLocated
         (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars)]])
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
forall a b. (a -> b) -> a -> b
$ ([(ExprLStmt GhcRn, FreeVars)]
 -> [(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)])
-> [[(ExprLStmt GhcRn, FreeVars)]]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
forall a b. (a -> b) -> [a] -> [b]
map [(ExprLStmt GhcRn, FreeVars)]
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. [a] -> [a]
reverse ([[(ExprLStmt GhcRn, FreeVars)]]
 -> [[(GenLocated
         (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars)]])
-> [[(ExprLStmt GhcRn, FreeVars)]]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
forall a b. (a -> b) -> a -> b
$ [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
walk ([(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. [a] -> [a]
reverse [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts)
  where
    allvars :: FreeVars
allvars = [Name] -> FreeVars
mkNameSet (((GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)
 -> [Name])
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CollectFlag GhcRn
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> [Name])
-> ((GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)
    -> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ((GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a b. (a, b) -> a
fst) [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts)

    -- We would rather not have a segment that just has LetStmts in
    -- it, so combine those with the next segment where possible.
    -- We don't merge it with the previous segment because the merged segment
    -- would require 'Monad' while it may otherwise only require 'Applicative'.
    merge :: [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
-> [[(GenLocated
        (Anno (StmtLR (GhcPass a) (GhcPass a) b))
        (StmtLR (GhcPass a) (GhcPass a) b),
      b)]]
merge [] = []
    merge ([(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
seg : [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
segs)
       = case [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
rest of
          [(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
s:[[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
ss | Bool
all_lets -> ([(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
seg [(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
-> [(GenLocated
       (Anno (StmtLR (GhcPass a) (GhcPass a) b))
       (StmtLR (GhcPass a) (GhcPass a) b),
     b)]
-> [(GenLocated
       (Anno (StmtLR (GhcPass a) (GhcPass a) b))
       (StmtLR (GhcPass a) (GhcPass a) b),
     b)]
forall a. [a] -> [a] -> [a]
++ [(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
s) [(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
-> [[(GenLocated
        (Anno (StmtLR (GhcPass a) (GhcPass a) b))
        (StmtLR (GhcPass a) (GhcPass a) b),
      b)]]
-> [[(GenLocated
        (Anno (StmtLR (GhcPass a) (GhcPass a) b))
        (StmtLR (GhcPass a) (GhcPass a) b),
      b)]]
forall a. a -> [a] -> [a]
: [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
ss
          [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
_otherwise -> [(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
seg [(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
-> [[(GenLocated
        (Anno (StmtLR (GhcPass a) (GhcPass a) b))
        (StmtLR (GhcPass a) (GhcPass a) b),
      b)]]
-> [[(GenLocated
        (Anno (StmtLR (GhcPass a) (GhcPass a) b))
        (StmtLR (GhcPass a) (GhcPass a) b),
      b)]]
forall a. a -> [a] -> [a]
: [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
rest
      where
        rest :: [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
rest = [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
-> [[(GenLocated
        (Anno (StmtLR (GhcPass a) (GhcPass a) b))
        (StmtLR (GhcPass a) (GhcPass a) b),
      b)]]
merge [[(GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b),
   b)]]
segs
        all_lets :: Bool
all_lets = ((GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)
 -> Bool)
-> [(GenLocated
       (Anno (StmtLR (GhcPass a) (GhcPass a) b))
       (StmtLR (GhcPass a) (GhcPass a) b),
     b)]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (LStmt (GhcPass a) b -> Bool
GenLocated
  (Anno (StmtLR (GhcPass a) (GhcPass a) b))
  (StmtLR (GhcPass a) (GhcPass a) b)
-> Bool
forall (a :: Pass) b. LStmt (GhcPass a) b -> Bool
isLetStmt (GenLocated
   (Anno (StmtLR (GhcPass a) (GhcPass a) b))
   (StmtLR (GhcPass a) (GhcPass a) b)
 -> Bool)
-> ((GenLocated
       (Anno (StmtLR (GhcPass a) (GhcPass a) b))
       (StmtLR (GhcPass a) (GhcPass a) b),
     b)
    -> GenLocated
         (Anno (StmtLR (GhcPass a) (GhcPass a) b))
         (StmtLR (GhcPass a) (GhcPass a) b))
-> (GenLocated
      (Anno (StmtLR (GhcPass a) (GhcPass a) b))
      (StmtLR (GhcPass a) (GhcPass a) b),
    b)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   (Anno (StmtLR (GhcPass a) (GhcPass a) b))
   (StmtLR (GhcPass a) (GhcPass a) b),
 b)
-> GenLocated
     (Anno (StmtLR (GhcPass a) (GhcPass a) b))
     (StmtLR (GhcPass a) (GhcPass a) b)
forall a b. (a, b) -> a
fst) [(GenLocated
    (Anno (StmtLR (GhcPass a) (GhcPass a) b))
    (StmtLR (GhcPass a) (GhcPass a) b),
  b)]
seg

    -- walk splits the statement sequence into segments, traversing
    -- the sequence from the back to the front, and keeping track of
    -- the set of free variables of the current segment.  Whenever
    -- this set of free variables is empty, we have a complete segment.
    walk :: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
    walk :: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
walk [] = []
    walk ((ExprLStmt GhcRn
stmt,FreeVars
fvs) : [(ExprLStmt GhcRn, FreeVars)]
stmts) = ((ExprLStmt GhcRn
GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt,FreeVars
fvs) (GenLocated
   (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. a -> [a] -> [a]
: [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
seg) [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
-> [[(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)]]
forall a. a -> [a] -> [a]
: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
walk [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest
      where ([(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
seg,[(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest) = FreeVars
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> ([(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)],
    [(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)])
chunter FreeVars
fvs' [(ExprLStmt GhcRn, FreeVars)]
[(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
stmts
            (FreeVars
_, FreeVars
fvs') = GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> FreeVars -> (FreeVars, FreeVars)
stmtRefs ExprLStmt GhcRn
GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt FreeVars
fvs

    chunter :: FreeVars
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> ([(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)],
    [(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)])
chunter FreeVars
_ [] = ([], [])
    chunter FreeVars
vars ((GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt,FreeVars
fvs) : [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest)
       | Bool -> Bool
not (FreeVars -> Bool
isEmptyNameSet FreeVars
vars)
       Bool -> Bool -> Bool
|| ExprLStmt GhcRn -> Bool
isStrictPatternBind ExprLStmt GhcRn
GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt
           -- See Note [ApplicativeDo and strict patterns]
       = ((GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt,FreeVars
fvs) (GenLocated
   (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. a -> [a] -> [a]
: [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
chunk, [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest')
       where ([(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
chunk,[(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest') = FreeVars
-> [(GenLocated
       (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> ([(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)],
    [(GenLocated
        (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)])
chunter FreeVars
vars' [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest
             (FreeVars
pvars, FreeVars
evars) = GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> FreeVars -> (FreeVars, FreeVars)
stmtRefs GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt FreeVars
fvs
             vars' :: FreeVars
vars' = (FreeVars
vars FreeVars -> FreeVars -> FreeVars
`minusNameSet` FreeVars
pvars) FreeVars -> FreeVars -> FreeVars
`unionNameSet` FreeVars
evars
    chunter FreeVars
_ [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest = ([], [(GenLocated
    (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest)

    stmtRefs :: GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> FreeVars -> (FreeVars, FreeVars)
stmtRefs GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt FreeVars
fvs
      | LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> Bool
forall (a :: Pass) b. LStmt (GhcPass a) b -> Bool
isLetStmt LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt = (FreeVars
pvars, FreeVars
fvs' FreeVars -> FreeVars -> FreeVars
`minusNameSet` FreeVars
pvars)
      | Bool
otherwise      = (FreeVars
pvars, FreeVars
fvs')
      where fvs' :: FreeVars
fvs' = FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
allvars
            pvars :: FreeVars
pvars = [Name] -> FreeVars
mkNameSet (CollectFlag GhcRn
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders (GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc GenLocated
  (Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
stmt))

    isStrictPatternBind :: ExprLStmt GhcRn -> Bool
    isStrictPatternBind :: ExprLStmt GhcRn -> Bool
isStrictPatternBind (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ LPat GhcRn
pat GenLocated SrcSpanAnnA (HsExpr GhcRn)
_)) = LPat GhcRn -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern LPat GhcRn
pat
    isStrictPatternBind ExprLStmt GhcRn
_ = Bool
False

{-
Note [ApplicativeDo and strict patterns]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A strict pattern match is really a dependency.  For example,

do
  (x,y) <- A
  z <- B
  return C

The pattern (_,_) must be matched strictly before we do B.  If we
allowed this to be transformed into

  (\(x,y) -> \z -> C) <$> A <*> B

then it could be lazier than the standard desugaring using >>=.  See #13875
for more examples.

Thus, whenever we have a strict pattern match, we treat it as a
dependency between that statement and the following one.  The
dependency prevents those two statements from being performed "in
parallel" in an ApplicativeStmt, but doesn't otherwise affect what we
can do with the rest of the statements in the same "do" expression.
-}

isStrictPattern :: forall p. IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern :: forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern (L SrcSpanAnnA
loc Pat (GhcPass p)
pat) =
  case Pat (GhcPass p)
pat of
    WildPat{}       -> Bool
False
    VarPat{}        -> Bool
False
    LazyPat{}       -> Bool
False
    AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LHsToken "@" (GhcPass p)
_ LPat (GhcPass p)
p   -> LPat (GhcPass p) -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
    ParPat XParPat (GhcPass p)
_ LHsToken "(" (GhcPass p)
_ LPat (GhcPass p)
p LHsToken ")" (GhcPass p)
_  -> LPat (GhcPass p) -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
    ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
_ LPat (GhcPass p)
p   -> LPat (GhcPass p) -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
    SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
p HsPatSigType (NoGhcTc (GhcPass p))
_    -> LPat (GhcPass p) -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
    BangPat{}       -> Bool
True
    ListPat{}       -> Bool
True
    TuplePat{}      -> Bool
True
    SumPat{}        -> Bool
True
    ConPat{}        -> Bool
True
    LitPat{}        -> Bool
True
    NPat{}          -> Bool
True
    NPlusKPat{}     -> Bool
True
    SplicePat{}     -> Bool
True
    XPat XXPat (GhcPass p)
ext        -> case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
      GhcPs -> dataConCantHappen ext
#endif
      GhcPass p
GhcRn
        | HsPatExpanded Pat GhcRn
_ Pat GhcRn
p <- XXPat (GhcPass p)
ext
        -> LPat GhcRn -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern (SrcSpanAnnA -> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc Pat GhcRn
p)
      GhcPass p
GhcTc -> case XXPat (GhcPass p)
ext of
        ExpansionPat Pat GhcRn
_ Pat GhcTc
p -> LPat GhcTc -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern (SrcSpanAnnA -> Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc Pat GhcTc
p)
        CoPat {} -> String -> Bool
forall a. HasCallStack => String -> a
panic String
"isStrictPattern: CoPat"

{-
Note [ApplicativeDo and refutable patterns]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Refutable patterns in do blocks are desugared to use the monadic 'fail' operation.
This means that sometimes an applicative block needs to be wrapped in 'join' simply because
of a refutable pattern, in order for the types to work out.

-}

hasRefutablePattern :: DynFlags -> ApplicativeArg GhcRn -> Bool
hasRefutablePattern :: DynFlags -> ApplicativeArg GhcRn -> Bool
hasRefutablePattern DynFlags
dflags (ApplicativeArgOne { app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
app_arg_pattern = LPat GhcRn
pat
                                              , is_body_stmt :: forall idL. ApplicativeArg idL -> Bool
is_body_stmt = Bool
False}) =
                                         Bool -> Bool
not (DynFlags -> LPat GhcRn -> Bool
forall (p :: Pass).
OutputableBndrId p =>
DynFlags -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat DynFlags
dflags LPat GhcRn
pat)
hasRefutablePattern DynFlags
_ ApplicativeArg GhcRn
_ = Bool
False

isLetStmt :: LStmt (GhcPass a) b -> Bool
isLetStmt :: forall (a :: Pass) b. LStmt (GhcPass a) b -> Bool
isLetStmt (L Anno (StmtLR (GhcPass a) (GhcPass a) b)
_ LetStmt{}) = Bool
True
isLetStmt LStmt (GhcPass a) b
_ = Bool
False

-- | Find a "good" place to insert a bind in an indivisible segment.
-- This is the only place where we use heuristics.  The current
-- heuristic is to peel off the first group of independent statements
-- and put the bind after those.
splitSegment
  :: [(ExprLStmt GhcRn, FreeVars)]
  -> ( [(ExprLStmt GhcRn, FreeVars)]
     , [(ExprLStmt GhcRn, FreeVars)] )
splitSegment :: [(ExprLStmt GhcRn, FreeVars)]
-> ([(ExprLStmt GhcRn, FreeVars)], [(ExprLStmt GhcRn, FreeVars)])
splitSegment [(ExprLStmt GhcRn, FreeVars)
one,(ExprLStmt GhcRn, FreeVars)
two] = ([(ExprLStmt GhcRn, FreeVars)
one],[(ExprLStmt GhcRn, FreeVars)
two])
  -- there is no choice when there are only two statements; this just saves
  -- some work in a common case.
splitSegment [(ExprLStmt GhcRn, FreeVars)]
stmts
  | Just ([(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
lets,[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
binds,[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
rest) <- [(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
-> Maybe
     ([(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)],
      [(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)],
      [(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)])
forall (body :: * -> *).
[(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
-> Maybe
     ([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
      [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
      [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)])
slurpIndependentStmts [(ExprLStmt GhcRn, FreeVars)]
[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
stmts
  =  if Bool -> Bool
not ([(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
lets)
       then ([(ExprLStmt GhcRn, FreeVars)]
[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
lets, [(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
binds[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. [a] -> [a] -> [a]
++[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
rest)
       else ([(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
lets[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     FreeVars)]
forall a. [a] -> [a] -> [a]
++[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
[(GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
binds, [(ExprLStmt GhcRn, FreeVars)]
[(LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), FreeVars)]
rest)
  | Bool
otherwise
  = case [(ExprLStmt GhcRn, FreeVars)]
stmts of
      ((ExprLStmt GhcRn, FreeVars)
x:[(ExprLStmt GhcRn, FreeVars)]
xs) -> ([(ExprLStmt GhcRn, FreeVars)
x],[(ExprLStmt GhcRn, FreeVars)]
xs)
      [(ExprLStmt GhcRn, FreeVars)]
_other -> ([(ExprLStmt GhcRn, FreeVars)]
stmts,[])

slurpIndependentStmts
   :: [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
   -> Maybe ( [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)] -- LetStmts
            , [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)] -- BindStmts
            , [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)] )
slurpIndependentStmts :: forall (body :: * -> *).
[(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
-> Maybe
     ([(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
      [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)],
      [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)])
slurpIndependentStmts [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
stmts = [(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
-> FreeVars
-> [(GenLocated
       SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
     FreeVars)]
-> Maybe
     ([(GenLocated
          SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
        FreeVars)],
      [(GenLocated
          SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
        FreeVars)],
      [(GenLocated
          SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
        FreeVars)])
forall {p :: Pass} {idR} {body} {idR} {body} {l}.
(XBindStmt (GhcPass p) idR body ~ XBindStmt (GhcPass p) idR body,
 XLetStmt (GhcPass p) idR body ~ XLetStmt (GhcPass p) idR body,
 IdGhcP p ~ Name, IsPass p) =>
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
     ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go [] [] FreeVars
emptyNameSet [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]
[(GenLocated
    SrcSpanAnnA (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))),
  FreeVars)]
stmts
 where
  -- If we encounter a BindStmt that doesn't depend on a previous BindStmt
  -- in this group, then add it to the group. We have to be careful about
  -- strict patterns though; splitSegments expects that if we return Just
  -- then we have actually done some splitting. Otherwise it will go into
  -- an infinite loop (#14163).
  go :: [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
     ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
bndrs ((L l
loc (BindStmt XBindStmt (GhcPass p) idR body
xbs LPat (GhcPass p)
pat body
body), FreeVars
fvs): [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest)
    | FreeVars -> FreeVars -> Bool
disjointNameSet FreeVars
bndrs FreeVars
fvs Bool -> Bool -> Bool
&& Bool -> Bool
not (LPat (GhcPass p) -> Bool
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
pat)
    = [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
     ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets ((l
-> StmtLR (GhcPass p) idR body
-> GenLocated l (StmtLR (GhcPass p) idR body)
forall l e. l -> e -> GenLocated l e
L l
loc (XBindStmt (GhcPass p) idR body
-> LPat (GhcPass p) -> body -> StmtLR (GhcPass p) idR body
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt (GhcPass p) idR body
XBindStmt (GhcPass p) idR body
xbs LPat (GhcPass p)
pat body
body), FreeVars
fvs) (GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. a -> [a] -> [a]
: [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep)
         FreeVars
bndrs' [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest
    where bndrs' :: FreeVars
bndrs' = FreeVars
bndrs FreeVars -> FreeVars -> FreeVars
`unionNameSet` [Name] -> FreeVars
mkNameSet (CollectFlag (GhcPass p) -> LPat (GhcPass p) -> [IdP (GhcPass p)]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag (GhcPass p)
forall p. CollectFlag p
CollNoDictBinders LPat (GhcPass p)
pat)
  -- If we encounter a LetStmt that doesn't depend on a BindStmt in this
  -- group, then move it to the beginning, so that it doesn't interfere with
  -- grouping more BindStmts.
  -- TODO: perhaps we shouldn't do this if there are any strict bindings,
  -- because we might be moving evaluation earlier.
  go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
bndrs ((L l
loc (LetStmt XLetStmt (GhcPass p) idR body
noExtField HsLocalBindsLR (GhcPass p) idR
binds), FreeVars
fvs) : [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest)
    | FreeVars -> FreeVars -> Bool
disjointNameSet FreeVars
bndrs FreeVars
fvs
    = [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
     ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go ((l
-> StmtLR (GhcPass p) idR body
-> GenLocated l (StmtLR (GhcPass p) idR body)
forall l e. l -> e -> GenLocated l e
L l
loc (XLetStmt (GhcPass p) idR body
-> HsLocalBindsLR (GhcPass p) idR -> StmtLR (GhcPass p) idR body
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt (GhcPass p) idR body
XLetStmt (GhcPass p) idR body
noExtField HsLocalBindsLR (GhcPass p) idR
binds), FreeVars
fvs) (GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. a -> [a] -> [a]
: [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets) [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
bndrs [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest
  go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ []  FreeVars
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ = Maybe
  ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
   [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
   [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
forall a. Maybe a
Nothing
  go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)
_] FreeVars
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ = Maybe
  ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
   [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
   [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
forall a. Maybe a
Nothing
  go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
stmts = ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
 [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
 [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
-> Maybe
     ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
      [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
forall a. a -> Maybe a
Just ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. [a] -> [a]
reverse [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets, [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. [a] -> [a]
reverse [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep, [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
stmts)

-- | Build an ApplicativeStmt, and strip the "return" from the tail
-- if necessary.
--
-- For example, if we start with
--   do x <- E1; y <- E2; return (f x y)
-- then we get
--   do (E1[x] | E2[y]); f x y
--
-- the LastStmt in this case has the return removed, but we set the
-- flag on the LastStmt to indicate this, so that we can print out the
-- original statement correctly in error messages.  It is easier to do
-- it this way rather than try to ignore the return later in both the
-- typechecker and the desugarer (I tried it that way first!).
mkApplicativeStmt
  :: HsDoFlavour
  -> [ApplicativeArg GhcRn]             -- ^ The args
  -> Bool                               -- ^ True <=> need a join
  -> [ExprLStmt GhcRn]        -- ^ The body statements
  -> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt :: HsDoFlavour
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsDoFlavour
ctxt [ApplicativeArg GhcRn]
args Bool
need_join [ExprLStmt GhcRn]
body_stmts
  = do { (SyntaxExprRn
fmap_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName (HsDoFlavour -> HsStmtContext GhcRn
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
fmapName
       ; (SyntaxExprRn
ap_op, FreeVars
fvs2) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName (HsDoFlavour -> HsStmtContext GhcRn
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
apAName
       ; (Maybe SyntaxExprRn
mb_join, FreeVars
fvs3) <-
           if Bool
need_join then
             do { (SyntaxExprRn
join_op, FreeVars
fvs) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName (HsDoFlavour -> HsStmtContext GhcRn
forall p. HsDoFlavour -> HsStmtContext p
HsDoStmt HsDoFlavour
ctxt) Name
joinMName
                ; (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn -> Maybe SyntaxExprRn
forall a. a -> Maybe a
Just SyntaxExprRn
join_op, FreeVars
fvs) }
           else
             (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SyntaxExprRn
forall a. Maybe a
Nothing, FreeVars
emptyNameSet)
       ; let applicative_stmt :: GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
applicative_stmt = StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a an. a -> LocatedAn an a
noLocA (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a b. (a -> b) -> a -> b
$ XApplicativeStmt
  GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
-> Maybe (SyntaxExpr GhcRn)
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
ApplicativeStmt XApplicativeStmt
  GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
NoExtField
noExtField
               ([SyntaxExprRn]
-> [ApplicativeArg GhcRn] -> [(SyntaxExprRn, ApplicativeArg GhcRn)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SyntaxExprRn
fmap_op SyntaxExprRn -> [SyntaxExprRn] -> [SyntaxExprRn]
forall a. a -> [a] -> [a]
: SyntaxExprRn -> [SyntaxExprRn]
forall a. a -> [a]
repeat SyntaxExprRn
ap_op) [ApplicativeArg GhcRn]
args)
               Maybe (SyntaxExpr GhcRn)
Maybe SyntaxExprRn
mb_join
       ; ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
applicative_stmt GenLocated
  SrcSpanAnnA
  (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcRn]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
body_stmts
                , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }

-- | Given the statements following an ApplicativeStmt, determine whether
-- we need a @join@ or not, and remove the @return@ if necessary.
--
-- We don't need @join@ if there's a single @LastStmt@ in the form of
-- @return E@, @return $ E@, @pure E@ or @pure $ E@.
needJoin :: MonadNames
         -> [ExprLStmt GhcRn]
            -- If this is @Just pure@, replace return by pure
            -- If this is @Nothing@, strip the return/pure
         -> Maybe (HsExpr GhcRn)
         -> (Bool, [ExprLStmt GhcRn])
needJoin :: MonadNames
-> [ExprLStmt GhcRn]
-> Maybe (HsExpr GhcRn)
-> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
_monad_names [] Maybe (HsExpr GhcRn)
_mb_pure = (Bool
False, [])  -- we're in an ApplicativeArg
needJoin MonadNames
monad_names  [L SrcSpanAnnA
loc (LastStmt XLastStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ GenLocated SrcSpanAnnA (HsExpr GhcRn)
e Maybe Bool
_ SyntaxExpr GhcRn
t)] Maybe (HsExpr GhcRn)
mb_pure
 | Just (XRec GhcRn (HsExpr GhcRn)
arg, Maybe Bool
noret) <- MonadNames
-> XRec GhcRn (HsExpr GhcRn)
-> Maybe (HsExpr GhcRn)
-> Maybe (XRec GhcRn (HsExpr GhcRn), Maybe Bool)
isReturnApp MonadNames
monad_names XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e Maybe (HsExpr GhcRn)
mb_pure =
       (Bool
False, [SrcSpanAnnA
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XLastStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> Maybe Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
NoExtField
noExtField XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg Maybe Bool
noret SyntaxExpr GhcRn
t)])
needJoin MonadNames
_monad_names [ExprLStmt GhcRn]
stmts Maybe (HsExpr GhcRn)
_mb_pure = (Bool
True, [ExprLStmt GhcRn]
stmts)

-- | @(Just e, Just False)@, if the expression is @return/pure e@,
--     and the third argument is Nothing,
--   @(Just e, Just True)@ if the expression is @return/pure $ e@,
--     and the third argument is Nothing,
--   @(Just (pure e), Nothing)@ if the expression is @return/pure e@,
--     and the third argument is @Just pure_expr@,
--   @(Just (pure $ e), Nothing)@ if the expression is @return/pure $ e@,
--     and the third argument is @Just pure_expr@,
--   otherwise @Nothing@.
isReturnApp :: MonadNames
            -> LHsExpr GhcRn
            -- If this is @Just pure@, replace return by pure
            -- If this is @Nothing@, strip the return/pure
            -> Maybe (HsExpr GhcRn)
            -> Maybe (LHsExpr GhcRn, Maybe Bool)
isReturnApp :: MonadNames
-> XRec GhcRn (HsExpr GhcRn)
-> Maybe (HsExpr GhcRn)
-> Maybe (XRec GhcRn (HsExpr GhcRn), Maybe Bool)
isReturnApp MonadNames
monad_names (L SrcSpanAnnA
_ (HsPar XPar GhcRn
_ LHsToken "(" GhcRn
_ XRec GhcRn (HsExpr GhcRn)
expr LHsToken ")" GhcRn
_)) Maybe (HsExpr GhcRn)
mb_pure =
  MonadNames
-> XRec GhcRn (HsExpr GhcRn)
-> Maybe (HsExpr GhcRn)
-> Maybe (XRec GhcRn (HsExpr GhcRn), Maybe Bool)
isReturnApp MonadNames
monad_names XRec GhcRn (HsExpr GhcRn)
expr Maybe (HsExpr GhcRn)
mb_pure
isReturnApp MonadNames
monad_names (L SrcSpanAnnA
loc HsExpr GhcRn
e) Maybe (HsExpr GhcRn)
mb_pure = case HsExpr GhcRn
e of
  OpApp XOpApp GhcRn
x XRec GhcRn (HsExpr GhcRn)
l XRec GhcRn (HsExpr GhcRn)
op XRec GhcRn (HsExpr GhcRn)
r
    | Just HsExpr GhcRn
pure_expr <- Maybe (HsExpr GhcRn)
mb_pure, GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_return XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
l, GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_dollar XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op ->
        (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
forall a. a -> Maybe a
Just (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XOpApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcRn
x (GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall {l} {e} {e}. GenLocated l e -> e -> GenLocated l e
to_pure XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
l HsExpr GhcRn
pure_expr) XRec GhcRn (HsExpr GhcRn)
op XRec GhcRn (HsExpr GhcRn)
r), Maybe Bool
forall a. Maybe a
Nothing)
    | GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_return XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
l, GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_dollar XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op -> (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
forall a. a -> Maybe a
Just (XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
r, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
  HsApp XApp GhcRn
x XRec GhcRn (HsExpr GhcRn)
f XRec GhcRn (HsExpr GhcRn)
arg
    | Just HsExpr GhcRn
pure_expr <- Maybe (HsExpr GhcRn)
mb_pure, GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_return XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
f ->
        (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
forall a. a -> Maybe a
Just (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XApp GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
x (GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall {l} {e} {e}. GenLocated l e -> e -> GenLocated l e
to_pure XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
f HsExpr GhcRn
pure_expr) XRec GhcRn (HsExpr GhcRn)
arg), Maybe Bool
forall a. Maybe a
Nothing)
    | GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_return XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
f -> (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
forall a. a -> Maybe a
Just (XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
  HsExpr GhcRn
_otherwise -> Maybe (XRec GhcRn (HsExpr GhcRn), Maybe Bool)
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn), Maybe Bool)
forall a. Maybe a
Nothing
 where
  is_var :: (IdP p -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var IdP p -> Bool
f (L l
_ (HsPar XPar p
_ LHsToken "(" p
_ XRec p (HsExpr p)
e LHsToken ")" p
_)) = (IdP p -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var IdP p -> Bool
f XRec p (HsExpr p)
GenLocated l (HsExpr p)
e
  is_var IdP p -> Bool
f (L l
_ (HsAppType XAppTypeE p
_ XRec p (HsExpr p)
e LHsToken "@" p
_ LHsWcType (NoGhcTc p)
_)) = (IdP p -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var IdP p -> Bool
f XRec p (HsExpr p)
GenLocated l (HsExpr p)
e
  is_var IdP p -> Bool
f (L l
_ (HsVar XVar p
_ (L l
_ IdP p
r))) = IdP p -> Bool
f IdP p
r
       -- TODO: I don't know how to get this right for rebindable syntax
  is_var IdP p -> Bool
_ GenLocated l (HsExpr p)
_ = Bool
False

  is_return :: GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_return = (IdP GhcRn -> Bool)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
forall {p} {l} {l}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p),
 XRec p (IdP p) ~ GenLocated l (IdP p)) =>
(IdP p -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var (\IdP GhcRn
n -> IdP GhcRn
Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== MonadNames -> Name
return_name MonadNames
monad_names
                         Bool -> Bool -> Bool
|| IdP GhcRn
Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== MonadNames -> Name
pure_name MonadNames
monad_names)
  to_pure :: GenLocated l e -> e -> GenLocated l e
to_pure (L l
loc e
_) e
pure_expr = l -> e -> GenLocated l e
forall l e. l -> e -> GenLocated l e
L l
loc e
pure_expr
  is_dollar :: GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
is_dollar = (IdP GhcRn -> Bool)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Bool
forall {p} {l} {l}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p),
 XRec p (IdP p) ~ GenLocated l (IdP p)) =>
(IdP p -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var (IdP GhcRn -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
dollarIdKey)

{-
************************************************************************
*                                                                      *
\subsubsection{Errors}
*                                                                      *
************************************************************************
-}

checkEmptyStmts :: HsStmtContext GhcRn -> RnM ()
-- We've seen an empty sequence of Stmts... is that ok?
checkEmptyStmts :: HsStmtContext GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkEmptyStmts HsStmtContext GhcRn
ctxt
  = (EmptyStatementGroupErrReason -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> Maybe EmptyStatementGroupErrReason
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (EmptyStatementGroupErrReason -> TcRnMessage)
-> EmptyStatementGroupErrReason
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmptyStatementGroupErrReason -> TcRnMessage
TcRnEmptyStmtsGroup) Maybe EmptyStatementGroupErrReason
mb_err
  where
    mb_err :: Maybe EmptyStatementGroupErrReason
mb_err = case HsStmtContext GhcRn
ctxt of
      PatGuard {}      -> Maybe EmptyStatementGroupErrReason
forall a. Maybe a
Nothing -- Pattern guards can be empty
      ParStmtCtxt {}   -> EmptyStatementGroupErrReason -> Maybe EmptyStatementGroupErrReason
forall a. a -> Maybe a
Just EmptyStatementGroupErrReason
EmptyStmtsGroupInParallelComp
      TransStmtCtxt {} -> EmptyStatementGroupErrReason -> Maybe EmptyStatementGroupErrReason
forall a. a -> Maybe a
Just EmptyStatementGroupErrReason
EmptyStmtsGroupInTransformListComp
      HsDoStmt HsDoFlavour
flav    -> EmptyStatementGroupErrReason -> Maybe EmptyStatementGroupErrReason
forall a. a -> Maybe a
Just (EmptyStatementGroupErrReason
 -> Maybe EmptyStatementGroupErrReason)
-> EmptyStatementGroupErrReason
-> Maybe EmptyStatementGroupErrReason
forall a b. (a -> b) -> a -> b
$ HsDoFlavour -> EmptyStatementGroupErrReason
EmptyStmtsGroupInDoNotation HsDoFlavour
flav
      HsStmtContext GhcRn
ArrowExpr        -> EmptyStatementGroupErrReason -> Maybe EmptyStatementGroupErrReason
forall a. a -> Maybe a
Just EmptyStatementGroupErrReason
EmptyStmtsGroupInArrowNotation

----------------------
checkLastStmt :: AnnoBody body
              => HsStmtContext GhcRn
              -> LStmt GhcPs (LocatedA (body GhcPs))
              -> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
checkLastStmt :: forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
checkLastStmt HsStmtContext GhcRn
ctxt lstmt :: LStmt GhcPs (LocatedA (body GhcPs))
lstmt@(L SrcSpanAnnA
loc StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
stmt)
  = case HsStmtContext GhcRn
ctxt of
      HsDoStmt HsDoFlavour
ListComp  -> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_comp
      HsDoStmt HsDoFlavour
MonadComp -> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_comp
      HsDoStmt DoExpr{}  -> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_do
      HsDoStmt MDoExpr{} -> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_do
      HsStmtContext GhcRn
ArrowExpr -> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_do
      HsStmtContext GhcRn
_         -> RnM (LStmt GhcPs (LocatedA (body GhcPs)))
IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_other
  where
    check_do :: IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_do    -- Expect BodyStmt, and change it to LastStmt
      = case StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
stmt of
          BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LocatedA (body GhcPs)
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LocatedA (body GhcPs) -> StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
LocatedA (bodyR (GhcPass idR))
-> StmtLR
     (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkLastStmt LocatedA (body GhcPs)
e))
          LastStmt {}      -> GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
lstmt   -- "Deriving" clauses may generate a
                                             -- LastStmt directly (unlike the parser)
          StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
_                -> do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ HsStmtContext GhcRn -> UnexpectedStatement -> TcRnMessage
TcRnLastStmtNotExpr HsStmtContext GhcRn
ctxt
                                          (UnexpectedStatement -> TcRnMessage)
-> UnexpectedStatement -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ StmtLR GhcPs GhcPs (LocatedA (body GhcPs)) -> UnexpectedStatement
forall body.
Outputable (StmtLR GhcPs GhcPs body) =>
StmtLR GhcPs GhcPs body -> UnexpectedStatement
UnexpectedStatement StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
stmt
                                 ; GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
lstmt }


    check_comp :: IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_comp  -- Expect LastStmt; this should be enforced by the parser!
      = case StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
stmt of
          LastStmt {} -> GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
lstmt
          StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
_           -> String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"checkLastStmt" (GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
lstmt)

    check_other :: IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
check_other -- Behave just as if this wasn't the last stmt
      = do { HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkStmt HsStmtContext GhcRn
ctxt LStmt GhcPs (LocatedA (body GhcPs))
lstmt; GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return LStmt GhcPs (LocatedA (body GhcPs))
GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
lstmt }

-- Checking when a particular Stmt is ok
checkStmt :: AnnoBody body
          => HsStmtContext GhcRn
          -> LStmt GhcPs (LocatedA (body GhcPs))
          -> RnM ()
checkStmt :: forall (body :: * -> *).
AnnoBody body =>
HsStmtContext GhcRn
-> LStmt GhcPs (LocatedA (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkStmt HsStmtContext GhcRn
ctxt (L SrcSpanAnnA
_ StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
stmt)
  = do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; case DynFlags
-> HsStmtContext GhcRn
-> StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
stmt of
           Validity' (Maybe Extension)
IsValid      -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           NotValid Maybe Extension
ext -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
              HsStmtContext GhcRn
-> UnexpectedStatement -> Maybe Extension -> TcRnMessage
TcRnUnexpectedStatementInContext
                HsStmtContext GhcRn
ctxt (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)) -> UnexpectedStatement
forall body.
Outputable (StmtLR GhcPs GhcPs body) =>
StmtLR GhcPs GhcPs body -> UnexpectedStatement
UnexpectedStatement StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
stmt) Maybe Extension
ext }

------------
emptyInvalid :: Validity' (Maybe LangExt.Extension)
emptyInvalid :: Validity' (Maybe Extension)
emptyInvalid = Maybe Extension -> Validity' (Maybe Extension)
forall a. a -> Validity' a
NotValid Maybe Extension
forall a. Maybe a
Nothing -- Invalid, and no extension to suggest

okStmt, okDoStmt, okCompStmt, okParStmt
   :: DynFlags -> HsStmtContext GhcRn
   -> Stmt GhcPs (LocatedA (body GhcPs)) -> Validity' (Maybe LangExt.Extension)
-- Return Nothing if OK, (Just extra) if not ok
-- The "extra" is an SDoc that is appended to a generic error message

okStmt :: forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
  = case HsStmtContext GhcRn
ctxt of
      PatGuard {}        -> Stmt GhcPs (LocatedA (body GhcPs)) -> Validity' (Maybe Extension)
forall (body :: * -> *).
Stmt GhcPs (LocatedA (body GhcPs)) -> Validity' (Maybe Extension)
okPatGuardStmt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      ParStmtCtxt HsStmtContext GhcRn
ctxt   -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okParStmt  DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      HsDoStmt HsDoFlavour
flavour   -> DynFlags
-> HsDoFlavour
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsDoFlavour
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okDoFlavourStmt DynFlags
dflags HsDoFlavour
flavour HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      HsStmtContext GhcRn
ArrowExpr          -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okDoStmt   DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      TransStmtCtxt HsStmtContext GhcRn
ctxt -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt

okDoFlavourStmt
  :: DynFlags -> HsDoFlavour -> HsStmtContext GhcRn
  -> Stmt GhcPs (LocatedA (body GhcPs)) -> Validity' (Maybe LangExt.Extension)
okDoFlavourStmt :: forall (body :: * -> *).
DynFlags
-> HsDoFlavour
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okDoFlavourStmt DynFlags
dflags HsDoFlavour
flavour HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt = case HsDoFlavour
flavour of
      DoExpr{}     -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okDoStmt   DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      MDoExpr{}    -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okDoStmt   DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      HsDoFlavour
GhciStmtCtxt -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okDoStmt   DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      HsDoFlavour
ListComp     -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okCompStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
      HsDoFlavour
MonadComp    -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okCompStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt

-------------
okPatGuardStmt :: Stmt GhcPs (LocatedA (body GhcPs)) -> Validity' (Maybe LangExt.Extension)
okPatGuardStmt :: forall (body :: * -> *).
Stmt GhcPs (LocatedA (body GhcPs)) -> Validity' (Maybe Extension)
okPatGuardStmt Stmt GhcPs (LocatedA (body GhcPs))
stmt
  = case Stmt GhcPs (LocatedA (body GhcPs))
stmt of
      BodyStmt {} -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
      BindStmt {} -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
      LetStmt {}  -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
      Stmt GhcPs (LocatedA (body GhcPs))
_           -> Validity' (Maybe Extension)
emptyInvalid

-------------
okParStmt :: forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okParStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
  = case Stmt GhcPs (LocatedA (body GhcPs))
stmt of
      LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ (HsIPBinds {}) -> Validity' (Maybe Extension)
emptyInvalid
      Stmt GhcPs (LocatedA (body GhcPs))
_                        -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt

----------------
okDoStmt :: forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okDoStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (LocatedA (body GhcPs))
stmt
  = case Stmt GhcPs (LocatedA (body GhcPs))
stmt of
       RecStmt {}
         | Extension
LangExt.RecursiveDo Extension -> DynFlags -> Bool
`xopt` DynFlags
dflags -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
         | HsStmtContext GhcRn
ArrowExpr <- HsStmtContext GhcRn
ctxt -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid    -- Arrows allows 'rec'
         | Bool
otherwise         -> Maybe Extension -> Validity' (Maybe Extension)
forall a. a -> Validity' a
NotValid (Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LangExt.RecursiveDo)
       BindStmt {} -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
       LetStmt {}  -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
       BodyStmt {} -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
       Stmt GhcPs (LocatedA (body GhcPs))
_           -> Validity' (Maybe Extension)
emptyInvalid

----------------
okCompStmt :: forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (LocatedA (body GhcPs))
-> Validity' (Maybe Extension)
okCompStmt DynFlags
dflags HsStmtContext GhcRn
_ Stmt GhcPs (LocatedA (body GhcPs))
stmt
  = case Stmt GhcPs (LocatedA (body GhcPs))
stmt of
       BindStmt {} -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
       LetStmt {}  -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
       BodyStmt {} -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
       ParStmt {}
         | Extension
LangExt.ParallelListComp Extension -> DynFlags -> Bool
`xopt` DynFlags
dflags -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
         | Bool
otherwise -> Maybe Extension -> Validity' (Maybe Extension)
forall a. a -> Validity' a
NotValid (Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LangExt.ParallelListComp)
       TransStmt {}
         | Extension
LangExt.TransformListComp Extension -> DynFlags -> Bool
`xopt` DynFlags
dflags -> Validity' (Maybe Extension)
forall a. Validity' a
IsValid
         | Bool
otherwise -> Maybe Extension -> Validity' (Maybe Extension)
forall a. a -> Validity' a
NotValid (Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LangExt.TransformListComp)
       RecStmt {}  -> Validity' (Maybe Extension)
emptyInvalid
       LastStmt {} -> Validity' (Maybe Extension)
emptyInvalid  -- Should not happen (dealt with by checkLastStmt)
       ApplicativeStmt {} -> Validity' (Maybe Extension)
emptyInvalid

---------
checkTupleSection :: [HsTupArg GhcPs] -> RnM ()
checkTupleSection :: [HsTupArg GhcPs] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupleSection [HsTupArg GhcPs]
args
  = do  { Bool
tuple_section <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TupleSections
        ; Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr ((HsTupArg GhcPs -> Bool) -> [HsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all HsTupArg GhcPs -> Bool
forall (p :: Pass). HsTupArg (GhcPass p) -> Bool
tupArgPresent [HsTupArg GhcPs]
args Bool -> Bool -> Bool
|| Bool
tuple_section) TcRnMessage
msg }
  where
    msg :: TcRnMessage
    msg :: TcRnMessage
msg = TcRnMessage
TcRnIllegalTupleSection

---------
sectionErr :: HsExpr GhcPs -> TcRnMessage
sectionErr :: HsExpr GhcPs -> TcRnMessage
sectionErr = HsExpr GhcPs -> TcRnMessage
TcRnSectionWithoutParentheses

badIpBinds :: Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs) -> TcRnMessage
badIpBinds :: Either (HsLocalBinds GhcPs) (HsLocalBindsLR GhcRn GhcPs)
-> TcRnMessage
badIpBinds = Either (HsLocalBinds GhcPs) (HsLocalBindsLR GhcRn GhcPs)
-> TcRnMessage
TcRnIllegalImplicitParameterBindings

---------

monadFailOp :: LPat GhcPs
            -> HsStmtContext GhcRn
            -> RnM (FailOperator GhcRn, FreeVars)
monadFailOp :: LPat GhcPs
-> HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
monadFailOp LPat GhcPs
pat HsStmtContext GhcRn
ctxt = do
    DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        -- If the pattern is irrefutable (e.g.: wildcard, tuple, ~pat, etc.)
        -- we should not need to fail.
    if | DynFlags -> LPat GhcPs -> Bool
forall (p :: Pass).
OutputableBndrId p =>
DynFlags -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat DynFlags
dflags LPat GhcPs
pat -> (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SyntaxExprRn
forall a. Maybe a
Nothing, FreeVars
emptyFVs)

        -- For non-monadic contexts (e.g. guard patterns, list
        -- comprehensions, etc.) we should not need to fail, or failure is handled in
        -- a different way. See Note [Failing pattern matches in Stmts].
       | Bool -> Bool
not (HsStmtContext GhcRn -> Bool
forall id. HsStmtContext id -> Bool
isMonadStmtContext HsStmtContext GhcRn
ctxt) -> (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SyntaxExprRn
forall a. Maybe a
Nothing, FreeVars
emptyFVs)

       | Bool
otherwise -> HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
forall p.
HsStmtContext p -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
getMonadFailOp HsStmtContext GhcRn
ctxt

{-
Note [Monad fail : Rebindable syntax, overloaded strings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Given the code
  foo x = do { Just y <- x; return y }

we expect it to desugar as
  foo x = x >>= \r -> case r of
                        Just y  -> return y
                        Nothing -> fail "Pattern match error"

But with RebindableSyntax and OverloadedStrings, we really want
it to desugar thus:
  foo x = x >>= \r -> case r of
                        Just y  -> return y
                        Nothing -> fail (fromString "Patterm match error")

So, in this case, we synthesize the function
  \x -> fail (fromString x)

(rather than plain 'fail') for the 'fail' operation. This is done in
'getMonadFailOp'.

Similarly with QualifiedDo and OverloadedStrings, we also want to desugar
using fromString:

  foo x = M.do { Just y <- x; return y }

  ===>

  foo x = x M.>>= \r -> case r of
                        Just y  -> return y
                        Nothing -> M.fail (fromString "Pattern match error")

-}
getMonadFailOp :: HsStmtContext p -> RnM (FailOperator GhcRn, FreeVars) -- Syntax expr fail op
getMonadFailOp :: forall p.
HsStmtContext p -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
getMonadFailOp HsStmtContext p
ctxt
 = do { Bool
xOverloadedStrings <- (DynFlags -> Bool)
-> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
-> TcRnIf TcGblEnv TcLclEnv Bool
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extension -> DynFlags -> Bool
xopt Extension
LangExt.OverloadedStrings) IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      ; Bool
xRebindableSyntax <- (DynFlags -> Bool)
-> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
-> TcRnIf TcGblEnv TcLclEnv Bool
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extension -> DynFlags -> Bool
xopt Extension
LangExt.RebindableSyntax) IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      ; (SyntaxExprRn
fail, FreeVars
fvs) <- Bool
-> Bool -> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
reallyGetMonadFailOp Bool
xRebindableSyntax Bool
xOverloadedStrings
      ; (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn -> Maybe SyntaxExprRn
forall a. a -> Maybe a
Just SyntaxExprRn
fail, FreeVars
fvs)
      }
  where
    isQualifiedDo :: Bool
isQualifiedDo = Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isJust (HsStmtContext p -> Maybe ModuleName
forall p. HsStmtContext p -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext p
ctxt)

    reallyGetMonadFailOp :: Bool
-> Bool -> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
reallyGetMonadFailOp Bool
rebindableSyntax Bool
overloadedStrings
      | (Bool
isQualifiedDo Bool -> Bool -> Bool
|| Bool
rebindableSyntax) Bool -> Bool -> Bool
&& Bool
overloadedStrings = do
        (HsExpr GhcRn
failExpr, FreeVars
failFvs) <- HsStmtContext p -> Name -> TcM (HsExpr GhcRn, FreeVars)
forall p. HsStmtContext p -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr HsStmtContext p
ctxt Name
failMName
        (HsExpr GhcRn
fromStringExpr, FreeVars
fromStringFvs) <- Name -> TcM (HsExpr GhcRn, FreeVars)
lookupSyntaxExpr Name
fromStringName
        let arg_lit :: OccName
arg_lit = FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"arg")
        Name
arg_name <- OccName -> RnM Name
forall gbl lcl. OccName -> TcRnIf gbl lcl Name
newSysName OccName
arg_lit
        let arg_syn_expr :: XRec GhcRn (HsExpr GhcRn)
arg_syn_expr = IdP GhcRn -> XRec GhcRn (HsExpr GhcRn)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP GhcRn
Name
arg_name
            XRec GhcRn (HsExpr GhcRn)
body :: LHsExpr GhcRn =
              XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn) -> XRec GhcRn (HsExpr GhcRn)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
noLocA HsExpr GhcRn
failExpr)
                      (XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn) -> XRec GhcRn (HsExpr GhcRn)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcRn
fromStringExpr) XRec GhcRn (HsExpr GhcRn)
arg_syn_expr)
        let HsExpr GhcRn
failAfterFromStringExpr :: HsExpr GhcRn =
              GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ [LPat GhcRn]
-> XRec GhcRn (HsExpr GhcRn) -> XRec GhcRn (HsExpr GhcRn)
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam [Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn))
-> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcRn -> XRec GhcRn (IdP GhcRn) -> Pat GhcRn
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcRn
NoExtField
noExtField (XRec GhcRn (IdP GhcRn) -> Pat GhcRn)
-> XRec GhcRn (IdP GhcRn) -> Pat GhcRn
forall a b. (a -> b) -> a -> b
$ Name -> GenLocated SrcSpanAnnN Name
forall a an. a -> LocatedAn an a
noLocA Name
arg_name] XRec GhcRn (HsExpr GhcRn)
body
        let SyntaxExpr GhcRn
failAfterFromStringSynExpr :: SyntaxExpr GhcRn =
              HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr HsExpr GhcRn
failAfterFromStringExpr
        (SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExpr GhcRn
SyntaxExprRn
failAfterFromStringSynExpr, FreeVars
failFvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fromStringFvs)
      | Bool
otherwise = HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext p
ctxt Name
failMName


{- *********************************************************************
*                                                                      *
              Generating code for HsExpanded
      See Note [Handling overloaded and rebindable constructs]
*                                                                      *
********************************************************************* -}

-- | Build a 'HsExpansion' out of an extension constructor,
--   and the two components of the expansion: original and
--   desugared expressions.
mkExpandedExpr
  :: HsExpr GhcRn           -- ^ source expression
  -> HsExpr GhcRn           -- ^ expanded expression
  -> HsExpr GhcRn           -- ^ suitably wrapped 'HsExpansion'
mkExpandedExpr :: HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedExpr HsExpr GhcRn
a HsExpr GhcRn
b = XXExpr GhcRn -> HsExpr GhcRn
forall p. XXExpr p -> HsExpr p
XExpr (HsExpr GhcRn
-> HsExpr GhcRn -> HsExpansion (HsExpr GhcRn) (HsExpr GhcRn)
forall orig expanded. orig -> expanded -> HsExpansion orig expanded
HsExpanded HsExpr GhcRn
a HsExpr GhcRn
b)

-----------------------------------------
-- Bits and pieces for RecordDotSyntax.
--
-- See Note [Overview of record dot syntax] in GHC.Hs.Expr.

-- mkGetField arg field calculates a get_field @field arg expression.
-- e.g. z.x = mkGetField z x = get_field @x z
mkGetField :: Name -> LHsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
mkGetField :: Name
-> XRec GhcRn (HsExpr GhcRn)
-> LocatedAn NoEpAnns FieldLabelString
-> HsExpr GhcRn
mkGetField Name
get_field XRec GhcRn (HsExpr GhcRn)
arg LocatedAn NoEpAnns FieldLabelString
field = GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc ([XRec GhcRn (HsExpr GhcRn)] -> XRec GhcRn (HsExpr GhcRn)
forall a. HasCallStack => [a] -> a
head ([XRec GhcRn (HsExpr GhcRn)] -> XRec GhcRn (HsExpr GhcRn))
-> [XRec GhcRn (HsExpr GhcRn)] -> XRec GhcRn (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Name
-> [XRec GhcRn (HsExpr GhcRn)]
-> LocatedAn NoEpAnns FieldLabelString
-> [XRec GhcRn (HsExpr GhcRn)]
mkGet Name
get_field [XRec GhcRn (HsExpr GhcRn)
arg] LocatedAn NoEpAnns FieldLabelString
field)

-- mkSetField a field b calculates a set_field @field expression.
-- e.g mkSetSetField a field b = set_field @"field" a b (read as "set field 'field' on a to b").
mkSetField :: Name -> LHsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> LHsExpr GhcRn -> HsExpr GhcRn
mkSetField :: Name
-> XRec GhcRn (HsExpr GhcRn)
-> LocatedAn NoEpAnns FieldLabelString
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
mkSetField Name
set_field XRec GhcRn (HsExpr GhcRn)
a (L SrcAnn NoEpAnns
_ (FieldLabelString FastString
field)) XRec GhcRn (HsExpr GhcRn)
b =
  HsExpr GhcRn -> XRec GhcRn (HsExpr GhcRn) -> HsExpr GhcRn
genHsApp (HsExpr GhcRn -> XRec GhcRn (HsExpr GhcRn) -> HsExpr GhcRn
genHsApp (Name -> HsExpr GhcRn
genHsVar Name
set_field HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
`genAppType` FastString -> HsType GhcRn
genHsTyLit FastString
field)  XRec GhcRn (HsExpr GhcRn)
a) XRec GhcRn (HsExpr GhcRn)
b

mkGet :: Name -> [LHsExpr GhcRn] -> LocatedAn NoEpAnns FieldLabelString -> [LHsExpr GhcRn]
mkGet :: Name
-> [XRec GhcRn (HsExpr GhcRn)]
-> LocatedAn NoEpAnns FieldLabelString
-> [XRec GhcRn (HsExpr GhcRn)]
mkGet Name
get_field l :: [XRec GhcRn (HsExpr GhcRn)]
l@(XRec GhcRn (HsExpr GhcRn)
r : [XRec GhcRn (HsExpr GhcRn)]
_) (L SrcAnn NoEpAnns
_ (FieldLabelString FastString
field)) =
  HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (HsExpr GhcRn -> XRec GhcRn (HsExpr GhcRn) -> HsExpr GhcRn
genHsApp (Name -> HsExpr GhcRn
genHsVar Name
get_field HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
`genAppType` FastString -> HsType GhcRn
genHsTyLit FastString
field) XRec GhcRn (HsExpr GhcRn)
r) GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
forall a. a -> [a] -> [a]
: [XRec GhcRn (HsExpr GhcRn)]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
l
mkGet Name
_ [] LocatedAn NoEpAnns FieldLabelString
_ = String -> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
forall a. HasCallStack => String -> a
panic String
"mkGet : The impossible has happened!"

mkSet :: Name -> LHsExpr GhcRn -> (LocatedAn NoEpAnns FieldLabelString, LHsExpr GhcRn) -> LHsExpr GhcRn
mkSet :: Name
-> XRec GhcRn (HsExpr GhcRn)
-> (LocatedAn NoEpAnns FieldLabelString, XRec GhcRn (HsExpr GhcRn))
-> XRec GhcRn (HsExpr GhcRn)
mkSet Name
set_field XRec GhcRn (HsExpr GhcRn)
acc (LocatedAn NoEpAnns FieldLabelString
field, XRec GhcRn (HsExpr GhcRn)
g) = HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (Name
-> XRec GhcRn (HsExpr GhcRn)
-> LocatedAn NoEpAnns FieldLabelString
-> XRec GhcRn (HsExpr GhcRn)
-> HsExpr GhcRn
mkSetField Name
set_field XRec GhcRn (HsExpr GhcRn)
g LocatedAn NoEpAnns FieldLabelString
field XRec GhcRn (HsExpr GhcRn)
acc)

-- mkProjection fields calculates a projection.
-- e.g. .x = mkProjection [x] = getField @"x"
--      .x.y = mkProjection [.x, .y] = (.y) . (.x) = getField @"y" . getField @"x"
mkProjection :: Name -> Name -> NonEmpty (LocatedAn NoEpAnns FieldLabelString) -> HsExpr GhcRn
mkProjection :: Name
-> Name
-> NonEmpty (LocatedAn NoEpAnns FieldLabelString)
-> HsExpr GhcRn
mkProjection Name
getFieldName Name
circName (LocatedAn NoEpAnns FieldLabelString
field :| [LocatedAn NoEpAnns FieldLabelString]
fields) = (HsExpr GhcRn
 -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn)
-> HsExpr GhcRn
-> [LocatedAn NoEpAnns FieldLabelString]
-> HsExpr GhcRn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
f (LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
proj LocatedAn NoEpAnns FieldLabelString
field) [LocatedAn NoEpAnns FieldLabelString]
fields
  where
    f :: HsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
    f :: HsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
f HsExpr GhcRn
acc LocatedAn NoEpAnns FieldLabelString
field = Name -> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
genHsApps Name
circName ([XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn)
-> [XRec GhcRn (HsExpr GhcRn)] -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [HsExpr GhcRn] -> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan [LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
proj LocatedAn NoEpAnns FieldLabelString
field, HsExpr GhcRn
acc]

    proj :: LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
    proj :: LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn
proj (L SrcAnn NoEpAnns
_ (FieldLabelString FastString
f)) = Name -> HsExpr GhcRn
genHsVar Name
getFieldName HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
`genAppType` FastString -> HsType GhcRn
genHsTyLit FastString
f

-- mkProjUpdateSetField calculates functions representing dot notation record updates.
-- e.g. Suppose an update like foo.bar = 1.
--      We calculate the function \a -> setField @"foo" a (setField @"bar" (getField @"foo" a) 1).
mkProjUpdateSetField :: Name -> Name -> LHsRecProj GhcRn (LHsExpr GhcRn) -> (LHsExpr GhcRn -> LHsExpr GhcRn)
mkProjUpdateSetField :: Name
-> Name
-> LHsRecUpdProj GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
mkProjUpdateSetField Name
get_field Name
set_field (L SrcSpanAnnA
_ (HsFieldBind { hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS = (L SrcAnn NoEpAnns
_ (FieldLabelStrings [XRec GhcRn (DotFieldOcc GhcRn)]
flds')), hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS = GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg } ))
  = let {
      ; flds :: [LocatedAn NoEpAnns FieldLabelString]
flds = (LocatedAn NoEpAnns (DotFieldOcc GhcRn)
 -> LocatedAn NoEpAnns FieldLabelString)
-> [LocatedAn NoEpAnns (DotFieldOcc GhcRn)]
-> [LocatedAn NoEpAnns FieldLabelString]
forall a b. (a -> b) -> [a] -> [b]
map ((DotFieldOcc GhcRn -> FieldLabelString)
-> LocatedAn NoEpAnns (DotFieldOcc GhcRn)
-> LocatedAn NoEpAnns FieldLabelString
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString)
-> (DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString)
-> DotFieldOcc GhcRn
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcRn -> XRec GhcRn FieldLabelString
DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel)) [XRec GhcRn (DotFieldOcc GhcRn)]
[LocatedAn NoEpAnns (DotFieldOcc GhcRn)]
flds'
      ; final :: LocatedAn NoEpAnns FieldLabelString
final = [LocatedAn NoEpAnns FieldLabelString]
-> LocatedAn NoEpAnns FieldLabelString
forall a. HasCallStack => [a] -> a
last [LocatedAn NoEpAnns FieldLabelString]
flds  -- quux
      ; fields :: [LocatedAn NoEpAnns FieldLabelString]
fields = [LocatedAn NoEpAnns FieldLabelString]
-> [LocatedAn NoEpAnns FieldLabelString]
forall a. HasCallStack => [a] -> [a]
init [LocatedAn NoEpAnns FieldLabelString]
flds   -- [foo, bar, baz]
      ; getters :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
getters = \GenLocated SrcSpanAnnA (HsExpr GhcRn)
a -> ([GenLocated SrcSpanAnnA (HsExpr GhcRn)]
 -> LocatedAn NoEpAnns FieldLabelString
 -> [GenLocated SrcSpanAnnA (HsExpr GhcRn)])
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> [LocatedAn NoEpAnns FieldLabelString]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Name
-> [XRec GhcRn (HsExpr GhcRn)]
-> LocatedAn NoEpAnns FieldLabelString
-> [XRec GhcRn (HsExpr GhcRn)]
mkGet Name
get_field) [GenLocated SrcSpanAnnA (HsExpr GhcRn)
a] [LocatedAn NoEpAnns FieldLabelString]
fields  -- Ordered from deep to shallow.
          -- [getField@"baz"(getField@"bar"(getField@"foo" a), getField@"bar"(getField@"foo" a), getField@"foo" a, a]
      ; zips :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [(LocatedAn NoEpAnns FieldLabelString,
     GenLocated SrcSpanAnnA (HsExpr GhcRn))]
zips = \GenLocated SrcSpanAnnA (HsExpr GhcRn)
a -> (LocatedAn NoEpAnns FieldLabelString
final, [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a. HasCallStack => [a] -> a
head (GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
getters GenLocated SrcSpanAnnA (HsExpr GhcRn)
a)) (LocatedAn NoEpAnns FieldLabelString,
 GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [(LocatedAn NoEpAnns FieldLabelString,
     GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> [(LocatedAn NoEpAnns FieldLabelString,
     GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall a. a -> [a] -> [a]
: [LocatedAn NoEpAnns FieldLabelString]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> [(LocatedAn NoEpAnns FieldLabelString,
     GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([LocatedAn NoEpAnns FieldLabelString]
-> [LocatedAn NoEpAnns FieldLabelString]
forall a. [a] -> [a]
reverse [LocatedAn NoEpAnns FieldLabelString]
fields) ([GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
forall a. HasCallStack => [a] -> [a]
tail (GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
getters GenLocated SrcSpanAnnA (HsExpr GhcRn)
a)) -- Ordered from deep to shallow.
          -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)]
      }
    in (\XRec GhcRn (HsExpr GhcRn)
a -> (GenLocated SrcSpanAnnA (HsExpr GhcRn)
 -> (LocatedAn NoEpAnns FieldLabelString,
     GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [(LocatedAn NoEpAnns FieldLabelString,
     GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Name
-> XRec GhcRn (HsExpr GhcRn)
-> (LocatedAn NoEpAnns FieldLabelString, XRec GhcRn (HsExpr GhcRn))
-> XRec GhcRn (HsExpr GhcRn)
mkSet Name
set_field) GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg (GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> [(LocatedAn NoEpAnns FieldLabelString,
     GenLocated SrcSpanAnnA (HsExpr GhcRn))]
zips XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
a))
          -- setField@"foo" (a) (setField@"bar" (getField @"foo" (a))(setField@"baz" (getField @"bar" (getField @"foo" (a)))(setField@"quux" (getField @"baz" (getField @"bar" (getField @"foo" (a))))(quux))))

mkRecordDotUpd :: Name -> Name -> LHsExpr GhcRn -> [LHsRecUpdProj GhcRn] -> HsExpr GhcRn
mkRecordDotUpd :: Name
-> Name
-> XRec GhcRn (HsExpr GhcRn)
-> [LHsRecUpdProj GhcRn]
-> HsExpr GhcRn
mkRecordDotUpd Name
get_field Name
set_field XRec GhcRn (HsExpr GhcRn)
exp [LHsRecUpdProj GhcRn]
updates = (HsExpr GhcRn
 -> GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> HsExpr GhcRn)
-> HsExpr GhcRn
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> HsExpr GhcRn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HsExpr GhcRn -> LHsRecUpdProj GhcRn -> HsExpr GhcRn
HsExpr GhcRn
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
        (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> HsExpr GhcRn
fieldUpdate (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (HsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
exp) [LHsRecUpdProj GhcRn]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
updates
  where
    fieldUpdate :: HsExpr GhcRn -> LHsRecUpdProj GhcRn -> HsExpr GhcRn
    fieldUpdate :: HsExpr GhcRn -> LHsRecUpdProj GhcRn -> HsExpr GhcRn
fieldUpdate HsExpr GhcRn
acc LHsRecUpdProj GhcRn
lpu =  GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ (Name
-> Name
-> LHsRecUpdProj GhcRn
-> XRec GhcRn (HsExpr GhcRn)
-> XRec GhcRn (HsExpr GhcRn)
mkProjUpdateSetField Name
get_field Name
set_field LHsRecUpdProj GhcRn
lpu) (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan HsExpr GhcRn
acc)

rnHsUpdProjs :: [LHsRecUpdProj GhcPs] -> RnM ([LHsRecUpdProj GhcRn], FreeVars)
rnHsUpdProjs :: [LHsRecUpdProj GhcPs] -> RnM ([LHsRecUpdProj GhcRn], FreeVars)
rnHsUpdProjs [LHsRecUpdProj GhcPs]
us = do
  ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
u, [FreeVars]
fvs) <- [(GenLocated
    SrcSpanAnnA
    (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
       (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)]
-> ([GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
          (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
    [FreeVars])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
        (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
   FreeVars)]
 -> ([GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
     [FreeVars]))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      [FreeVars])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars)]
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 LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars)
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
rnRecUpdProj [LHsRecUpdProj GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
us
  ([GenLocated
    SrcSpanAnnA
    (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
       (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
u, [FreeVars] -> FreeVars
plusFVs [FreeVars]
fvs)
  where
    rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars)
    rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars)
rnRecUpdProj (L SrcSpanAnnA
l (HsFieldBind XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs)
fs GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
pun))
      = do { (GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg, FreeVars
fv) <- LHsExpr GhcPs -> RnM (XRec GhcRn (HsExpr GhcRn), FreeVars)
rnLExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
           ; (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated
    SrcSpanAnnA
    (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
       (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
  FreeVars)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
       FreeVars))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
    FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
           (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      FreeVars)
forall a b. (a -> b) -> a -> b
$
               (SrcSpanAnnA
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
     (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
        (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind {
                         hfbAnn :: XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
hfbAnn = XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                       , hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn)
hfbLHS = (FieldLabelStrings GhcPs -> FieldLabelStrings GhcRn)
-> GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs)
-> GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcRn)
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldLabelStrings GhcPs -> FieldLabelStrings GhcRn
rnFieldLabelStrings GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs)
fs
                       , hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
hfbRHS = GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg
                       , hfbPun :: Bool
hfbPun = Bool
pun}), FreeVars
fv ) }