{-# 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.Strict
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 -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Functor_binds :: SrcSpan
-> DerivInstTys -> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Functor_binds SrcSpan
loc (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon})
| Role
Phantom <- [Role] -> Role
forall a. HasCallStack => [a] -> a
last (TyCon -> [Role]
tyConRoles TyCon
tycon)
= ([LHsBind (GhcPass 'Parsed)
fmap_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
fmap_name :: GenLocated SrcSpanAnnN RdrName
fmap_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
fmap_RDR
fmap_bind :: LHsBind (GhcPass 'Parsed)
fmap_bind = GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBind GenLocated SrcSpanAnnN RdrName
fmap_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
fmap_eqns
fmap_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
fmap_eqns = [HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns) =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> LocatedE [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
fmap_match_ctxt
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat])
LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
coerce_Expr]
fmap_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
fmap_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
fmap_name AnnFunRhs
forall a. NoAnn a => a
noAnn
gen_Functor_binds SrcSpan
loc dit :: DerivInstTys
dit@(DerivInstTys{ dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon
, dit_rep_tc_args :: DerivInstTys -> [Type]
dit_rep_tc_args = [Type]
tycon_args })
= ([LHsBind (GhcPass 'Parsed)
fmap_bind, LHsBind (GhcPass 'Parsed)
replace_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
fmap_name :: GenLocated SrcSpanAnnN RdrName
fmap_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
fmap_RDR
fmap_bind :: LHsBind (GhcPass 'Parsed)
fmap_bind = Int
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindEC Int
2 LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. a -> a
id GenLocated SrcSpanAnnN RdrName
fmap_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
fmap_eqns
fmap_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
fmap_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
fmap_name AnnFunRhs
forall a. NoAnn a => a
noAnn
fmap_eqn :: DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
fmap_eqn DataCon
con = (State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall s a. State s a -> s -> a
evalState [RdrName]
bs_RDRs (State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
fmap_match_ctxt [LPat (GhcPass 'Parsed)
f_Pat] DataCon
con [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
[LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts
where
parts :: [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts = FFoldType
(LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed))))
-> DataCon
-> DerivInstTys
-> [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
foldDataConArgs FFoldType
(LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
FFoldType
(LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_fmap DataCon
con DerivInstTys
dit
fmap_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
fmap_eqns = (DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
fmap_eqn [DataCon]
data_cons
ft_fmap :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_fmap :: FFoldType
(LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
ft_fmap = FT { ft_triv :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_triv = \LHsExpr (GhcPass 'Parsed)
x -> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a. a -> State [RdrName] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr (GhcPass 'Parsed)
x
, ft_var :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_var = \LHsExpr (GhcPass 'Parsed)
x -> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a. a -> State [RdrName] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass 'Parsed)
f_Expr LHsExpr (GhcPass 'Parsed)
x
, ft_fun :: (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_fun = \LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
h LHsExpr (GhcPass 'Parsed)
x -> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam ((LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ \LHsExpr (GhcPass 'Parsed)
b -> do
gg <- LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
b
h $ nlHsApp x gg
, ft_tup :: TyCon
-> [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_tup = ([LPat (GhcPass 'Parsed)]
-> DataCon
-> [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *) a.
Monad m =>
([LPat (GhcPass 'Parsed)]
-> DataCon
-> [a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [a]
-> LHsExpr (GhcPass 'Parsed)
-> m (LHsExpr (GhcPass 'Parsed))
mkSimpleTupleCase (HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. HsMatchContext fn
CaseAlt)
, ft_ty_app :: Type
-> Type
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_ty_app = \Type
_ Type
arg_ty LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
x ->
if Type -> Bool
tcIsTyVarTy Type
arg_ty
then LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a. a -> State [RdrName] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
fmap_RDR [LHsExpr (GhcPass 'Parsed)
f_Expr,LHsExpr (GhcPass 'Parsed)
x]
else do gg <- (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g
pure $ nlHsApps fmap_RDR [gg,x]
, ft_forall :: Id
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_forall = \Id
_ LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
x -> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
x
, ft_bad_app :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_bad_app = String
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
panic String
"in other argument in ft_fmap"
, ft_co_var :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_co_var = String
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
panic String
"contravariant in ft_fmap" }
replace_name :: GenLocated SrcSpanAnnN RdrName
replace_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
replace_RDR
replace_bind :: LHsBind (GhcPass 'Parsed)
replace_bind = Int
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindEC Int
2 LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. a -> a
id GenLocated SrcSpanAnnN RdrName
replace_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
replace_eqns
replace_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
replace_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
replace_name AnnFunRhs
forall a. NoAnn a => a
noAnn
replace_eqn :: DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
replace_eqn DataCon
con = (State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall s a. State s a -> s -> a
evalState [RdrName]
bs_RDRs (State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
replace_match_ctxt [LPat (GhcPass 'Parsed)
z_Pat] DataCon
con [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
[LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts
where
parts :: [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts = FFoldType
(LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed))))
-> DataCon
-> DerivInstTys
-> [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
foldDataConArgs FFoldType
(LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
FFoldType
(LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_replace DataCon
con DerivInstTys
dit
replace_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
replace_eqns = (DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
replace_eqn [DataCon]
data_cons
ft_replace :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))
ft_replace :: FFoldType
(LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
ft_replace = FT { ft_triv :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_triv = \LHsExpr (GhcPass 'Parsed)
x -> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a. a -> State [RdrName] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr (GhcPass 'Parsed)
x
, ft_var :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_var = \LHsExpr (GhcPass 'Parsed)
_ -> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a. a -> State [RdrName] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr (GhcPass 'Parsed)
z_Expr
, ft_fun :: (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_fun = \LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
h LHsExpr (GhcPass 'Parsed)
x -> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam ((LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ \LHsExpr (GhcPass 'Parsed)
b -> do
gg <- LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
b
h $ nlHsApp x gg
, ft_tup :: TyCon
-> [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_tup = ([LPat (GhcPass 'Parsed)]
-> DataCon
-> [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *) a.
Monad m =>
([LPat (GhcPass 'Parsed)]
-> DataCon
-> [a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [a]
-> LHsExpr (GhcPass 'Parsed)
-> m (LHsExpr (GhcPass 'Parsed))
mkSimpleTupleCase (HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. HsMatchContext fn
CaseAlt)
, ft_ty_app :: Type
-> Type
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_ty_app = \Type
_ Type
arg_ty LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
x ->
if Type -> Bool
tcIsTyVarTy Type
arg_ty
then LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a. a -> State [RdrName] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
replace_RDR [LHsExpr (GhcPass 'Parsed)
z_Expr,LHsExpr (GhcPass 'Parsed)
x]
else do gg <- (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g
pure $ nlHsApps fmap_RDR [gg,x]
, ft_forall :: Id
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_forall = \Id
_ LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
x -> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
g LHsExpr (GhcPass 'Parsed)
x
, ft_bad_app :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_bad_app = String
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
panic String
"in other argument in ft_replace"
, ft_co_var :: LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
ft_co_var = String
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
panic String
"contravariant in ft_replace" }
match_for_con :: Monad m
=> HsMatchContextPs
-> [LPat GhcPs] -> DataCon
-> [LHsExpr GhcPs -> m (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
match_for_con :: forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con HsMatchContextPs
ctxt = HsMatchContextPs
-> (RdrName
-> [m (LHsExpr (GhcPass 'Parsed))]
-> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a.
Monad m =>
HsMatchContextPs
-> (RdrName -> [a] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
mkSimpleConMatch HsMatchContextPs
ctxt ((RdrName
-> [m (LHsExpr (GhcPass 'Parsed))]
-> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> (RdrName
-> [m (LHsExpr (GhcPass 'Parsed))]
-> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
\RdrName
con_name [m (LHsExpr (GhcPass 'Parsed))]
xsM -> do xs <- [m (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> m [LocatedA (HsExpr (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [m (LHsExpr (GhcPass 'Parsed))]
[m (LocatedA (HsExpr (GhcPass 'Parsed)))]
xsM
pure $ nlHsApps con_name xs
data FFoldType a
= FT { forall a. FFoldType a -> a
ft_triv :: a
, forall a. FFoldType a -> a
ft_var :: a
, forall a. FFoldType a -> a
ft_co_var :: a
, forall a. FFoldType a -> a -> a -> a
ft_fun :: a -> a -> a
, forall a. FFoldType a -> TyCon -> [a] -> a
ft_tup :: TyCon -> [a] -> a
, forall a. FFoldType a -> Type -> Type -> a -> a
ft_ty_app :: Type -> Type -> a -> a
, forall a. FFoldType a -> a
ft_bad_app :: a
, forall a. FFoldType a -> Id -> a -> a
ft_forall :: TcTyVar -> a -> a
}
functorLikeTraverse :: forall a.
TyVar
-> FFoldType a
-> Type
-> a
functorLikeTraverse :: forall a. Id -> FFoldType a -> Type -> a
functorLikeTraverse Id
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 -> Id -> a -> a
ft_forall = Id -> 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
coreView Type
ty = Bool -> Type -> (a, Bool)
go Bool
co Type
ty'
go Bool
co (TyVarTy Id
v) | Id
v Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
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 -> FunTyFlag
ft_af = FunTyFlag
af })
| FunTyFlag -> Bool
isInvisibleFunArg FunTyFlag
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. HasCallStack => [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. HasCallStack => [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 Id
v ForAllTyFlag
vis) Type
x)
| ForAllTyFlag -> Bool
isVisibleForAllTyFlag ForAllTyFlag
vis = String -> (a, Bool)
forall a. HasCallStack => String -> a
panic String
"unexpected visible binder"
| Id
v Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
/= Id
var Bool -> Bool -> Bool
&& Bool
xc = (Id -> a -> a
caseForAll Id
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 :: Id -> Type -> [Type]
deepSubtypesContaining Id
tv
= Id -> FFoldType [Type] -> Type -> [Type]
forall a. Id -> FFoldType a -> Type -> a
functorLikeTraverse Id
tv
(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. HasCallStack => String -> a
panic String
"in other argument in deepSubtypesContaining"
, ft_co_var :: [Type]
ft_co_var = String -> [Type]
forall a. HasCallStack => String -> a
panic String
"contravariant in deepSubtypesContaining"
, ft_forall :: Id -> [Type] -> [Type]
ft_forall = \Id
v [Type]
xs -> (Type -> Bool) -> [Type] -> [Type]
forall a. (a -> Bool) -> [a] -> [a]
filterOut ((Id
v Id -> 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 -> DerivInstTys -> [a]
foldDataConArgs :: forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
foldDataConArgs FFoldType a
ft DataCon
con DerivInstTys
dit
= (Type -> a) -> [Type] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Type -> a
foldArg (DataCon -> DerivInstTys -> [Type]
derivDataConInstArgTys DataCon
con DerivInstTys
dit)
where
foldArg :: Type -> a
foldArg
= case Type -> Maybe Id
getTyVar_maybe ([Type] -> Type
forall a. HasCallStack => [a] -> a
last (HasDebugCallStack => Type -> [Type]
Type -> [Type]
tyConAppArgs (DataCon -> Type
dataConOrigResTy DataCon
con))) of
Just Id
tv -> Id -> FFoldType a -> Type -> a
forall a. Id -> FFoldType a -> Type -> a
functorLikeTraverse Id
tv FFoldType a
ft
Maybe Id
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 (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
lam =
State [RdrName] [RdrName]
forall s. State s s
get State [RdrName] [RdrName]
-> ([RdrName]
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b.
State [RdrName] a -> (a -> State [RdrName] b) -> State [RdrName] b
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
body <- LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
lam (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
n)
return (mkHsLam (noLocA [nlVarPat n]) body)
[RdrName]
_ -> String -> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
panic String
"mkSimpleLam"
mkSimpleLam2 :: (LHsExpr GhcPs -> LHsExpr GhcPs
-> State [RdrName] (LHsExpr GhcPs))
-> State [RdrName] (LHsExpr GhcPs)
mkSimpleLam2 :: (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam2 LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
lam =
State [RdrName] [RdrName]
forall s. State s s
get State [RdrName] [RdrName]
-> ([RdrName]
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b.
State [RdrName] a -> (a -> State [RdrName] b) -> State [RdrName] b
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
body <- LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
lam (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
n1) (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
n2)
return (mkHsLam (noLocA [nlVarPat n1,nlVarPat n2]) body)
[RdrName]
_ -> String -> State [RdrName] (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
panic String
"mkSimpleLam2"
mkSimpleConMatch :: Monad m => HsMatchContextPs
-> (RdrName -> [a] -> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [LHsExpr GhcPs -> a]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch :: forall (m :: * -> *) a.
Monad m =>
HsMatchContextPs
-> (RdrName -> [a] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [LHsExpr (GhcPass 'Parsed) -> a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
mkSimpleConMatch HsMatchContextPs
ctxt RdrName -> [a] -> m (LHsExpr (GhcPass 'Parsed))
fold [LPat (GhcPass 'Parsed)]
extra_pats DataCon
con [LHsExpr (GhcPass 'Parsed) -> 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 = [LocatedA (HsExpr (GhcPass 'Parsed)) -> a]
-> [RdrName] -> [RdrName]
forall b a. [b] -> [a] -> [a]
takeList [LHsExpr (GhcPass 'Parsed) -> a]
[LocatedA (HsExpr (GhcPass 'Parsed)) -> a]
insides [RdrName]
as_RDRs
let bare_pat :: LPat (GhcPass 'Parsed)
bare_pat = RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
con_name [RdrName]
vars_needed
let pat :: LPat (GhcPass 'Parsed)
pat = if [RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RdrName]
vars_needed
then LPat (GhcPass 'Parsed)
bare_pat
else LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
nlParPat LPat (GhcPass 'Parsed)
bare_pat
rhs <- RdrName -> [a] -> m (LHsExpr (GhcPass 'Parsed))
fold RdrName
con_name
(((LocatedA (HsExpr (GhcPass 'Parsed)) -> a) -> RdrName -> a)
-> [LocatedA (HsExpr (GhcPass 'Parsed)) -> a] -> [RdrName] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\LocatedA (HsExpr (GhcPass 'Parsed)) -> a
i RdrName
v -> LocatedA (HsExpr (GhcPass 'Parsed)) -> a
i (LocatedA (HsExpr (GhcPass 'Parsed)) -> a)
-> LocatedA (HsExpr (GhcPass 'Parsed)) -> a
forall a b. (a -> b) -> a -> b
$ IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
v) [LHsExpr (GhcPass 'Parsed) -> a]
[LocatedA (HsExpr (GhcPass 'Parsed)) -> a]
insides [RdrName]
vars_needed)
return $ mkMatch ctxt (noLocA (extra_pats ++ [pat])) rhs emptyLocalBinds
mkSimpleConMatch2 :: Monad m
=> HsMatchContextPs
-> (LHsExpr GhcPs -> [LHsExpr GhcPs]
-> m (LHsExpr GhcPs))
-> [LPat GhcPs]
-> DataCon
-> [Maybe (LHsExpr GhcPs)]
-> m (LMatch GhcPs (LHsExpr GhcPs))
mkSimpleConMatch2 :: forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
mkSimpleConMatch2 HsMatchContextPs
ctxt LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed))
fold [LPat (GhcPass 'Parsed)]
extra_pats DataCon
con [Maybe (LHsExpr (GhcPass 'Parsed))]
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 (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> [RdrName] -> [RdrName]
forall b a. [b] -> [a] -> [a]
takeList [Maybe (LHsExpr (GhcPass 'Parsed))]
[Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
insides [RdrName]
as_RDRs
pat :: LPat (GhcPass 'Parsed)
pat = RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
con_name [RdrName]
vars_needed
exps :: [LocatedA (HsExpr (GhcPass 'Parsed))]
exps = [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))])
-> [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> a -> b
$ (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> RdrName -> Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> [RdrName]
-> [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
i RdrName
v -> (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`nlHsApp` IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
v) (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
i)
[Maybe (LHsExpr (GhcPass 'Parsed))]
[Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
insides [RdrName]
vars_needed
argTysTyVarInfo :: [Bool]
argTysTyVarInfo = (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))) -> Bool)
-> [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (LocatedA (HsExpr (GhcPass 'Parsed))) -> Bool
forall a. Maybe a -> Bool
isJust [Maybe (LHsExpr (GhcPass 'Parsed))]
[Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
insides
([LocatedA (HsExpr (GhcPass 'Parsed))]
asWithTyVar, [LocatedA (HsExpr (GhcPass 'Parsed))]
asWithoutTyVar) = [Bool]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> ([LocatedA (HsExpr (GhcPass 'Parsed))],
[LocatedA (HsExpr (GhcPass 'Parsed))])
forall a. [Bool] -> [a] -> ([a], [a])
partitionByList [Bool]
argTysTyVarInfo [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
as_Vars
con_expr :: LHsExpr (GhcPass 'Parsed)
con_expr
| [LocatedA (HsExpr (GhcPass 'Parsed))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LocatedA (HsExpr (GhcPass 'Parsed))]
asWithTyVar = IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
con_name [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
asWithoutTyVar
| Bool
otherwise =
let bs :: [RdrName]
bs = [Bool] -> [RdrName] -> [RdrName]
forall a. [Bool] -> [a] -> [a]
filterByList [Bool]
argTysTyVarInfo [RdrName]
bs_RDRs
vars :: [LocatedA (HsExpr (GhcPass 'Parsed))]
vars = [Bool]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. [Bool] -> [a] -> [a] -> [a]
filterByLists [Bool]
argTysTyVarInfo [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
bs_Vars [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
as_Vars
in LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) =>
LocatedE [LPat (GhcPass p)]
-> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA ((RdrName -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [RdrName] -> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
RdrName -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat [RdrName]
bs)) (IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
con_name [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
vars)
rhs <- LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed))
fold LHsExpr (GhcPass 'Parsed)
con_expr [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
exps
return $ mkMatch ctxt (noLocA (extra_pats ++ [pat])) rhs emptyLocalBinds
mkSimpleTupleCase :: Monad m => ([LPat GhcPs] -> DataCon -> [a]
-> m (LMatch GhcPs (LHsExpr GhcPs)))
-> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)
mkSimpleTupleCase :: forall (m :: * -> *) a.
Monad m =>
([LPat (GhcPass 'Parsed)]
-> DataCon
-> [a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [a]
-> LHsExpr (GhcPass 'Parsed)
-> m (LHsExpr (GhcPass 'Parsed))
mkSimpleTupleCase [LPat (GhcPass 'Parsed)]
-> DataCon
-> [a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con TyCon
tc [a]
insides LHsExpr (GhcPass 'Parsed)
x
= do { let data_con :: DataCon
data_con = TyCon -> DataCon
tyConSingleDataCon TyCon
tc
; match <- [LPat (GhcPass 'Parsed)]
-> DataCon
-> [a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con [] DataCon
data_con [a]
insides
; return $ nlHsCase x [match] }
gen_Foldable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Foldable_binds :: SrcSpan
-> DerivInstTys -> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Foldable_binds SrcSpan
loc (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon})
| Role
Phantom <- [Role] -> Role
forall a. HasCallStack => [a] -> a
last (TyCon -> [Role]
tyConRoles TyCon
tycon)
= ([LHsBind (GhcPass 'Parsed)
foldMap_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
foldMap_name :: GenLocated SrcSpanAnnN RdrName
foldMap_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
foldMap_RDR
foldMap_bind :: LHsBind (GhcPass 'Parsed)
foldMap_bind = GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBind GenLocated SrcSpanAnnN RdrName
foldMap_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
foldMap_eqns
foldMap_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
foldMap_eqns = [HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns) =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> LocatedE [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
foldMap_match_ctxt
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat])
LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
mempty_Expr]
foldMap_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
foldMap_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
foldMap_name AnnFunRhs
forall a. NoAnn a => a
noAnn
gen_Foldable_binds SrcSpan
loc dit :: DerivInstTys
dit@(DerivInstTys{ dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon
, dit_rep_tc_args :: DerivInstTys -> [Type]
dit_rep_tc_args = [Type]
tycon_args })
| [DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
data_cons
= ([LHsBind (GhcPass 'Parsed)
foldMap_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
| Bool
otherwise
= ([LHsBind (GhcPass 'Parsed)
foldr_bind, LHsBind (GhcPass 'Parsed)
foldMap_bind, LHsBind (GhcPass 'Parsed)
null_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
foldr_name :: GenLocated SrcSpanAnnN RdrName
foldr_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
foldable_foldr_RDR
foldr_bind :: LHsBind (GhcPass 'Parsed)
foldr_bind = GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBind (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
foldable_foldr_RDR) [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
eqns
eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
eqns = (DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
foldr_eqn [DataCon]
data_cons
foldr_eqn :: DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
foldr_eqn DataCon
con
= State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall s a. State s a -> s -> a
evalState (LHsExpr (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
LHsExpr (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_foldr LHsExpr (GhcPass 'Parsed)
z_Expr [LPat (GhcPass 'Parsed)
f_Pat,LPat (GhcPass 'Parsed)
z_Pat] DataCon
con ([Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts) [RdrName]
bs_RDRs
where
parts :: State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts = [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))])
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> DataCon
-> DerivInstTys
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
foldDataConArgs FFoldType (State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed))))
FFoldType
(State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))))
ft_foldr DataCon
con DerivInstTys
dit
foldr_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
foldr_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
foldr_name AnnFunRhs
forall a. NoAnn a => a
noAnn
foldMap_name :: GenLocated SrcSpanAnnN RdrName
foldMap_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
foldMap_RDR
foldMap_bind :: LHsBind (GhcPass 'Parsed)
foldMap_bind = Int
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindEC Int
2 (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a b. a -> b -> a
const LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
mempty_Expr)
GenLocated SrcSpanAnnN RdrName
foldMap_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
foldMap_eqns
foldMap_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
foldMap_eqns = (DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
foldMap_eqn [DataCon]
data_cons
foldMap_eqn :: DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
foldMap_eqn DataCon
con
= State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall s a. State s a -> s -> a
evalState ([LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_foldMap [LPat (GhcPass 'Parsed)
f_Pat] DataCon
con ([Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts) [RdrName]
bs_RDRs
where
parts :: State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts = [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))])
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> DataCon
-> DerivInstTys
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
foldDataConArgs FFoldType (State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed))))
FFoldType
(State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))))
ft_foldMap DataCon
con DerivInstTys
dit
foldMap_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
foldMap_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
foldMap_name AnnFunRhs
forall a. NoAnn a => a
noAnn
convert :: [NullM a] -> Maybe [Maybe a]
convert :: forall a. [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 SrcSpanAnnN RdrName
null_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
null_RDR
null_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
null_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
null_name AnnFunRhs
forall a. NoAnn a => a
noAnn
null_bind :: LHsBind (GhcPass 'Parsed)
null_bind = GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBind GenLocated SrcSpanAnnN RdrName
null_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
null_eqns
null_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
null_eqns = (DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
null_eqn [DataCon]
data_cons
null_eqn :: DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
null_eqn DataCon
con
= (State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall s a. State s a -> s -> a
evalState [RdrName]
bs_RDRs (State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ do
parts <- [State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [NullM (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [NullM (LocatedA (HsExpr (GhcPass 'Parsed)))])
-> [State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [NullM (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> DataCon
-> DerivInstTys
-> [State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
foldDataConArgs FFoldType (State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed))))
FFoldType
(State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed)))))
ft_null DataCon
con DerivInstTys
dit
case convert parts of
Maybe [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
Nothing -> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$
HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall (p :: Pass).
IsPass p =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> LocatedE [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
null_match_ctxt ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
nlParPat (DataCon -> LPat (GhcPass 'Parsed)
nlWildConPat DataCon
con)])
LHsExpr (GhcPass 'Parsed)
false_Expr HsLocalBinds (GhcPass 'Parsed)
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds
Just [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
cp -> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_null [] DataCon
con [Maybe (LHsExpr (GhcPass 'Parsed))]
[Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
cp
ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed))))
ft_foldr
= FT { ft_triv :: State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_triv = Maybe (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LHsExpr (GhcPass 'Parsed))
forall a. Maybe a
Nothing
, ft_var :: State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_var = Maybe (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed))))
-> Maybe (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> Maybe (LHsExpr (GhcPass 'Parsed))
forall a. a -> Maybe a
Just LHsExpr (GhcPass 'Parsed)
f_Expr
, ft_tup :: TyCon
-> [State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))]
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_tup = \TyCon
t [State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))]
g -> do
gg <- [State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))]
-> State [RdrName] [Maybe (LHsExpr (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))]
g
lam <- mkSimpleLam2 $ \LHsExpr (GhcPass 'Parsed)
x LHsExpr (GhcPass 'Parsed)
z ->
([LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *) a.
Monad m =>
([LPat (GhcPass 'Parsed)]
-> DataCon
-> [a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [a]
-> LHsExpr (GhcPass 'Parsed)
-> m (LHsExpr (GhcPass 'Parsed))
mkSimpleTupleCase (LHsExpr (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
LHsExpr (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_foldr LHsExpr (GhcPass 'Parsed)
z) TyCon
t [Maybe (LHsExpr (GhcPass 'Parsed))]
gg LHsExpr (GhcPass 'Parsed)
x
return (Just lam)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_ty_app = \Type
_ Type
_ State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
g -> do
gg <- State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
g
mapM (\LocatedA (HsExpr (GhcPass 'Parsed))
gg' -> (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam2 ((LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ \LHsExpr (GhcPass 'Parsed)
x LHsExpr (GhcPass 'Parsed)
z -> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
foldable_foldr_RDR [LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
gg',LHsExpr (GhcPass 'Parsed)
z,LHsExpr (GhcPass 'Parsed)
x]) gg
, ft_forall :: Id
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_forall = \Id
_ State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
g -> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
g
, ft_co_var :: State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_co_var = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"contravariant in ft_foldr"
, ft_fun :: State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_fun = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"function in ft_foldr"
, ft_bad_app :: State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed)))
ft_bad_app = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => 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 :: forall (m :: * -> *).
Monad m =>
LHsExpr (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_foldr LHsExpr (GhcPass 'Parsed)
z = HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
mkSimpleConMatch2 HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
foldr_match_ctxt ((LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ \LHsExpr (GhcPass 'Parsed)
_ [LHsExpr (GhcPass 'Parsed)]
xs -> LocatedA (HsExpr (GhcPass 'Parsed))
-> m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkFoldr [LHsExpr (GhcPass 'Parsed)]
xs)
where
mkFoldr :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldr :: [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkFoldr = (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
z
ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed))))
ft_foldMap
= FT { ft_triv :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_triv = Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. Maybe a
Nothing
, ft_var :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_var = Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (HsExpr (GhcPass 'Parsed))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> Maybe a
Just LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
f_Expr)
, ft_tup :: TyCon
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_tup = \TyCon
t [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
g -> do
gg <- [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
g
lam <- mkSimpleLam $ mkSimpleTupleCase match_foldMap t gg
return (Just lam)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_ty_app = \Type
_ Type
_ State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g -> (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass 'Parsed)
foldMap_Expr) (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g
, ft_forall :: Id
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_forall = \Id
_ State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g -> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g
, ft_co_var :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_co_var = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"contravariant in ft_foldMap"
, ft_fun :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_fun = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"function in ft_foldMap"
, ft_bad_app :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_bad_app = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => 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 :: forall (m :: * -> *).
Monad m =>
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_foldMap = HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
mkSimpleConMatch2 HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
foldMap_match_ctxt ((LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ \LHsExpr (GhcPass 'Parsed)
_ [LHsExpr (GhcPass 'Parsed)]
xs -> LocatedA (HsExpr (GhcPass 'Parsed))
-> m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkFoldMap [LHsExpr (GhcPass 'Parsed)]
xs)
where
mkFoldMap :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkFoldMap :: [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkFoldMap [] = LHsExpr (GhcPass 'Parsed)
mempty_Expr
mkFoldMap [LHsExpr (GhcPass 'Parsed)]
xs = (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\LocatedA (HsExpr (GhcPass 'Parsed))
x LocatedA (HsExpr (GhcPass 'Parsed))
y -> IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
mappend_RDR [LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x,LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y]) [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
xs
ft_null :: FFoldType (State [RdrName] (NullM (LHsExpr GhcPs)))
ft_null :: FFoldType (State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed))))
ft_null
= FT { ft_triv :: State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_triv = NullM (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return NullM (LHsExpr (GhcPass 'Parsed))
forall a. NullM a
IsNull
, ft_var :: State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_var = NullM (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return NullM (LHsExpr (GhcPass 'Parsed))
forall a. NullM a
NotNull
, ft_tup :: TyCon
-> [State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))]
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_tup = \TyCon
t [State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))]
g -> do
gg <- [State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))]
-> State [RdrName] [NullM (LHsExpr (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))]
g
case convert gg of
Maybe [Maybe (LHsExpr (GhcPass 'Parsed))]
Nothing -> NullM (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
forall a. a -> State [RdrName] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NullM (LHsExpr (GhcPass 'Parsed))
forall a. NullM a
NotNull
Just [Maybe (LHsExpr (GhcPass 'Parsed))]
ggg ->
LHsExpr (GhcPass 'Parsed) -> NullM (LHsExpr (GhcPass 'Parsed))
forall a. a -> NullM a
NullM (LHsExpr (GhcPass 'Parsed) -> NullM (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
mkSimpleLam ((LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> (LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ ([LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> LHsExpr (GhcPass 'Parsed)
-> State [RdrName] (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *) a.
Monad m =>
([LPat (GhcPass 'Parsed)]
-> DataCon
-> [a]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> TyCon
-> [a]
-> LHsExpr (GhcPass 'Parsed)
-> m (LHsExpr (GhcPass 'Parsed))
mkSimpleTupleCase [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_null TyCon
t [Maybe (LHsExpr (GhcPass 'Parsed))]
[Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
ggg)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_ty_app = \Type
_ Type
_ State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
g -> ((NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> (NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
(NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> State [RdrName] a -> State [RdrName] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
g ((NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed))))
-> (NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ \NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
nestedResult ->
case NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
nestedResult of
NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
NotNull -> LocatedA (HsExpr (GhcPass 'Parsed))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> NullM a
NullM LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
null_Expr
NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
IsNull -> NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. NullM a
IsNull
NullM LocatedA (HsExpr (GhcPass 'Parsed))
nestedTest -> LocatedA (HsExpr (GhcPass 'Parsed))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> NullM a
NullM (LocatedA (HsExpr (GhcPass 'Parsed))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> NullM (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass 'Parsed)
all_Expr LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
nestedTest
, ft_forall :: Id
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_forall = \Id
_ State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
g -> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
g
, ft_co_var :: State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_co_var = String
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"contravariant in ft_null"
, ft_fun :: State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
-> State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_fun = String
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"function in ft_null"
, ft_bad_app :: State [RdrName] (NullM (LHsExpr (GhcPass 'Parsed)))
ft_bad_app = String
-> State [RdrName] (NullM (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => 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 :: forall (m :: * -> *).
Monad m =>
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_null = HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
mkSimpleConMatch2 HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. HsMatchContext fn
CaseAlt ((LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ \LHsExpr (GhcPass 'Parsed)
_ [LHsExpr (GhcPass 'Parsed)]
xs -> LocatedA (HsExpr (GhcPass 'Parsed))
-> m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkNull [LHsExpr (GhcPass 'Parsed)]
xs)
where
mkNull :: [LHsExpr GhcPs] -> LHsExpr GhcPs
mkNull :: [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkNull [] = LHsExpr (GhcPass 'Parsed)
true_Expr
mkNull [LHsExpr (GhcPass 'Parsed)]
xs = (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\LocatedA (HsExpr (GhcPass 'Parsed))
x LocatedA (HsExpr (GhcPass 'Parsed))
y -> IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
and_RDR [LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x,LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y]) [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
xs
data NullM a =
IsNull
| NotNull
| NullM a
gen_Traversable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Traversable_binds :: SrcSpan
-> DerivInstTys -> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Traversable_binds SrcSpan
loc (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon})
| Role
Phantom <- [Role] -> Role
forall a. HasCallStack => [a] -> a
last (TyCon -> [Role]
tyConRoles TyCon
tycon)
= ([LHsBind (GhcPass 'Parsed)
traverse_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
traverse_name :: GenLocated SrcSpanAnnN RdrName
traverse_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
traverse_RDR
traverse_bind :: LHsBind (GhcPass 'Parsed)
traverse_bind = GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBind GenLocated SrcSpanAnnN RdrName
traverse_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
traverse_eqns
traverse_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
traverse_eqns =
[HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns) =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> LocatedE [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext (LIdP (NoGhcTc (GhcPass 'Parsed)))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
traverse_match_ctxt
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
z_Pat])
(IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
pure_RDR [LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass 'Parsed)
coerce_Expr LHsExpr (GhcPass 'Parsed)
z_Expr])]
traverse_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
traverse_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
traverse_name AnnFunRhs
forall a. NoAnn a => a
noAnn
gen_Traversable_binds SrcSpan
loc dit :: DerivInstTys
dit@(DerivInstTys{ dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon
, dit_rep_tc_args :: DerivInstTys -> [Type]
dit_rep_tc_args = [Type]
tycon_args })
= ([LHsBind (GhcPass 'Parsed)
traverse_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
traverse_name :: GenLocated SrcSpanAnnN RdrName
traverse_name = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
traverse_RDR
traverse_bind :: LHsBind (GhcPass 'Parsed)
traverse_bind = Int
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindEC Int
2 (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass 'Parsed)
pure_Expr)
GenLocated SrcSpanAnnN RdrName
traverse_name [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
traverse_eqns
traverse_eqns :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
traverse_eqns = (DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [DataCon]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
traverse_eqn [DataCon]
data_cons
traverse_eqn :: DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
traverse_eqn DataCon
con
= State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall s a. State s a -> s -> a
evalState ([LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> State
[RdrName] (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con [LPat (GhcPass 'Parsed)
f_Pat] DataCon
con ([Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> State
[RdrName]
(GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts) [RdrName]
bs_RDRs
where
parts :: State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
parts = [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))])
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> a -> b
$ FFoldType
(State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))))
-> DataCon
-> DerivInstTys
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
foldDataConArgs FFoldType (State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed))))
FFoldType
(State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))))
ft_trav DataCon
con DerivInstTys
dit
traverse_match_ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
traverse_match_ctxt = GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
traverse_name AnnFunRhs
forall a. NoAnn a => a
noAnn
ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))
ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr (GhcPass 'Parsed))))
ft_trav
= FT { ft_triv :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_triv = Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. Maybe a
Nothing
, ft_var :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_var = Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. a -> State [RdrName] a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (HsExpr (GhcPass 'Parsed))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> Maybe a
Just LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
f_Expr)
, ft_tup :: TyCon
-> [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_tup = \TyCon
t [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
gs -> do
gg <- [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> State [RdrName] [Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))]
gs
lam <- mkSimpleLam $ mkSimpleTupleCase match_for_con t gg
return (Just lam)
, ft_ty_app :: Type
-> Type
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_ty_app = \Type
_ Type
_ State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g -> (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass 'Parsed)
traverse_Expr) (Maybe (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g
, ft_forall :: Id
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_forall = \Id
_ State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g -> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
g
, ft_co_var :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_co_var = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"contravariant in ft_trav"
, ft_fun :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_fun = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => String -> a
panic String
"function in ft_trav"
, ft_bad_app :: State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
ft_bad_app = String
-> State [RdrName] (Maybe (LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => 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 :: forall (m :: * -> *).
Monad m =>
[LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
match_for_con = HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
Monad m =>
HsMatchContextPs
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
mkSimpleConMatch2 HsMatchContextPs
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
traverse_match_ctxt ((LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> m (LHsExpr (GhcPass 'Parsed)))
-> [LPat (GhcPass 'Parsed)]
-> DataCon
-> [Maybe (LHsExpr (GhcPass 'Parsed))]
-> m (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
\LHsExpr (GhcPass 'Parsed)
con [LHsExpr (GhcPass 'Parsed)]
xs -> LocatedA (HsExpr (GhcPass 'Parsed))
-> m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkApCon LHsExpr (GhcPass 'Parsed)
con [LHsExpr (GhcPass 'Parsed)]
xs)
where
mkApCon :: LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
mkApCon :: LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
mkApCon LHsExpr (GhcPass 'Parsed)
con [] = IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
pure_RDR [LHsExpr (GhcPass 'Parsed)
con]
mkApCon LHsExpr (GhcPass 'Parsed)
con [LHsExpr (GhcPass 'Parsed)
x] = IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
fmap_RDR [LHsExpr (GhcPass 'Parsed)
con,LHsExpr (GhcPass 'Parsed)
x]
mkApCon LHsExpr (GhcPass 'Parsed)
con (LHsExpr (GhcPass 'Parsed)
x1:LHsExpr (GhcPass 'Parsed)
x2:[LHsExpr (GhcPass 'Parsed)]
xs) =
(LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass}.
(IdGhcP p ~ RdrName, IsPass p) =>
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
appAp (IdP (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass 'Parsed)
RdrName
liftA2_RDR [LHsExpr (GhcPass 'Parsed)
con,LHsExpr (GhcPass 'Parsed)
x1,LHsExpr (GhcPass 'Parsed)
x2]) [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
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 IdP (GhcPass p)
RdrName
ap_RDR [LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
x,LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (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 (GhcPass 'Parsed)
f_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
f_RDR
z_Expr :: LHsExpr (GhcPass 'Parsed)
z_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
z_RDR
mempty_Expr :: LHsExpr (GhcPass 'Parsed)
mempty_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
mempty_RDR
foldMap_Expr :: LHsExpr (GhcPass 'Parsed)
foldMap_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
foldMap_RDR
traverse_Expr :: LHsExpr (GhcPass 'Parsed)
traverse_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
traverse_RDR
coerce_Expr :: LHsExpr (GhcPass 'Parsed)
coerce_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (Id -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Id
coerceId)
pure_Expr :: LHsExpr (GhcPass 'Parsed)
pure_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
pure_RDR
true_Expr :: LHsExpr (GhcPass 'Parsed)
true_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
true_RDR
false_Expr :: LHsExpr (GhcPass 'Parsed)
false_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
false_RDR
all_Expr :: LHsExpr (GhcPass 'Parsed)
all_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
all_RDR
null_Expr :: LHsExpr (GhcPass 'Parsed)
null_Expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
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]
++Int -> String
forall a. Show a => a -> String
show Int
i)) | Int
i <- [(Int
1::Int) .. ] ]
bs_RDRs :: [RdrName]
bs_RDRs = [ FastString -> RdrName
mkVarUnqual (String -> FastString
mkFastString (String
"b"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i)) | Int
i <- [(Int
1::Int) .. ] ]
as_Vars, bs_Vars :: [LHsExpr GhcPs]
as_Vars :: [LHsExpr (GhcPass 'Parsed)]
as_Vars = (RdrName -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [RdrName] -> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar [RdrName]
as_RDRs
bs_Vars :: [LHsExpr (GhcPass 'Parsed)]
bs_Vars = (RdrName -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [RdrName] -> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
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 (GhcPass 'Parsed)
f_Pat = IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
f_RDR
z_Pat :: LPat (GhcPass 'Parsed)
z_Pat = IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
z_RDR