{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Tc.Deriv.Functor
( FFoldType(..)
, functorLikeTraverse
, deepSubtypesContaining
, foldDataConArgs
, gen_Functor_binds
, gen_Foldable_binds
, gen_Traversable_binds
)
where
import GHC.Prelude
import GHC.Data.Bag
import GHC.Core.DataCon
import GHC.Data.FastString
import GHC.Hs
import GHC.Utils.Panic
import GHC.Builtin.Names
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Utils.Monad.State
import GHC.Tc.Deriv.Generate
import GHC.Tc.Utils.TcType
import GHC.Core.TyCon
import GHC.Core.TyCo.Rep
import GHC.Core.Type
import GHC.Utils.Misc
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Id.Make (coerceId)
import GHC.Builtin.Types (true_RDR, false_RDR)
import Data.Maybe (catMaybes, isJust)
gen_Functor_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Functor_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Functor_binds SrcSpan
loc TyCon
tycon [Type]
_
| Role
Phantom <- [Role] -> Role
forall a. [a] -> a
last (TyCon -> [Role]
tyConRoles TyCon
tycon)
= (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
fmap_bind, BagDerivStuff
forall a. Bag a
emptyBag)
where
fmap_name :: GenLocated (SrcAnn NameAnn) RdrName
fmap_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
fmap_RDR
fmap_bind :: LHsBind GhcPs
fmap_bind = GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
mkRdrFunBind GenLocated (SrcAnn NameAnn) RdrName
fmap_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
fmap_eqns
fmap_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fmap_eqns = [HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan) =>
HsMatchContext (NoGhcTc (GhcPass p))
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext GhcPs
HsMatchContext (NoGhcTc GhcPs)
fmap_match_ctxt
[LPat GhcPs
nlWildPat]
GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
coerce_Expr]
fmap_match_ctxt :: HsMatchContext GhcPs
fmap_match_ctxt = LIdP GhcPs -> HsMatchContext GhcPs
forall p. LIdP p -> HsMatchContext p
mkPrefixFunRhs GenLocated (SrcAnn NameAnn) RdrName
LIdP GhcPs
fmap_name
gen_Functor_binds SrcSpan
loc TyCon
tycon [Type]
tycon_args
= ([GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. [a] -> Bag a
listToBag [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
fmap_bind, GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
replace_bind], BagDerivStuff
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
fmap_name :: GenLocated (SrcAnn NameAnn) RdrName
fmap_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
fmap_RDR
fmap_bind :: LHsBind GhcPs
fmap_bind = Arity
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsBind GhcPs
mkRdrFunBindEC Arity
2 LHsExpr GhcPs -> LHsExpr GhcPs
forall a. a -> a
id GenLocated (SrcAnn NameAnn) RdrName
fmap_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
fmap_eqns
fmap_match_ctxt :: HsMatchContext GhcPs
fmap_match_ctxt = LIdP GhcPs -> HsMatchContext GhcPs
forall p. LIdP p -> HsMatchContext p
mkPrefixFunRhs GenLocated (SrcAnn NameAnn) RdrName
LIdP GhcPs
fmap_name
fmap_eqn :: DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
fmap_eqn DataCon
con = (State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall s a. State s a -> s -> a
evalState [RdrName]
bs_RDRs (State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$
HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con HsMatchContext GhcPs
fmap_match_ctxt [LPat GhcPs
f_Pat] DataCon
con [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)]
parts
where
parts :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts = FFoldType
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> DataCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. FFoldType a -> DataCon -> [a]
foldDataConArgs FFoldType
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_fmap DataCon
con
fmap_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fmap_eqns = (DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
fmap_eqn [DataCon]
data_cons
ft_fmap :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_fmap :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_fmap = FT :: forall a.
a
-> a
-> a
-> (a -> a -> a)
-> (TyCon -> [a] -> a)
-> (Type -> Type -> a -> a)
-> a
-> (TcTyVar -> a -> a)
-> FFoldType a
FT { ft_triv :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_triv = \GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
, ft_var :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_var = \GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr GhcPs
f_Expr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x
, ft_fun :: (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_fun = \GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
h GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam ((LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs))
-> (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
b -> do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
gg <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
b
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
h (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
gg
, ft_tup :: TyCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_tup = ([LPat GhcPs]
-> DataCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs)
forall (m :: * -> *) a.
Monad m =>
([LPat GhcPs]
-> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase (HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con HsMatchContext GhcPs
forall p. HsMatchContext p
CaseAlt)
, ft_ty_app :: Type
-> Type
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_ty_app = \Type
_ Type
arg_ty GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
x ->
if Type -> Bool
tcIsTyVarTy Type
arg_ty
then GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
fmap_RDR [LHsExpr GhcPs
f_Expr,GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x]
else do GenLocated SrcSpanAnnA (HsExpr GhcPs)
gg <- (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)
g
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
fmap_RDR [GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
gg,GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x]
, ft_forall :: TcTyVar
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_forall = \TcTyVar
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
, ft_bad_app :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_bad_app = String
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. String -> a
panic String
"in other argument in ft_fmap"
, ft_co_var :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_co_var = String
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. String -> a
panic String
"contravariant in ft_fmap" }
replace_name :: GenLocated (SrcAnn NameAnn) RdrName
replace_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
replace_RDR
replace_bind :: LHsBind GhcPs
replace_bind = Arity
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsBind GhcPs
mkRdrFunBindEC Arity
2 LHsExpr GhcPs -> LHsExpr GhcPs
forall a. a -> a
id GenLocated (SrcAnn NameAnn) RdrName
replace_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
replace_eqns
replace_match_ctxt :: HsMatchContext GhcPs
replace_match_ctxt = LIdP GhcPs -> HsMatchContext GhcPs
forall p. LIdP p -> HsMatchContext p
mkPrefixFunRhs GenLocated (SrcAnn NameAnn) RdrName
LIdP GhcPs
replace_name
replace_eqn :: DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
replace_eqn DataCon
con = (State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall s a. State s a -> s -> a
evalState [RdrName]
bs_RDRs (State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$
HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con HsMatchContext GhcPs
replace_match_ctxt [LPat GhcPs
z_Pat] DataCon
con [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)]
parts
where
parts :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts = FFoldType
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> DataCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. FFoldType a -> DataCon -> [a]
foldDataConArgs FFoldType
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_replace DataCon
con
replace_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
replace_eqns = (DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
replace_eqn [DataCon]
data_cons
ft_replace :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_replace :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_replace = FT :: forall a.
a
-> a
-> a
-> (a -> a -> a)
-> (TyCon -> [a] -> a)
-> (Type -> Type -> a -> a)
-> a
-> (TcTyVar -> a -> a)
-> FFoldType a
FT { ft_triv :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_triv = \GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
, ft_var :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_var = \GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
z_Expr
, ft_fun :: (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_fun = \GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
h GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam ((LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs))
-> (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
b -> do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
gg <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
b
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
h (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
gg
, ft_tup :: TyCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_tup = ([LPat GhcPs]
-> DataCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs)
forall (m :: * -> *) a.
Monad m =>
([LPat GhcPs]
-> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase (HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con HsMatchContext GhcPs
forall p. HsMatchContext p
CaseAlt)
, ft_ty_app :: Type
-> Type
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_ty_app = \Type
_ Type
arg_ty GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
x ->
if Type -> Bool
tcIsTyVarTy Type
arg_ty
then GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
replace_RDR [LHsExpr GhcPs
z_Expr,GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x]
else do GenLocated SrcSpanAnnA (HsExpr GhcPs)
gg <- (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)
g
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
fmap_RDR [GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
gg,GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x]
, ft_forall :: TcTyVar
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_forall = \TcTyVar
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
, ft_bad_app :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_bad_app = String
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. String -> a
panic String
"in other argument in ft_replace"
, ft_co_var :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ft_co_var = String
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. String -> a
panic String
"contravariant in ft_replace" }
match_for_con :: Monad m
=> HsMatchContext GhcPs
-> [LPat GhcPs] -> DataCon
-> [LHsExpr GhcPs -> m (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con :: HsMatchContext GhcPs
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con HsMatchContext GhcPs
ctxt = HsMatchContext GhcPs
-> (RdrName
-> [m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a.
Monad m =>
HsMatchContext GhcPs
-> (RdrName -> [a] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> a]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch HsMatchContext GhcPs
ctxt ((RdrName
-> [m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> m (LMatch GhcPs (LHsExpr GhcPs)))
-> (RdrName
-> [m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$
\RdrName
con_name [m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
xsM -> do [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs <- [m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> m [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [m (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
xsM
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
con_name [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
xs
data FFoldType a
= FT { FFoldType a -> a
ft_triv :: a
, FFoldType a -> a
ft_var :: a
, FFoldType a -> a
ft_co_var :: a
, FFoldType a -> a -> a -> a
ft_fun :: a -> a -> a
, FFoldType a -> TyCon -> [a] -> a
ft_tup :: TyCon -> [a] -> a
, FFoldType a -> Type -> Type -> a -> a
ft_ty_app :: Type -> Type -> a -> a
, FFoldType a -> a
ft_bad_app :: a
, FFoldType a -> TcTyVar -> a -> a
ft_forall :: TcTyVar -> a -> a
}
functorLikeTraverse :: forall a.
TyVar
-> FFoldType a
-> Type
-> a
functorLikeTraverse :: TcTyVar -> FFoldType a -> Type -> a
functorLikeTraverse TcTyVar
var (FT { ft_triv :: forall a. FFoldType a -> a
ft_triv = a
caseTrivial, ft_var :: forall a. FFoldType a -> a
ft_var = a
caseVar
, ft_co_var :: forall a. FFoldType a -> a
ft_co_var = a
caseCoVar, ft_fun :: forall a. FFoldType a -> a -> a -> a
ft_fun = a -> a -> a
caseFun
, ft_tup :: forall a. FFoldType a -> TyCon -> [a] -> a
ft_tup = TyCon -> [a] -> a
caseTuple, ft_ty_app :: forall a. FFoldType a -> Type -> Type -> a -> a
ft_ty_app = Type -> Type -> a -> a
caseTyApp
, ft_bad_app :: forall a. FFoldType a -> a
ft_bad_app = a
caseWrongArg, ft_forall :: forall a. FFoldType a -> TcTyVar -> a -> a
ft_forall = TcTyVar -> a -> a
caseForAll })
Type
ty
= (a, Bool) -> a
forall a b. (a, b) -> a
fst (Bool -> Type -> (a, Bool)
go Bool
False Type
ty)
where
go :: Bool
-> Type
-> (a, Bool)
go :: Bool -> Type -> (a, Bool)
go Bool
co Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Bool -> Type -> (a, Bool)
go Bool
co Type
ty'
go Bool
co (TyVarTy TcTyVar
v) | TcTyVar
v TcTyVar -> TcTyVar -> Bool
forall a. Eq a => a -> a -> Bool
== TcTyVar
var = (if Bool
co then a
caseCoVar else a
caseVar,Bool
True)
go Bool
co (FunTy { ft_arg :: Type -> Type
ft_arg = Type
x, ft_res :: Type -> Type
ft_res = Type
y, ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af })
| AnonArgFlag
InvisArg <- AnonArgFlag
af = Bool -> Type -> (a, Bool)
go Bool
co Type
y
| Bool
xc Bool -> Bool -> Bool
|| Bool
yc = (a -> a -> a
caseFun a
xr a
yr,Bool
True)
where (a
xr,Bool
xc) = Bool -> Type -> (a, Bool)
go (Bool -> Bool
not Bool
co) Type
x
(a
yr,Bool
yc) = Bool -> Type -> (a, Bool)
go Bool
co Type
y
go Bool
co (AppTy Type
x Type
y) | Bool
xc = (a
caseWrongArg, Bool
True)
| Bool
yc = (Type -> Type -> a -> a
caseTyApp Type
x Type
y a
yr, Bool
True)
where (a
_, Bool
xc) = Bool -> Type -> (a, Bool)
go Bool
co Type
x
(a
yr,Bool
yc) = Bool -> Type -> (a, Bool)
go Bool
co Type
y
go Bool
co ty :: Type
ty@(TyConApp TyCon
con [Type]
args)
| Bool -> Bool
not ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
xcs) = (a
caseTrivial, Bool
False)
| TyCon -> Bool
isTupleTyCon TyCon
con = (TyCon -> [a] -> a
caseTuple TyCon
con [a]
xrs, Bool
True)
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> [Bool]
forall a. [a] -> [a]
init [Bool]
xcs) = (a
caseWrongArg, Bool
True)
| Just (Type
fun_ty, Type
arg_ty) <- Type -> Maybe (Type, Type)
splitAppTy_maybe Type
ty
= (Type -> Type -> a -> a
caseTyApp Type
fun_ty Type
arg_ty ([a] -> a
forall a. [a] -> a
last [a]
xrs), Bool
True)
| Bool
otherwise = (a
caseWrongArg, Bool
True)
where
([a]
xrs,[Bool]
xcs) = [(a, Bool)] -> ([a], [Bool])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Type -> (a, Bool)) -> [Type] -> [(a, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Type -> (a, Bool)
go Bool
co) ([Type] -> [Type]
dropRuntimeRepArgs [Type]
args))
go Bool
co (ForAllTy (Bndr TcTyVar
v ArgFlag
vis) Type
x)
| ArgFlag -> Bool
isVisibleArgFlag ArgFlag
vis = String -> (a, Bool)
forall a. String -> a
panic String
"unexpected visible binder"
| TcTyVar
v TcTyVar -> TcTyVar -> Bool
forall a. Eq a => a -> a -> Bool
/= TcTyVar
var Bool -> Bool -> Bool
&& Bool
xc = (TcTyVar -> a -> a
caseForAll TcTyVar
v a
xr,Bool
True)
where (a
xr,Bool
xc) = Bool -> Type -> (a, Bool)
go Bool
co Type
x
go Bool
_ Type
_ = (a
caseTrivial,Bool
False)
deepSubtypesContaining :: TyVar -> Type -> [TcType]
deepSubtypesContaining :: TcTyVar -> Type -> [Type]
deepSubtypesContaining TcTyVar
tv
= TcTyVar -> FFoldType [Type] -> Type -> [Type]
forall a. TcTyVar -> FFoldType a -> Type -> a
functorLikeTraverse TcTyVar
tv
(FT :: forall a.
a
-> a
-> a
-> (a -> a -> a)
-> (TyCon -> [a] -> a)
-> (Type -> Type -> a -> a)
-> a
-> (TcTyVar -> a -> a)
-> FFoldType a
FT { ft_triv :: [Type]
ft_triv = []
, ft_var :: [Type]
ft_var = []
, ft_fun :: [Type] -> [Type] -> [Type]
ft_fun = [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
(++)
, ft_tup :: TyCon -> [[Type]] -> [Type]
ft_tup = \TyCon
_ [[Type]]
xs -> [[Type]] -> [Type]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Type]]
xs
, ft_ty_app :: Type -> Type -> [Type] -> [Type]
ft_ty_app = \Type
t Type
_ [Type]
ts -> Type
tType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
ts
, ft_bad_app :: [Type]
ft_bad_app = String -> [Type]
forall a. String -> a
panic String
"in other argument in deepSubtypesContaining"
, ft_co_var :: [Type]
ft_co_var = String -> [Type]
forall a. String -> a
panic String
"contravariant in deepSubtypesContaining"
, ft_forall :: TcTyVar -> [Type] -> [Type]
ft_forall = \TcTyVar
v [Type]
xs -> (Type -> Bool) -> [Type] -> [Type]
forall a. (a -> Bool) -> [a] -> [a]
filterOut ((TcTyVar
v TcTyVar -> VarSet -> Bool
`elemVarSet`) (VarSet -> Bool) -> (Type -> VarSet) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> VarSet
tyCoVarsOfType) [Type]
xs })
foldDataConArgs :: FFoldType a -> DataCon -> [a]
foldDataConArgs :: FFoldType a -> DataCon -> [a]
foldDataConArgs FFoldType a
ft DataCon
con
= (Type -> a) -> [Type] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Type -> a
foldArg ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
scaledThing ([Scaled Type] -> [Type]) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ DataCon -> [Scaled Type]
dataConOrigArgTys DataCon
con)
where
foldArg :: Type -> a
foldArg
= case Type -> Maybe TcTyVar
getTyVar_maybe ([Type] -> Type
forall a. [a] -> a
last (Type -> [Type]
tyConAppArgs (DataCon -> Type
dataConOrigResTy DataCon
con))) of
Just TcTyVar
tv -> TcTyVar -> FFoldType a -> Type -> a
forall a. TcTyVar -> FFoldType a -> Type -> a
functorLikeTraverse TcTyVar
tv FFoldType a
ft
Maybe TcTyVar
Nothing -> a -> Type -> a
forall a b. a -> b -> a
const (FFoldType a -> a
forall a. FFoldType a -> a
ft_triv FFoldType a
ft)
mkSimpleLam :: (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam :: (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)
lam =
State [RdrName] [RdrName]
forall s. State s s
get State [RdrName] [RdrName]
-> ([RdrName]
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
RdrName
n:[RdrName]
names -> do
[RdrName] -> State [RdrName] ()
forall s. s -> State s ()
put [RdrName]
names
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body <- LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)
lam (IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
n)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam [IdP GhcPs -> LPat GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat RdrName
IdP GhcPs
n] GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body)
[RdrName]
_ -> String -> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. String -> a
panic String
"mkSimpleLam"
mkSimpleLam2 :: (LHsExpr GhcPs -> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam2 :: (LHsExpr GhcPs -> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam2 LHsExpr GhcPs -> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)
lam =
State [RdrName] [RdrName]
forall s. State s s
get State [RdrName] [RdrName]
-> ([RdrName]
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
RdrName
n1:RdrName
n2:[RdrName]
names -> do
[RdrName] -> State [RdrName] ()
forall s. s -> State s ()
put [RdrName]
names
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body <- LHsExpr GhcPs -> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)
lam (IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
n1) (IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
n2)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam [IdP GhcPs -> LPat GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat RdrName
IdP GhcPs
n1,IdP GhcPs -> LPat GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat RdrName
IdP GhcPs
n2] GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body)
[RdrName]
_ -> String -> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. String -> a
panic String
"mkSimpleLam2"
mkSimpleConMatch :: Monad m => HsMatchContext GhcPs
-> (RdrName -> [a] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> a]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch :: HsMatchContext GhcPs
-> (RdrName -> [a] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> a]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch HsMatchContext GhcPs
ctxt RdrName -> [a] -> m (LHsExpr GhcPs)
fold [LPat GhcPs]
extra_pats DataCon
con [LHsExpr GhcPs -> a]
insides = do
let con_name :: RdrName
con_name = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
con
let vars_needed :: [RdrName]
vars_needed = [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a]
-> [RdrName] -> [RdrName]
forall b a. [b] -> [a] -> [a]
takeList [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a]
[LHsExpr GhcPs -> a]
insides [RdrName]
as_RDRs
let bare_pat :: LPat GhcPs
bare_pat = RdrName -> [RdrName] -> LPat GhcPs
nlConVarPat RdrName
con_name [RdrName]
vars_needed
let pat :: GenLocated SrcSpanAnnA (Pat GhcPs)
pat = if [RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RdrName]
vars_needed
then GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
bare_pat
else LPat GhcPs -> LPat GhcPs
forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
nlParPat LPat GhcPs
bare_pat
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs <- RdrName -> [a] -> m (LHsExpr GhcPs)
fold RdrName
con_name
(((GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a) -> RdrName -> a)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a] -> [RdrName] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a
i RdrName
v -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a
i (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a
forall a b. (a -> b) -> a -> b
$ IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
v) [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> a]
[LHsExpr GhcPs -> a]
insides [RdrName]
vars_needed)
GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> HsLocalBinds GhcPs
-> LMatch GhcPs (LHsExpr GhcPs)
forall (p :: Pass).
IsPass p =>
HsMatchContext (NoGhcTc (GhcPass p))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext GhcPs
HsMatchContext (NoGhcTc GhcPs)
ctxt ([GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
extra_pats [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (Pat GhcPs)
pat]) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
rhs HsLocalBinds GhcPs
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds
mkSimpleConMatch2 :: Monad m
=> HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs]
-> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch2 :: HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch2 HsMatchContext GhcPs
ctxt LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs)
fold [LPat GhcPs]
extra_pats DataCon
con [Maybe (LHsExpr GhcPs)]
insides = do
let con_name :: RdrName
con_name = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
con
vars_needed :: [RdrName]
vars_needed = [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [RdrName] -> [RdrName]
forall b a. [b] -> [a] -> [a]
takeList [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[Maybe (LHsExpr GhcPs)]
insides [RdrName]
as_RDRs
pat :: LPat GhcPs
pat = RdrName -> [RdrName] -> LPat GhcPs
nlConVarPat RdrName
con_name [RdrName]
vars_needed
exps :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
exps = [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RdrName -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [RdrName]
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
i RdrName
v -> (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`nlHsApp` IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
v) (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
i)
[Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[Maybe (LHsExpr GhcPs)]
insides [RdrName]
vars_needed
argTysTyVarInfo :: [Bool]
argTysTyVarInfo = (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Bool)
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Bool
forall a. Maybe a -> Bool
isJust [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[Maybe (LHsExpr GhcPs)]
insides
([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
asWithTyVar, [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
asWithoutTyVar) = [Bool]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
[GenLocated SrcSpanAnnA (HsExpr GhcPs)])
forall a. [Bool] -> [a] -> ([a], [a])
partitionByList [Bool]
argTysTyVarInfo [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
as_Vars
con_expr :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
con_expr
| [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
asWithTyVar = IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
con_name [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
asWithoutTyVar
| Bool
otherwise =
let bs :: [RdrName]
bs = [Bool] -> [RdrName] -> [RdrName]
forall a. [Bool] -> [a] -> [a]
filterByList [Bool]
argTysTyVarInfo [RdrName]
bs_RDRs
vars :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
vars = [Bool]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. [Bool] -> [a] -> [a] -> [a]
filterByLists [Bool]
argTysTyVarInfo [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
bs_Vars [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
as_Vars
in [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam ((RdrName -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> [RdrName] -> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat [RdrName]
bs) (IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
con_name [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
vars)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs <- LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs)
fold GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
con_expr [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
exps
GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> HsLocalBinds GhcPs
-> LMatch GhcPs (LHsExpr GhcPs)
forall (p :: Pass).
IsPass p =>
HsMatchContext (NoGhcTc (GhcPass p))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext GhcPs
HsMatchContext (NoGhcTc GhcPs)
ctxt ([GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
extra_pats [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat]) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
rhs HsLocalBinds GhcPs
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds
mkSimpleTupleCase :: Monad m => ([LPat GhcPs] -> DataCon -> [a]
-> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase :: ([LPat GhcPs]
-> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase [LPat GhcPs] -> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con TyCon
tc [a]
insides LHsExpr GhcPs
x
= do { let data_con :: DataCon
data_con = TyCon -> DataCon
tyConSingleDataCon TyCon
tc
; GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match <- [LPat GhcPs] -> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con [] DataCon
data_con [a]
insides
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
nlHsCase LHsExpr GhcPs
x [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
LMatch GhcPs (LHsExpr GhcPs)
match] }
gen_Foldable_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Foldable_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Foldable_binds SrcSpan
loc TyCon
tycon [Type]
_
| Role
Phantom <- [Role] -> Role
forall a. [a] -> a
last (TyCon -> [Role]
tyConRoles TyCon
tycon)
= (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
foldMap_bind, BagDerivStuff
forall a. Bag a
emptyBag)
where
foldMap_name :: GenLocated (SrcAnn NameAnn) RdrName
foldMap_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
foldMap_RDR
foldMap_bind :: LHsBind GhcPs
foldMap_bind = GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
mkRdrFunBind GenLocated (SrcAnn NameAnn) RdrName
foldMap_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
foldMap_eqns
foldMap_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
foldMap_eqns = [HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan) =>
HsMatchContext (NoGhcTc (GhcPass p))
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext GhcPs
HsMatchContext (NoGhcTc GhcPs)
foldMap_match_ctxt
[LPat GhcPs
nlWildPat, LPat GhcPs
nlWildPat]
GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
mempty_Expr]
foldMap_match_ctxt :: HsMatchContext GhcPs
foldMap_match_ctxt = LIdP GhcPs -> HsMatchContext GhcPs
forall p. LIdP p -> HsMatchContext p
mkPrefixFunRhs GenLocated (SrcAnn NameAnn) RdrName
LIdP GhcPs
foldMap_name
gen_Foldable_binds SrcSpan
loc TyCon
tycon [Type]
tycon_args
| [DataCon] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
data_cons
= (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
foldMap_bind, BagDerivStuff
forall a. Bag a
emptyBag)
| Bool
otherwise
= ([GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. [a] -> Bag a
listToBag [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
foldr_bind, GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
foldMap_bind, GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
null_bind], BagDerivStuff
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
foldr_bind :: LHsBind GhcPs
foldr_bind = GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
mkRdrFunBind (SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
foldable_foldr_RDR) [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
eqns
eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
eqns = (DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
foldr_eqn [DataCon]
data_cons
foldr_eqn :: DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
foldr_eqn DataCon
con
= State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall s a. State s a -> s -> a
evalState (LHsExpr GhcPs
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
LHsExpr GhcPs
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldr LHsExpr GhcPs
z_Expr [LPat GhcPs
f_Pat,LPat GhcPs
z_Pat] DataCon
con ([Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts) [RdrName]
bs_RDRs
where
parts :: State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts = [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> DataCon
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. FFoldType a -> DataCon -> [a]
foldDataConArgs FFoldType
(State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldr DataCon
con
foldMap_name :: GenLocated (SrcAnn NameAnn) RdrName
foldMap_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
foldMap_RDR
foldMap_bind :: LHsBind GhcPs
foldMap_bind = Arity
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsBind GhcPs
mkRdrFunBindEC Arity
2 (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. a -> b -> a
const GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
mempty_Expr)
GenLocated (SrcAnn NameAnn) RdrName
foldMap_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
foldMap_eqns
foldMap_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
foldMap_eqns = (DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
foldMap_eqn [DataCon]
data_cons
foldMap_eqn :: DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
foldMap_eqn DataCon
con
= State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall s a. State s a -> s -> a
evalState ([LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
[LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldMap [LPat GhcPs
f_Pat] DataCon
con ([Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts) [RdrName]
bs_RDRs
where
parts :: State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts = [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> DataCon
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. FFoldType a -> DataCon -> [a]
foldDataConArgs FFoldType
(State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldMap DataCon
con
convert :: [NullM a] -> Maybe [Maybe a]
convert :: [NullM a] -> Maybe [Maybe a]
convert = (NullM a -> Maybe (Maybe a)) -> [NullM a] -> Maybe [Maybe a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NullM a -> Maybe (Maybe a)
forall a. NullM a -> Maybe (Maybe a)
go where
go :: NullM a -> Maybe (Maybe a)
go NullM a
IsNull = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
go NullM a
NotNull = Maybe (Maybe a)
forall a. Maybe a
Nothing
go (NullM a
a) = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
null_name :: GenLocated (SrcAnn NameAnn) RdrName
null_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
null_RDR
null_match_ctxt :: HsMatchContext GhcPs
null_match_ctxt = LIdP GhcPs -> HsMatchContext GhcPs
forall p. LIdP p -> HsMatchContext p
mkPrefixFunRhs GenLocated (SrcAnn NameAnn) RdrName
LIdP GhcPs
null_name
null_bind :: LHsBind GhcPs
null_bind = GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
mkRdrFunBind GenLocated (SrcAnn NameAnn) RdrName
null_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
null_eqns
null_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
null_eqns = (DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
null_eqn [DataCon]
data_cons
null_eqn :: DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
null_eqn DataCon
con
= (State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall s a. State s a -> s -> a
evalState [RdrName]
bs_RDRs (State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ do
[NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts <- [State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> [State
[RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> DataCon
-> [State
[RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. FFoldType a -> DataCon -> [a]
foldDataConArgs FFoldType
(State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
FFoldType (State [RdrName] (NullM (LHsExpr GhcPs)))
ft_null DataCon
con
case [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Maybe [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. [NullM a] -> Maybe [Maybe a]
convert [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts of
Maybe [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
Nothing -> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$
HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> HsLocalBinds GhcPs
-> LMatch GhcPs (LHsExpr GhcPs)
forall (p :: Pass).
IsPass p =>
HsMatchContext (NoGhcTc (GhcPass p))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext GhcPs
HsMatchContext (NoGhcTc GhcPs)
null_match_ctxt [LPat GhcPs -> LPat GhcPs
forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
nlParPat (DataCon -> LPat GhcPs
nlWildConPat DataCon
con)]
LHsExpr GhcPs
false_Expr HsLocalBinds GhcPs
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds
Just [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
cp -> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
[LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_null [] DataCon
con [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[Maybe (LHsExpr GhcPs)]
cp
ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldr
= FT :: forall a.
a
-> a
-> a
-> (a -> a -> a)
-> (TyCon -> [a] -> a)
-> (Type -> Type -> a -> a)
-> a
-> (TcTyVar -> a -> a)
-> FFoldType a
FT { ft_triv :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_triv = Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. Maybe a
Nothing
, ft_var :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_var = Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f_Expr
, ft_tup :: TyCon
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_tup = \TyCon
t [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g -> do
[Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg <- [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lam <- (LHsExpr GhcPs -> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam2 ((LHsExpr GhcPs
-> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs))
-> (LHsExpr GhcPs
-> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
x LHsExpr GhcPs
z ->
([LPat GhcPs]
-> DataCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs)
forall (m :: * -> *) a.
Monad m =>
([LPat GhcPs]
-> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase (LHsExpr GhcPs
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
LHsExpr GhcPs
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldr LHsExpr GhcPs
z) TyCon
t [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg LHsExpr GhcPs
x
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
lam)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_ty_app = \Type
_ Type
_ State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> do
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
gg <- State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
gg' -> (LHsExpr GhcPs -> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam2 ((LHsExpr GhcPs
-> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs))
-> (LHsExpr GhcPs
-> LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
x LHsExpr GhcPs
z -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$
IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
foldable_foldr_RDR [GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
gg',LHsExpr GhcPs
z,LHsExpr GhcPs
x]) Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
gg
, ft_forall :: TcTyVar
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_forall = \TcTyVar
_ State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g
, ft_co_var :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_co_var = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"contravariant in ft_foldr"
, ft_fun :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_fun = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"function in ft_foldr"
, ft_bad_app :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_bad_app = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"in other argument in ft_foldr" }
match_foldr :: Monad m
=> LHsExpr GhcPs
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldr :: LHsExpr GhcPs
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldr LHsExpr GhcPs
z = HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch2 HsMatchContext GhcPs
forall p. HsMatchContext p
LambdaExpr ((LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
_ [LHsExpr GhcPs]
xs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldr [LHsExpr GhcPs]
xs)
where
mkFoldr :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldr :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldr = (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
z
ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldMap
= FT :: forall a.
a
-> a
-> a
-> (a -> a -> a)
-> (TyCon -> [a] -> a)
-> (Type -> Type -> a -> a)
-> a
-> (TcTyVar -> a -> a)
-> FFoldType a
FT { ft_triv :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_triv = Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. Maybe a
Nothing
, ft_var :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_var = Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f_Expr)
, ft_tup :: TyCon
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_tup = \TyCon
t [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g -> do
[Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg <- [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lam <- (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam ((LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs))
-> (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ([LPat GhcPs]
-> DataCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs)
forall (m :: * -> *) a.
Monad m =>
([LPat GhcPs]
-> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase [LPat GhcPs]
-> DataCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
[LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldMap TyCon
t [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
lam)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_ty_app = \Type
_ Type
_ State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr GhcPs
foldMap_Expr) (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g
, ft_forall :: TcTyVar
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_forall = \TcTyVar
_ State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g
, ft_co_var :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_co_var = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"contravariant in ft_foldMap"
, ft_fun :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_fun = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"function in ft_foldMap"
, ft_bad_app :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_bad_app = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"in other argument in ft_foldMap" }
match_foldMap :: Monad m
=> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldMap :: [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_foldMap = HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch2 HsMatchContext GhcPs
forall p. HsMatchContext p
CaseAlt ((LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
_ [LHsExpr GhcPs]
xs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldMap [LHsExpr GhcPs]
xs)
where
mkFoldMap :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldMap :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldMap [] = LHsExpr GhcPs
mempty_Expr
mkFoldMap [LHsExpr GhcPs]
xs = (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
y -> IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
mappend_RDR [GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x,GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
y]) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
xs
ft_null :: FFoldType (State [RdrName] (NullM (LHsExpr GhcPs)))
ft_null :: FFoldType (State [RdrName] (NullM (LHsExpr GhcPs)))
ft_null
= FT :: forall a.
a
-> a
-> a
-> (a -> a -> a)
-> (TyCon -> [a] -> a)
-> (Type -> Type -> a -> a)
-> a
-> (TcTyVar -> a -> a)
-> FFoldType a
FT { ft_triv :: State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_triv = NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. NullM a
IsNull
, ft_var :: State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_var = NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. NullM a
NotNull
, ft_tup :: TyCon
-> [State
[RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_tup = \TyCon
t [State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g -> do
[NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg <- [State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g
case [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Maybe [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. [NullM a] -> Maybe [Maybe a]
convert [NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg of
Maybe [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
Nothing -> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. NullM a
NotNull
Just [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
ggg ->
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> NullM a
NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam ((LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs))
-> (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ([LPat GhcPs]
-> DataCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs)
forall (m :: * -> *) a.
Monad m =>
([LPat GhcPs]
-> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase [LPat GhcPs]
-> DataCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
[LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_null TyCon
t [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
ggg)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_ty_app = \Type
_ Type
_ State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> ((NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g ((NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ \NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
nestedResult ->
case NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
nestedResult of
NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
NotNull -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> NullM a
NullM GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
null_Expr
NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
IsNull -> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. NullM a
IsNull
NullM GenLocated SrcSpanAnnA (HsExpr GhcPs)
nestedTest -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> NullM a
NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr GhcPs
all_Expr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
nestedTest
, ft_forall :: TcTyVar
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_forall = \TcTyVar
_ State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g
, ft_co_var :: State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_co_var = String
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"contravariant in ft_null"
, ft_fun :: State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_fun = String
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"function in ft_null"
, ft_bad_app :: State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_bad_app = String
-> State [RdrName] (NullM (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"in other argument in ft_null" }
match_null :: Monad m
=> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_null :: [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_null = HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch2 HsMatchContext GhcPs
forall p. HsMatchContext p
CaseAlt ((LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
_ [LHsExpr GhcPs]
xs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsExpr GhcPs] -> LHsExpr GhcPs
mkNull [LHsExpr GhcPs]
xs)
where
mkNull :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkNull :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkNull [] = LHsExpr GhcPs
true_Expr
mkNull [LHsExpr GhcPs]
xs = (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
y -> IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
and_RDR [GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x,GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
y]) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
xs
data NullM a =
IsNull
| NotNull
| NullM a
gen_Traversable_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Traversable_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Traversable_binds SrcSpan
loc TyCon
tycon [Type]
_
| Role
Phantom <- [Role] -> Role
forall a. [a] -> a
last (TyCon -> [Role]
tyConRoles TyCon
tycon)
= (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
traverse_bind, BagDerivStuff
forall a. Bag a
emptyBag)
where
traverse_name :: GenLocated (SrcAnn NameAnn) RdrName
traverse_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
traverse_RDR
traverse_bind :: LHsBind GhcPs
traverse_bind = GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
mkRdrFunBind GenLocated (SrcAnn NameAnn) RdrName
traverse_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
traverse_eqns
traverse_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
traverse_eqns =
[HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan) =>
HsMatchContext (NoGhcTc (GhcPass p))
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext GhcPs
HsMatchContext (NoGhcTc GhcPs)
traverse_match_ctxt
[LPat GhcPs
nlWildPat, LPat GhcPs
z_Pat]
(IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
pure_RDR [LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr GhcPs
coerce_Expr LHsExpr GhcPs
z_Expr])]
traverse_match_ctxt :: HsMatchContext GhcPs
traverse_match_ctxt = LIdP GhcPs -> HsMatchContext GhcPs
forall p. LIdP p -> HsMatchContext p
mkPrefixFunRhs GenLocated (SrcAnn NameAnn) RdrName
LIdP GhcPs
traverse_name
gen_Traversable_binds SrcSpan
loc TyCon
tycon [Type]
tycon_args
= (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
LHsBind GhcPs
traverse_bind, BagDerivStuff
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
traverse_name :: GenLocated (SrcAnn NameAnn) RdrName
traverse_name = SrcAnn NameAnn -> RdrName -> GenLocated (SrcAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NameAnn
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
traverse_RDR
traverse_bind :: LHsBind GhcPs
traverse_bind = Arity
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> GenLocated (SrcAnn NameAnn) RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsBind GhcPs
mkRdrFunBindEC Arity
2 (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr GhcPs
pure_Expr)
GenLocated (SrcAnn NameAnn) RdrName
traverse_name [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
traverse_eqns
traverse_eqns :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
traverse_eqns = (DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
traverse_eqn [DataCon]
data_cons
traverse_eqn :: DataCon
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
traverse_eqn DataCon
con
= State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall s a. State s a -> s -> a
evalState ([LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
[LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con [LPat GhcPs
f_Pat] DataCon
con ([Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts) [RdrName]
bs_RDRs
where
parts :: State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
parts = [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> DataCon
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. FFoldType a -> DataCon -> [a]
foldDataConArgs FFoldType
(State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_trav DataCon
con
ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_trav
= FT :: forall a.
a
-> a
-> a
-> (a -> a -> a)
-> (TyCon -> [a] -> a)
-> (Type -> Type -> a -> a)
-> a
-> (TcTyVar -> a -> a)
-> FFoldType a
FT { ft_triv :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_triv = Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. Maybe a
Nothing
, ft_var :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_var = Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f_Expr)
, ft_tup :: TyCon
-> [State
[RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_tup = \TyCon
t [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs -> do
[Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg <- [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> State [RdrName] [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lam <- (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam ((LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs))
-> (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ([LPat GhcPs]
-> DataCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs)
forall (m :: * -> *) a.
Monad m =>
([LPat GhcPs]
-> DataCon -> [a] -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase [LPat GhcPs]
-> DataCon
-> [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
[LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con TyCon
t [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gg
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
lam)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_ty_app = \Type
_ Type
_ State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr GhcPs
traverse_Expr) (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g
, ft_forall :: TcTyVar
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_forall = \TcTyVar
_ State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g -> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g
, ft_co_var :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_co_var = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"contravariant in ft_trav"
, ft_fun :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_fun = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"function in ft_trav"
, ft_bad_app :: State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ft_bad_app = String
-> State [RdrName] (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"in other argument in ft_trav" }
match_for_con :: Monad m
=> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con :: [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con = HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
HsMatchContext GhcPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch2 HsMatchContext GhcPs
forall p. HsMatchContext p
CaseAlt ((LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$
\LHsExpr GhcPs
con [LHsExpr GhcPs]
xs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
mkApCon LHsExpr GhcPs
con [LHsExpr GhcPs]
xs)
where
mkApCon :: LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
mkApCon :: LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
mkApCon LHsExpr GhcPs
con [] = IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
pure_RDR [LHsExpr GhcPs
con]
mkApCon LHsExpr GhcPs
con [LHsExpr GhcPs
x] = IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
fmap_RDR [LHsExpr GhcPs
con,LHsExpr GhcPs
x]
mkApCon LHsExpr GhcPs
con (LHsExpr GhcPs
x1:LHsExpr GhcPs
x2:[LHsExpr GhcPs]
xs) =
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (p :: Pass).
(IsPass p, IdGhcP p ~ RdrName, Anno (IdGhcP p) ~ SrcAnn NameAnn) =>
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
appAp (IdP GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP GhcPs
liftA2_RDR [LHsExpr GhcPs
con,LHsExpr GhcPs
x1,LHsExpr GhcPs
x2]) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
xs
where appAp :: GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> LHsExpr (GhcPass p)
appAp GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
x GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
y = IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps RdrName
IdP (GhcPass p)
ap_RDR [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
LHsExpr (GhcPass p)
x,GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
LHsExpr (GhcPass p)
y]
f_Expr, z_Expr, mempty_Expr, foldMap_Expr,
traverse_Expr, coerce_Expr, pure_Expr, true_Expr, false_Expr,
all_Expr, null_Expr :: LHsExpr GhcPs
f_Expr :: LHsExpr GhcPs
f_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
f_RDR
z_Expr :: LHsExpr GhcPs
z_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
z_RDR
mempty_Expr :: LHsExpr GhcPs
mempty_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
mempty_RDR
foldMap_Expr :: LHsExpr GhcPs
foldMap_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
foldMap_RDR
traverse_Expr :: LHsExpr GhcPs
traverse_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
traverse_RDR
coerce_Expr :: LHsExpr GhcPs
coerce_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (TcTyVar -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TcTyVar
coerceId)
pure_Expr :: LHsExpr GhcPs
pure_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
pure_RDR
true_Expr :: LHsExpr GhcPs
true_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
true_RDR
false_Expr :: LHsExpr GhcPs
false_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
false_RDR
all_Expr :: LHsExpr GhcPs
all_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
all_RDR
null_Expr :: LHsExpr GhcPs
null_Expr = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar RdrName
IdP GhcPs
null_RDR
f_RDR, z_RDR :: RdrName
f_RDR :: RdrName
f_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"f")
z_RDR :: RdrName
z_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"z")
as_RDRs, bs_RDRs :: [RdrName]
as_RDRs :: [RdrName]
as_RDRs = [ FastString -> RdrName
mkVarUnqual (String -> FastString
mkFastString (String
"a"String -> String -> String
forall a. [a] -> [a] -> [a]
++Arity -> String
forall a. Show a => a -> String
show Arity
i)) | Arity
i <- [(Arity
1::Int) .. ] ]
bs_RDRs :: [RdrName]
bs_RDRs = [ FastString -> RdrName
mkVarUnqual (String -> FastString
mkFastString (String
"b"String -> String -> String
forall a. [a] -> [a] -> [a]
++Arity -> String
forall a. Show a => a -> String
show Arity
i)) | Arity
i <- [(Arity
1::Int) .. ] ]
as_Vars, bs_Vars :: [LHsExpr GhcPs]
as_Vars :: [LHsExpr GhcPs]
as_Vars = (RdrName -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [RdrName] -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar [RdrName]
as_RDRs
bs_Vars :: [LHsExpr GhcPs]
bs_Vars = (RdrName -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [RdrName] -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar [RdrName]
bs_RDRs
f_Pat, z_Pat :: LPat GhcPs
f_Pat :: LPat GhcPs
f_Pat = IdP GhcPs -> LPat GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat RdrName
IdP GhcPs
f_RDR
z_Pat :: LPat GhcPs
z_Pat = IdP GhcPs -> LPat GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat RdrName
IdP GhcPs
z_RDR