{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Tc.Deriv.Generate (
AuxBindSpec(..),
gen_Eq_binds,
gen_Ord_binds,
gen_Enum_binds,
gen_Bounded_binds,
gen_Ix_binds,
gen_Show_binds,
gen_Read_binds,
gen_Data_binds,
gen_Lift_binds,
gen_Newtype_binds,
gen_Newtype_fam_insts,
mkCoerceClassMethEqn,
genAuxBinds,
ordOpTbl, boxConTbl,
mkRdrFunBind, mkRdrFunBindEC, mkRdrFunBindSE, error_Expr,
getPossibleDataCons,
DerivInstTys(..), buildDataConInstArgEnv,
derivDataConInstArgTys, substDerivInstTys, zonkDerivInstTys
) where
import GHC.Prelude
import GHC.Hs
import GHC.Tc.TyCl.Class ( substATBndrs )
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Instantiate( newFamInst )
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.TcType
import GHC.Tc.Zonk.Type
import GHC.Tc.Validity
import GHC.Core.DataCon
import GHC.Core.FamInstEnv
import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom ( coAxiomSingleBranch )
import GHC.Core.Type
import GHC.Core.Class
import GHC.Types.Name.Reader
import GHC.Types.Basic
import GHC.Types.Fixity
import GHC.Types.Name
import GHC.Types.SourceText
import GHC.Types.Id.Make ( coerceId )
import GHC.Types.SrcLoc
import GHC.Types.Unique.FM ( lookupUFM, listToUFM )
import GHC.Types.Var.Env
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Builtin.Names
import GHC.Builtin.Names.TH
import GHC.Builtin.PrimOps
import GHC.Builtin.PrimOps.Ids (primOpId)
import GHC.Builtin.Types.Prim
import GHC.Builtin.Types
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Lexeme
import GHC.Data.FastString
import GHC.Data.Pair
import GHC.Data.Bag
import GHC.Data.Maybe ( expectJust )
import GHC.Unit.Module
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import Data.List ( find, partition, intersperse )
data AuxBindSpec
= DerivTag2Con
TyCon
RdrName
| DerivMaxTag
TyCon
RdrName
| DerivDataDataType
TyCon
RdrName
[RdrName]
| DerivDataConstr
DataCon
RdrName
RdrName
auxBindSpecRdrName :: AuxBindSpec -> RdrName
auxBindSpecRdrName :: AuxBindSpec -> RdrName
auxBindSpecRdrName (DerivTag2Con TyCon
_ RdrName
tag2con_RDR) = RdrName
tag2con_RDR
auxBindSpecRdrName (DerivMaxTag TyCon
_ RdrName
maxtag_RDR) = RdrName
maxtag_RDR
auxBindSpecRdrName (DerivDataDataType TyCon
_ RdrName
dataT_RDR [RdrName]
_) = RdrName
dataT_RDR
auxBindSpecRdrName (DerivDataConstr DataCon
_ RdrName
dataC_RDR RdrName
_) = RdrName
dataC_RDR
gen_Eq_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Eq_binds :: SrcSpan
-> DerivInstTys
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Eq_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 }) = do
([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))],
Bag AuxBindSpec)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))],
Bag AuxBindSpec)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
method_binds, Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
all_cons :: [DataCon]
all_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
non_nullary_cons :: [DataCon]
non_nullary_cons = (DataCon -> Bool) -> [DataCon] -> [DataCon]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (DataCon -> Bool) -> DataCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> Bool
isNullarySrcDataCon) [DataCon]
all_cons
eq_expr_with_tag_check :: LHsExpr (GhcPass 'Parsed)
eq_expr_with_tag_check = LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase
(LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar ([(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR,RdrName
ah_RDR), (RdrName
b_RDR,RdrName
bh_RDR)]
(LHsExpr (GhcPass 'Parsed)
-> IdP (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
ah_RDR) IdP (GhcPass 'Parsed)
RdrName
neInt_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
bh_RDR))))
[ LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (HsLit (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
nlLitPat (XHsIntPrim (GhcPass 'Parsed) -> Integer -> HsLit (GhcPass 'Parsed)
forall x. XHsIntPrim x -> Integer -> HsLit x
HsIntPrim XHsIntPrim (GhcPass 'Parsed)
SourceText
NoSourceText Integer
1)) LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
false_Expr
, LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (
LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase
(IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
a_RDR)
(let non_nullary_pats :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
non_nullary_pats = (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) (LocatedA (HsExpr (GhcPass 'Parsed)))
DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
pats_etc [DataCon]
non_nullary_cons
in if [DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
non_nullary_cons
then [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
non_nullary_pats
else [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
non_nullary_pats [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
true_Expr]))
]
method_binds :: [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
method_binds = [LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
eq_bind]
eq_bind :: LHsBind (GhcPass 'Parsed)
eq_bind = Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
2 SrcSpan
loc RdrName
eq_RDR (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))
true_Expr) [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
[([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
binds
where
binds :: [([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
binds
| [DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
all_cons = []
| [DataCon
data_con] <- [DataCon]
all_cons
, ([RdrName]
as_needed, [RdrName]
bs_needed, [Type]
tys_needed) <- DataCon -> ([RdrName], [RdrName], [Type])
gen_con_fields_and_tys DataCon
data_con
, RdrName
data_con_RDR <- DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con
, LPat (GhcPass 'Parsed)
con1_pat <- LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
nlParPat (LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed))
-> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
as_needed
, LPat (GhcPass 'Parsed)
con2_pat <- LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
nlParPat (LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed))
-> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
bs_needed
, LocatedA (HsExpr (GhcPass 'Parsed))
eq_expr <- [Type]
-> [RdrName] -> [RdrName] -> LocatedA (HsExpr (GhcPass 'Parsed))
nested_eq_expr [Type]
tys_needed [RdrName]
as_needed [RdrName]
bs_needed
= [([LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
con1_pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
con2_pat], LocatedA (HsExpr (GhcPass 'Parsed))
eq_expr)]
| (DataCon -> Bool) -> [DataCon] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DataCon -> Bool
isNullarySrcDataCon [DataCon]
all_cons
= [([LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
a_Pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
b_Pat], [(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR,RdrName
ah_RDR), (RdrName
b_RDR,RdrName
bh_RDR)]
(LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
ah_RDR) RdrName
eqInt_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
bh_RDR)))]
| Bool
otherwise
= [([LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
a_Pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
b_Pat], LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
eq_expr_with_tag_check)]
nested_eq_expr :: [Type] -> [RdrName] -> [RdrName] -> LHsExpr (GhcPass 'Parsed)
nested_eq_expr [] [] [] = LHsExpr (GhcPass 'Parsed)
true_Expr
nested_eq_expr [Type]
tys [RdrName]
as [RdrName]
bs
= (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 LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
and_Expr (String
-> (Type
-> RdrName -> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [Type]
-> [RdrName]
-> [RdrName]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b c d.
HasDebugCallStack =>
String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3Equal String
"nested_eq" Type -> RdrName -> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
nested_eq [Type]
tys [RdrName]
as [RdrName]
bs)
where
nested_eq :: Type -> RdrName -> RdrName -> LHsExpr (GhcPass 'Parsed)
nested_eq Type
ty RdrName
a RdrName
b = LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (Type
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
eq_Expr Type
ty (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
a) (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b))
gen_con_fields_and_tys :: DataCon -> ([RdrName], [RdrName], [Type])
gen_con_fields_and_tys DataCon
data_con
| [Type]
tys_needed <- DataCon -> DerivInstTys -> [Type]
derivDataConInstArgTys DataCon
data_con DerivInstTys
dit
, Int
con_arity <- [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys_needed
, [RdrName]
as_needed <- Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
as_RDRs
, [RdrName]
bs_needed <- Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
bs_RDRs
= ([RdrName]
as_needed, [RdrName]
bs_needed, [Type]
tys_needed)
pats_etc :: DataCon
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
pats_etc DataCon
data_con
| ([RdrName]
as_needed, [RdrName]
bs_needed, [Type]
tys_needed) <- DataCon -> ([RdrName], [RdrName], [Type])
gen_con_fields_and_tys DataCon
data_con
, RdrName
data_con_RDR <- DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con
, LPat (GhcPass 'Parsed)
con1_pat <- LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
nlParPat (LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed))
-> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
as_needed
, LPat (GhcPass 'Parsed)
con2_pat <- LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
nlParPat (LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed))
-> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
bs_needed
, LocatedA (HsExpr (GhcPass 'Parsed))
fields_eq_expr <- [Type]
-> [RdrName] -> [RdrName] -> LocatedA (HsExpr (GhcPass 'Parsed))
nested_eq_expr [Type]
tys_needed [RdrName]
as_needed [RdrName]
bs_needed
= LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
con1_pat (LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
con2_pat LocatedA (HsExpr (GhcPass 'Parsed))
fields_eq_expr])
data OrdOp = OrdCompare | OrdLT | OrdLE | OrdGE | OrdGT
ordMethRdr :: OrdOp -> RdrName
ordMethRdr :: OrdOp -> RdrName
ordMethRdr OrdOp
op
= case OrdOp
op of
OrdOp
OrdCompare -> RdrName
compare_RDR
OrdOp
OrdLT -> RdrName
lt_RDR
OrdOp
OrdLE -> RdrName
le_RDR
OrdOp
OrdGE -> RdrName
ge_RDR
OrdOp
OrdGT -> RdrName
gt_RDR
ltResult :: OrdOp -> LHsExpr GhcPs
ltResult :: OrdOp -> LHsExpr (GhcPass 'Parsed)
ltResult OrdOp
OrdCompare = LHsExpr (GhcPass 'Parsed)
ltTag_Expr
ltResult OrdOp
OrdLT = LHsExpr (GhcPass 'Parsed)
true_Expr
ltResult OrdOp
OrdLE = LHsExpr (GhcPass 'Parsed)
true_Expr
ltResult OrdOp
OrdGE = LHsExpr (GhcPass 'Parsed)
false_Expr
ltResult OrdOp
OrdGT = LHsExpr (GhcPass 'Parsed)
false_Expr
eqResult :: OrdOp -> LHsExpr GhcPs
eqResult :: OrdOp -> LHsExpr (GhcPass 'Parsed)
eqResult OrdOp
OrdCompare = LHsExpr (GhcPass 'Parsed)
eqTag_Expr
eqResult OrdOp
OrdLT = LHsExpr (GhcPass 'Parsed)
false_Expr
eqResult OrdOp
OrdLE = LHsExpr (GhcPass 'Parsed)
true_Expr
eqResult OrdOp
OrdGE = LHsExpr (GhcPass 'Parsed)
true_Expr
eqResult OrdOp
OrdGT = LHsExpr (GhcPass 'Parsed)
false_Expr
gtResult :: OrdOp -> LHsExpr GhcPs
gtResult :: OrdOp -> LHsExpr (GhcPass 'Parsed)
gtResult OrdOp
OrdCompare = LHsExpr (GhcPass 'Parsed)
gtTag_Expr
gtResult OrdOp
OrdLT = LHsExpr (GhcPass 'Parsed)
false_Expr
gtResult OrdOp
OrdLE = LHsExpr (GhcPass 'Parsed)
false_Expr
gtResult OrdOp
OrdGE = LHsExpr (GhcPass 'Parsed)
true_Expr
gtResult OrdOp
OrdGT = LHsExpr (GhcPass 'Parsed)
true_Expr
gen_Ord_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Ord_binds :: SrcSpan
-> DerivInstTys
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Ord_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 }) = do
(LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec))
-> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
forall a b. (a -> b) -> a -> b
$ if [DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
tycon_data_cons
then ( [Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
2 SrcSpan
loc RdrName
compare_RDR (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))
eqTag_Expr) []]
, Bag AuxBindSpec
forall a. Bag a
emptyBag)
else ( [OrdOp -> LHsBind (GhcPass 'Parsed)
mkOrdOp OrdOp
OrdCompare] [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
other_ops
, Bag AuxBindSpec
forall a. Bag a
aux_binds)
where
aux_binds :: Bag a
aux_binds = Bag a
forall a. Bag a
emptyBag
other_ops :: [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
other_ops
| (Int
last_tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first_tag) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2
Bool -> Bool -> Bool
|| [DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
non_nullary_cons
= [OrdOp -> LHsBind (GhcPass 'Parsed)
mkOrdOp OrdOp
OrdLT, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
lE, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
gT, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
gE]
| Bool
otherwise
= []
negate_expr :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
negate_expr = 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
not_RDR)
pats :: GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pats = [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))
a_Pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
b_Pat]
lE :: LHsBind (GhcPass 'Parsed)
lE = SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
le_RDR LocatedE [LPat (GhcPass 'Parsed)]
GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pats (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
negate_expr (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)
-> 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
lt_RDR) LHsExpr (GhcPass 'Parsed)
b_Expr) LHsExpr (GhcPass 'Parsed)
a_Expr)
gT :: LHsBind (GhcPass 'Parsed)
gT = SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
gt_RDR LocatedE [LPat (GhcPass 'Parsed)]
GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pats (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (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)
-> 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
lt_RDR) LHsExpr (GhcPass 'Parsed)
b_Expr) LHsExpr (GhcPass 'Parsed)
a_Expr
gE :: LHsBind (GhcPass 'Parsed)
gE = SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
ge_RDR LocatedE [LPat (GhcPass 'Parsed)]
GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pats (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
negate_expr (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)
-> 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
lt_RDR) LHsExpr (GhcPass 'Parsed)
a_Expr) LHsExpr (GhcPass 'Parsed)
b_Expr)
get_tag :: DataCon -> Int
get_tag DataCon
con = DataCon -> Int
dataConTag DataCon
con Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fIRST_TAG
tycon_data_cons :: [DataCon]
tycon_data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
single_con_type :: Bool
single_con_type = [DataCon] -> Bool
forall a. [a] -> Bool
isSingleton [DataCon]
tycon_data_cons
(DataCon
first_con : [DataCon]
_) = [DataCon]
tycon_data_cons
(DataCon
last_con : [DataCon]
_) = [DataCon] -> [DataCon]
forall a. [a] -> [a]
reverse [DataCon]
tycon_data_cons
first_tag :: Int
first_tag = DataCon -> Int
get_tag DataCon
first_con
last_tag :: Int
last_tag = DataCon -> Int
get_tag DataCon
last_con
([DataCon]
nullary_cons, [DataCon]
non_nullary_cons) = (DataCon -> Bool) -> [DataCon] -> ([DataCon], [DataCon])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition DataCon -> Bool
isNullarySrcDataCon [DataCon]
tycon_data_cons
mkOrdOp :: OrdOp -> LHsBind GhcPs
mkOrdOp :: OrdOp -> LHsBind (GhcPass 'Parsed)
mkOrdOp OrdOp
op
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc (OrdOp -> RdrName
ordMethRdr OrdOp
op) ([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))
a_Pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
b_Pat])
(OrdOp -> LHsExpr (GhcPass 'Parsed)
mkOrdOpRhs OrdOp
op)
mkOrdOpRhs :: OrdOp -> LHsExpr GhcPs
mkOrdOpRhs :: OrdOp -> LHsExpr (GhcPass 'Parsed)
mkOrdOpRhs OrdOp
op
| [DataCon]
nullary_cons [DataCon] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthAtMost` Int
2
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
a_RDR) ([LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed))
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
(DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> [DataCon]
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map (OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkOrdOpAlt OrdOp
op) [DataCon]
tycon_data_cons
| [DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
non_nullary_cons
= OrdOp -> LHsExpr (GhcPass 'Parsed)
mkTagCmp OrdOp
op
| Bool
otherwise
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
a_RDR) ([LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed))
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
((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 (OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkOrdOpAlt OrdOp
op) [DataCon]
non_nullary_cons
[LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (OrdOp -> LHsExpr (GhcPass 'Parsed)
mkTagCmp OrdOp
op)])
mkOrdOpAlt :: OrdOp -> DataCon
-> LMatch GhcPs (LHsExpr GhcPs)
mkOrdOpAlt :: OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkOrdOpAlt OrdOp
op DataCon
data_con
= LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
as_needed)
(OrdOp -> DataCon -> LHsExpr (GhcPass 'Parsed)
mkInnerRhs OrdOp
op DataCon
data_con)
where
as_needed :: [RdrName]
as_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take (DataCon -> Int
dataConSourceArity DataCon
data_con) [RdrName]
as_RDRs
data_con_RDR :: RdrName
data_con_RDR = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con
mkInnerRhs :: OrdOp -> DataCon -> LHsExpr (GhcPass 'Parsed)
mkInnerRhs OrdOp
op DataCon
data_con
| Bool
single_con_type
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [ OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con ]
| Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
first_tag
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [ OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con
, LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (OrdOp -> LHsExpr (GhcPass 'Parsed)
ltResult OrdOp
op) ]
| Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
last_tag
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [ OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con
, LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (OrdOp -> LHsExpr (GhcPass 'Parsed)
gtResult OrdOp
op) ]
| Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
first_tag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [ LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (DataCon -> LPat (GhcPass 'Parsed)
nlConWildPat DataCon
first_con)
(OrdOp -> LHsExpr (GhcPass 'Parsed)
gtResult OrdOp
op)
, OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con
, LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (OrdOp -> LHsExpr (GhcPass 'Parsed)
ltResult OrdOp
op) ]
| Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
last_tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [ LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (DataCon -> LPat (GhcPass 'Parsed)
nlConWildPat DataCon
last_con)
(OrdOp -> LHsExpr (GhcPass 'Parsed)
ltResult OrdOp
op)
, OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con
, LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (OrdOp -> LHsExpr (GhcPass 'Parsed)
gtResult OrdOp
op) ]
| Int
tag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
last_tag Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
= [(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
b_RDR, RdrName
bh_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
bh_RDR) RdrName
ltInt_RDR LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
tag_lit)
(OrdOp -> LHsExpr (GhcPass 'Parsed)
gtResult OrdOp
op) (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [ OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con
, LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (OrdOp -> LHsExpr (GhcPass 'Parsed)
ltResult OrdOp
op) ]
| Bool
otherwise
= [(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
b_RDR, RdrName
bh_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
bh_RDR) RdrName
gtInt_RDR LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
tag_lit)
(OrdOp -> LHsExpr (GhcPass 'Parsed)
ltResult OrdOp
op) (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b_RDR) [ OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con
, LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass 'Parsed)
nlWildPat (OrdOp -> LHsExpr (GhcPass 'Parsed)
gtResult OrdOp
op) ]
where
tag :: Int
tag = DataCon -> Int
get_tag DataCon
data_con
tag_lit :: LocatedA (HsExpr (GhcPass 'Parsed))
tag_lit
= HsExpr (GhcPass 'Parsed) -> LocatedA (HsExpr (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XLitE (GhcPass 'Parsed)
-> HsLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass 'Parsed)
NoExtField
noExtField (XHsIntPrim (GhcPass 'Parsed) -> Integer -> HsLit (GhcPass 'Parsed)
forall x. XHsIntPrim x -> Integer -> HsLit x
HsIntPrim XHsIntPrim (GhcPass 'Parsed)
SourceText
NoSourceText (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
tag)))
mkInnerEqAlt :: OrdOp -> DataCon -> LMatch GhcPs (LHsExpr GhcPs)
mkInnerEqAlt :: OrdOp
-> DataCon -> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mkInnerEqAlt OrdOp
op DataCon
data_con
= LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
bs_needed) (LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
OrdOp -> [Type] -> LHsExpr (GhcPass 'Parsed)
mkCompareFields OrdOp
op (DataCon -> DerivInstTys -> [Type]
derivDataConInstArgTys DataCon
data_con DerivInstTys
dit)
where
data_con_RDR :: RdrName
data_con_RDR = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con
bs_needed :: [RdrName]
bs_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take (DataCon -> Int
dataConSourceArity DataCon
data_con) [RdrName]
bs_RDRs
mkTagCmp :: OrdOp -> LHsExpr GhcPs
mkTagCmp :: OrdOp -> LHsExpr (GhcPass 'Parsed)
mkTagCmp OrdOp
op =
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR),(RdrName
b_RDR, RdrName
bh_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
Type -> OrdOp -> RdrName -> RdrName -> LHsExpr (GhcPass 'Parsed)
unliftedOrdOp Type
intPrimTy OrdOp
op RdrName
ah_RDR RdrName
bh_RDR
mkCompareFields :: OrdOp -> [Type] -> LHsExpr GhcPs
mkCompareFields :: OrdOp -> [Type] -> LHsExpr (GhcPass 'Parsed)
mkCompareFields OrdOp
op [Type]
tys
= [Type]
-> [RdrName] -> [RdrName] -> LocatedA (HsExpr (GhcPass 'Parsed))
go [Type]
tys [RdrName]
as_RDRs [RdrName]
bs_RDRs
where
go :: [Type]
-> [RdrName] -> [RdrName] -> LocatedA (HsExpr (GhcPass 'Parsed))
go [] [RdrName]
_ [RdrName]
_ = OrdOp -> LHsExpr (GhcPass 'Parsed)
eqResult OrdOp
op
go [Type
ty] (RdrName
a:[RdrName]
_) (RdrName
b:[RdrName]
_)
| HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType Type
ty = Type -> OrdOp -> RdrName -> RdrName -> LHsExpr (GhcPass 'Parsed)
unliftedOrdOp Type
ty OrdOp
op RdrName
a RdrName
b
| Bool
otherwise = LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
a) (OrdOp -> RdrName
ordMethRdr OrdOp
op) (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b)
go (Type
ty:[Type]
tys) (RdrName
a:[RdrName]
as) (RdrName
b:[RdrName]
bs) = Type
-> RdrName
-> RdrName
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_compare Type
ty RdrName
a RdrName
b
(OrdOp -> LHsExpr (GhcPass 'Parsed)
ltResult OrdOp
op)
([Type]
-> [RdrName] -> [RdrName] -> LocatedA (HsExpr (GhcPass 'Parsed))
go [Type]
tys [RdrName]
as [RdrName]
bs)
(OrdOp -> LHsExpr (GhcPass 'Parsed)
gtResult OrdOp
op)
go [Type]
_ [RdrName]
_ [RdrName]
_ = String -> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. HasCallStack => String -> a
panic String
"mkCompareFields"
mk_compare :: Type
-> IdGhcP 'Parsed
-> IdGhcP 'Parsed
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
mk_compare Type
ty IdGhcP 'Parsed
a IdGhcP 'Parsed
b LocatedA (HsExpr (GhcPass 'Parsed))
lt LocatedA (HsExpr (GhcPass 'Parsed))
eq LocatedA (HsExpr (GhcPass 'Parsed))
gt
| HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType Type
ty
= RdrName
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
unliftedCompare RdrName
lt_op RdrName
eq_op LHsExpr (GhcPass 'Parsed)
a_expr LHsExpr (GhcPass 'Parsed)
b_expr LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
lt LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
eq LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
gt
| Bool
otherwise
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (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)
-> 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
compare_RDR) LHsExpr (GhcPass 'Parsed)
a_expr) LHsExpr (GhcPass 'Parsed)
b_expr))
[LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (RdrName -> LPat (GhcPass 'Parsed)
nlNullaryConPat RdrName
ltTag_RDR) LocatedA (HsExpr (GhcPass 'Parsed))
lt,
LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (RdrName -> LPat (GhcPass 'Parsed)
nlNullaryConPat RdrName
eqTag_RDR) LocatedA (HsExpr (GhcPass 'Parsed))
eq,
LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (RdrName -> LPat (GhcPass 'Parsed)
nlNullaryConPat RdrName
gtTag_RDR) LocatedA (HsExpr (GhcPass 'Parsed))
gt]
where
a_expr :: LHsExpr (GhcPass 'Parsed)
a_expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
IdGhcP 'Parsed
a
b_expr :: LHsExpr (GhcPass 'Parsed)
b_expr = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
IdGhcP 'Parsed
b
(RdrName
lt_op, RdrName
_, RdrName
eq_op, RdrName
_, RdrName
_) = String -> Type -> (RdrName, RdrName, RdrName, RdrName, RdrName)
primOrdOps String
"Ord" Type
ty
unliftedOrdOp :: Type -> OrdOp -> RdrName -> RdrName -> LHsExpr GhcPs
unliftedOrdOp :: Type -> OrdOp -> RdrName -> RdrName -> LHsExpr (GhcPass 'Parsed)
unliftedOrdOp Type
ty OrdOp
op RdrName
a RdrName
b
= case OrdOp
op of
OrdOp
OrdCompare -> RdrName
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
unliftedCompare RdrName
lt_op RdrName
eq_op LHsExpr (GhcPass 'Parsed)
a_expr LHsExpr (GhcPass 'Parsed)
b_expr
LHsExpr (GhcPass 'Parsed)
ltTag_Expr LHsExpr (GhcPass 'Parsed)
eqTag_Expr LHsExpr (GhcPass 'Parsed)
gtTag_Expr
OrdOp
OrdLT -> RdrName -> LHsExpr (GhcPass 'Parsed)
wrap RdrName
lt_op
OrdOp
OrdLE -> RdrName -> LHsExpr (GhcPass 'Parsed)
wrap RdrName
le_op
OrdOp
OrdGE -> RdrName -> LHsExpr (GhcPass 'Parsed)
wrap RdrName
ge_op
OrdOp
OrdGT -> RdrName -> LHsExpr (GhcPass 'Parsed)
wrap RdrName
gt_op
where
(RdrName
lt_op, RdrName
le_op, RdrName
eq_op, RdrName
ge_op, RdrName
gt_op) = String -> Type -> (RdrName, RdrName, RdrName, RdrName, RdrName)
primOrdOps String
"Ord" Type
ty
wrap :: RdrName -> LHsExpr (GhcPass 'Parsed)
wrap RdrName
prim_op = LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp LHsExpr (GhcPass 'Parsed)
a_expr RdrName
prim_op LHsExpr (GhcPass 'Parsed)
b_expr
a_expr :: LHsExpr (GhcPass 'Parsed)
a_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
a
b_expr :: LHsExpr (GhcPass 'Parsed)
b_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
b
unliftedCompare :: RdrName -> RdrName
-> LHsExpr GhcPs -> LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
-> LHsExpr GhcPs
unliftedCompare :: RdrName
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
unliftedCompare RdrName
lt_op RdrName
eq_op LHsExpr (GhcPass 'Parsed)
a_expr LHsExpr (GhcPass 'Parsed)
b_expr LHsExpr (GhcPass 'Parsed)
lt LHsExpr (GhcPass 'Parsed)
eq LHsExpr (GhcPass 'Parsed)
gt
= LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
ascribeBool (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp LHsExpr (GhcPass 'Parsed)
a_expr RdrName
lt_op LHsExpr (GhcPass 'Parsed)
b_expr) LHsExpr (GhcPass 'Parsed)
lt (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
ascribeBool (LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp LHsExpr (GhcPass 'Parsed)
a_expr RdrName
eq_op LHsExpr (GhcPass 'Parsed)
b_expr) LHsExpr (GhcPass 'Parsed)
eq LHsExpr (GhcPass 'Parsed)
gt
where
ascribeBool :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
ascribeBool = RdrName -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
nlAscribe RdrName
boolTyCon_RDR
nlConWildPat :: DataCon -> LPat GhcPs
nlConWildPat :: DataCon -> LPat (GhcPass 'Parsed)
nlConWildPat DataCon
con = Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat (GhcPass 'Parsed)
pat_con_ext = XConPat (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn
, pat_con :: XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
pat_con = RdrName -> GenLocated SrcSpanAnnN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
con
, pat_args :: HsConPatDetails (GhcPass 'Parsed)
pat_args = HsRecFields (GhcPass 'Parsed) (LPat (GhcPass 'Parsed))
-> HsConPatDetails (GhcPass 'Parsed)
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon (HsRecFields (GhcPass 'Parsed) (LPat (GhcPass 'Parsed))
-> HsConPatDetails (GhcPass 'Parsed))
-> HsRecFields (GhcPass 'Parsed) (LPat (GhcPass 'Parsed))
-> HsConPatDetails (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsRecFields
{ rec_ext :: XHsRecFields (GhcPass 'Parsed)
rec_ext = NoExtField
XHsRecFields (GhcPass 'Parsed)
noExtField
, rec_flds :: [LHsRecField (GhcPass 'Parsed) (LPat (GhcPass 'Parsed))]
rec_flds = []
, rec_dotdot :: Maybe (XRec (GhcPass 'Parsed) RecFieldsDotDot)
rec_dotdot = Maybe (XRec (GhcPass 'Parsed) RecFieldsDotDot)
forall a. Maybe a
Nothing }
}
gen_Enum_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Enum_binds :: SrcSpan
-> DerivInstTys
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Enum_binds SrcSpan
loc (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon}) = do
tag2con_RDR <- SrcSpan -> TyCon -> TcM RdrName
new_tag2con_rdr_name SrcSpan
loc TyCon
tycon
maxtag_RDR <- new_maxtag_rdr_name loc tycon
return ( method_binds tag2con_RDR maxtag_RDR
, aux_binds tag2con_RDR maxtag_RDR )
where
method_binds :: RdrName
-> RdrName
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
method_binds RdrName
tag2con_RDR RdrName
maxtag_RDR =
[ RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
succ_enum RdrName
tag2con_RDR RdrName
maxtag_RDR
, RdrName -> LHsBind (GhcPass 'Parsed)
pred_enum RdrName
tag2con_RDR
, RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
to_enum RdrName
tag2con_RDR RdrName
maxtag_RDR
, RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
enum_from RdrName
tag2con_RDR RdrName
maxtag_RDR
, RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
enum_from_then RdrName
tag2con_RDR RdrName
maxtag_RDR
, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
from_enum
]
aux_binds :: RdrName -> RdrName -> Bag AuxBindSpec
aux_binds RdrName
tag2con_RDR RdrName
maxtag_RDR = [AuxBindSpec] -> Bag AuxBindSpec
forall a. [a] -> Bag a
listToBag
[ TyCon -> RdrName -> AuxBindSpec
DerivTag2Con TyCon
tycon RdrName
tag2con_RDR
, TyCon -> RdrName -> AuxBindSpec
DerivMaxTag TyCon
tycon RdrName
maxtag_RDR
]
occ_nm :: String
occ_nm = TyCon -> String
forall a. NamedThing a => a -> String
getOccString TyCon
tycon
succ_enum :: RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
succ_enum RdrName
tag2con_RDR RdrName
maxtag_RDR
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
succ_RDR ([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))
a_Pat]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (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
eq_RDR [IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
maxtag_RDR,
IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_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 (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
succError_RDR) (HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
occ_nm)))
(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
tag2con_RDR)
(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
plus_RDR [IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_RDR],
Integer -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
1]))
pred_enum :: RdrName -> LHsBind (GhcPass 'Parsed)
pred_enum RdrName
tag2con_RDR
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
pred_RDR ([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))
a_Pat]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (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
eq_RDR [Integer -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
0,
IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_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 (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
predError_RDR) (HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
occ_nm)))
(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
tag2con_RDR)
(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
plus_RDR
[ IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_RDR]
, HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (XHsInt (GhcPass 'Parsed) -> IntegralLit -> HsLit (GhcPass 'Parsed)
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt (GhcPass 'Parsed)
NoExtField
noExtField
(Int -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit (-Int
1 :: Int)))]))
to_enum :: RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
to_enum RdrName
tag2con_RDR RdrName
maxtag_RDR
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
toEnum_RDR ([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))
a_Pat]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
let to_word :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
to_word = 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
enumIntToWord_RDR)
in LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (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
le_RDR [ LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
to_word (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
a_RDR), LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
to_word (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
maxtag_RDR)])
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
tag2con_RDR [IdP (GhcPass 'Parsed)
RdrName
a_RDR])
(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
toEnumError_RDR
[ HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
occ_nm)
, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
a_RDR
, [LHsExpr (GhcPass 'Parsed)]
-> XExplicitTuple (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsTupleExpr [Integer -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
0, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
maxtag_RDR] (EpaLocation, EpaLocation)
XExplicitTuple (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn
])
enum_from :: RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
enum_from RdrName
tag2con_RDR RdrName
maxtag_RDR
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
enumFrom_RDR ([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))
a_Pat]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> 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
map_RDR
[IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
tag2con_RDR,
LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
enum_from_to_Expr
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_RDR])
(IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
maxtag_RDR))]
enum_from_then :: RdrName -> RdrName -> LHsBind (GhcPass 'Parsed)
enum_from_then RdrName
tag2con_RDR RdrName
maxtag_RDR
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
enumFromThen_RDR ([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))
a_Pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
b_Pat]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR), (RdrName
b_RDR, RdrName
bh_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> 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 (IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
map_RDR [IdP (GhcPass 'Parsed)
RdrName
tag2con_RDR]) (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
enum_from_then_to_Expr
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_RDR])
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
bh_RDR])
(LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsIf (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
gt_RDR [IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_RDR],
IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
bh_RDR]])
(Integer -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
0)
(IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
maxtag_RDR)
))
from_enum :: LHsBind (GhcPass 'Parsed)
from_enum
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
fromEnum_RDR ([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))
a_Pat]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_RDR])
gen_Bounded_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Bounded_binds :: SrcSpan
-> DerivInstTys -> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Bounded_binds SrcSpan
loc (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon})
| TyCon -> Bool
isEnumerationTyCon TyCon
tycon
= ([ LHsBind (GhcPass 'Parsed)
min_bound_enum, LHsBind (GhcPass 'Parsed)
max_bound_enum ], Bag AuxBindSpec
forall a. Bag a
emptyBag)
| Bool
otherwise
= Bool
-> ([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))],
Bag AuxBindSpec)
-> ([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))],
Bag AuxBindSpec)
forall a. HasCallStack => Bool -> a -> a
assert ([DataCon] -> Bool
forall a. [a] -> Bool
isSingleton [DataCon]
data_cons)
([ LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
min_bound_1con, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
max_bound_1con ], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [DataCon]
tyConDataCons TyCon
tycon
min_bound_enum :: LHsBind (GhcPass 'Parsed)
min_bound_enum = SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
minBound_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
data_con_1_RDR)
max_bound_enum :: LHsBind (GhcPass 'Parsed)
max_bound_enum = SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
maxBound_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
data_con_N_RDR)
data_con_1 :: DataCon
data_con_1 = [DataCon] -> DataCon
forall a. HasCallStack => [a] -> a
head [DataCon]
data_cons
data_con_N :: DataCon
data_con_N = [DataCon] -> DataCon
forall a. HasCallStack => [a] -> a
last [DataCon]
data_cons
data_con_1_RDR :: RdrName
data_con_1_RDR = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con_1
data_con_N_RDR :: RdrName
data_con_N_RDR = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con_N
arity :: Int
arity = DataCon -> Int
dataConSourceArity DataCon
data_con_1
min_bound_1con :: LHsBind (GhcPass 'Parsed)
min_bound_1con = SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
minBound_RDR (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
data_con_1_RDR (Int -> RdrName -> [RdrName]
forall a. Int -> a -> [a]
replicate Int
arity RdrName
minBound_RDR)
max_bound_1con :: LHsBind (GhcPass 'Parsed)
max_bound_1con = SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
maxBound_RDR (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
data_con_1_RDR (Int -> RdrName -> [RdrName]
forall a. Int -> a -> [a]
replicate Int
arity RdrName
maxBound_RDR)
gen_Ix_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Ix_binds :: SrcSpan
-> DerivInstTys
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Ix_binds SrcSpan
loc (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon}) = do
tag2con_RDR <- SrcSpan -> TyCon -> TcM RdrName
new_tag2con_rdr_name SrcSpan
loc TyCon
tycon
return $ if isEnumerationTyCon tycon
then (enum_ixes tag2con_RDR, listToBag
[ DerivTag2Con tycon tag2con_RDR
])
else (single_con_ixes, emptyBag)
where
enum_ixes :: RdrName
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
enum_ixes RdrName
tag2con_RDR =
[ RdrName -> LHsBind (GhcPass 'Parsed)
enum_range RdrName
tag2con_RDR
, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
enum_index
, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
enum_inRange
]
enum_range :: RdrName -> LHsBind (GhcPass 'Parsed)
enum_range RdrName
tag2con_RDR
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
range_RDR ([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)] -> Boxity -> LPat (GhcPass 'Parsed)
nlTuplePat [LPat (GhcPass 'Parsed)
a_Pat, LPat (GhcPass 'Parsed)
b_Pat] Boxity
Boxed]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
b_RDR, RdrName
bh_RDR)] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> 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 (IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
map_RDR [IdP (GhcPass 'Parsed)
RdrName
tag2con_RDR]) (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
enum_from_to_Expr
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
ah_RDR])
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
bh_RDR]))
enum_index :: LHsBind (GhcPass 'Parsed)
enum_index
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
unsafeIndex_RDR
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XAsPat (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed)
-> Pat (GhcPass 'Parsed)
forall p. XAsPat p -> LIdP p -> LPat p -> Pat p
AsPat XAsPat (GhcPass 'Parsed)
EpToken "@"
forall a. NoAnn a => a
noAnn (RdrName -> GenLocated SrcSpanAnnN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA RdrName
c_RDR)
([LPat (GhcPass 'Parsed)] -> Boxity -> LPat (GhcPass 'Parsed)
nlTuplePat [LPat (GhcPass 'Parsed)
a_Pat, LPat (GhcPass 'Parsed)
nlWildPat] Boxity
Boxed)),
LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
d_Pat]) (
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR)] (
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
d_RDR, RdrName
dh_RDR)] (
let
rhs :: LHsExpr (GhcPass 'Parsed)
rhs = IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
intDataCon_RDR [IdP (GhcPass 'Parsed)
RdrName
c_RDR]
in
LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase
(LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
dh_RDR) RdrName
minusInt_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
ah_RDR))
[LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
c_RDR) LocatedA (HsExpr (GhcPass 'Parsed))
rhs]
))
)
enum_inRange :: LHsBind (GhcPass 'Parsed)
enum_inRange
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
inRange_RDR ([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)] -> Boxity -> LPat (GhcPass 'Parsed)
nlTuplePat [LPat (GhcPass 'Parsed)
a_Pat, LPat (GhcPass 'Parsed)
b_Pat] Boxity
Boxed, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
c_Pat]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
a_RDR, RdrName
ah_RDR)] (
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
b_RDR, RdrName
bh_RDR)] (
[(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName
c_RDR, RdrName
ch_RDR)] (
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)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
ch_RDR) RdrName
geInt_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
ah_RDR)
, LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
ch_RDR) RdrName
leInt_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
bh_RDR)
]
)))
single_con_ixes :: [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
single_con_ixes
= [LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
single_con_range, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
single_con_index, LHsBind (GhcPass 'Parsed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
single_con_inRange]
data_con :: DataCon
data_con
= case TyCon -> Maybe DataCon
tyConSingleDataCon_maybe TyCon
tycon of
Maybe DataCon
Nothing -> String -> DataCon
forall a. HasCallStack => String -> a
panic String
"get_Ix_binds"
Just DataCon
dc -> DataCon
dc
con_arity :: Int
con_arity = DataCon -> Int
dataConSourceArity DataCon
data_con
data_con_RDR :: RdrName
data_con_RDR = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con
as_needed :: [RdrName]
as_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
as_RDRs
bs_needed :: [RdrName]
bs_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
bs_RDRs
cs_needed :: [RdrName]
cs_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
cs_RDRs
con_pat :: [RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
xs = RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
xs
con_expr :: LHsExpr (GhcPass 'Parsed)
con_expr = IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
data_con_RDR [IdP (GhcPass 'Parsed)]
[RdrName]
cs_needed
single_con_range :: LHsBind (GhcPass 'Parsed)
single_con_range
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
range_RDR
([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)] -> Boxity -> LPat (GhcPass 'Parsed)
nlTuplePat [[RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
as_needed, [RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
bs_needed] Boxity
Boxed]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
HsExpr (GhcPass 'Parsed) -> LocatedA (HsExpr (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (HsDoFlavour
-> [ExprLStmt (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
mkHsComp HsDoFlavour
ListComp [ExprLStmt (GhcPass 'Parsed)]
[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
stmts LHsExpr (GhcPass 'Parsed)
con_expr)
where
stmts :: [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
stmts = String
-> (RdrName
-> RdrName
-> RdrName
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> [RdrName]
-> [RdrName]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b c d.
HasDebugCallStack =>
String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3Equal String
"single_con_range" RdrName
-> RdrName
-> RdrName
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e}.
HasAnnotation e =>
RdrName
-> RdrName
-> RdrName
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
mk_qual [RdrName]
as_needed [RdrName]
bs_needed [RdrName]
cs_needed
mk_qual :: RdrName
-> RdrName
-> RdrName
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
mk_qual RdrName
a RdrName
b RdrName
c = StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ EpUniToken "<-" "\8592"
-> LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
forall (bodyR :: * -> *).
EpUniToken "<-" "\8592"
-> LPat (GhcPass 'Parsed)
-> LocatedA (bodyR (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (bodyR (GhcPass 'Parsed)))
mkPsBindStmt EpUniToken "<-" "\8592"
forall a. NoAnn a => a
noAnn (IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
c)
(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
range_RDR)
([IdP (GhcPass 'Parsed)]
-> XExplicitTuple (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsVarTuple [IdP (GhcPass 'Parsed)
RdrName
a,IdP (GhcPass 'Parsed)
RdrName
b] (EpaLocation, EpaLocation)
XExplicitTuple (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn))
single_con_index :: LHsBind (GhcPass 'Parsed)
single_con_index
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
unsafeIndex_RDR
([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)] -> Boxity -> LPat (GhcPass 'Parsed)
nlTuplePat [[RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
as_needed, [RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
bs_needed] Boxity
Boxed,
[RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
cs_needed])
([(RdrName, RdrName, RdrName)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_index ([(RdrName, RdrName, RdrName)] -> [(RdrName, RdrName, RdrName)]
forall a. [a] -> [a]
reverse ([(RdrName, RdrName, RdrName)] -> [(RdrName, RdrName, RdrName)])
-> [(RdrName, RdrName, RdrName)] -> [(RdrName, RdrName, RdrName)]
forall a b. (a -> b) -> a -> b
$ [RdrName]
-> [RdrName] -> [RdrName] -> [(RdrName, RdrName, RdrName)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [RdrName]
as_needed [RdrName]
bs_needed [RdrName]
cs_needed))
where
mk_index :: [(RdrName, RdrName, RdrName)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_index [] = Integer -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
0
mk_index [(RdrName
l,RdrName
u,RdrName
i)] = RdrName
-> RdrName -> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass}.
(IdGhcP p ~ RdrName, NoAnn (XExplicitTuple (GhcPass p)),
IsPass p) =>
RdrName
-> RdrName
-> RdrName
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
mk_one RdrName
l RdrName
u RdrName
i
mk_index ((RdrName
l,RdrName
u,RdrName
i) : [(RdrName, RdrName, RdrName)]
rest)
= LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp (
RdrName
-> RdrName -> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass}.
(IdGhcP p ~ RdrName, NoAnn (XExplicitTuple (GhcPass p)),
IsPass p) =>
RdrName
-> RdrName
-> RdrName
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
mk_one RdrName
l RdrName
u RdrName
i
) RdrName
plus_RDR (
LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp (
(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
unsafeRangeSize_RDR)
([IdP (GhcPass 'Parsed)]
-> XExplicitTuple (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsVarTuple [IdP (GhcPass 'Parsed)
RdrName
l,IdP (GhcPass 'Parsed)
RdrName
u] (EpaLocation, EpaLocation)
XExplicitTuple (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn))
) RdrName
times_RDR ([(RdrName, RdrName, RdrName)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_index [(RdrName, RdrName, RdrName)]
rest)
)
mk_one :: RdrName -> RdrName -> RdrName -> LHsExpr (GhcPass p)
mk_one RdrName
l RdrName
u RdrName
i
= 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
unsafeIndex_RDR [[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsVarTuple [IdP (GhcPass p)
RdrName
l,IdP (GhcPass p)
RdrName
u] XExplicitTuple (GhcPass p)
forall a. NoAnn a => a
noAnn, IdP (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass p)
RdrName
i]
single_con_inRange :: LHsBind (GhcPass 'Parsed)
single_con_inRange
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
inRange_RDR
([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)] -> Boxity -> LPat (GhcPass 'Parsed)
nlTuplePat [[RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
as_needed, [RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
bs_needed] Boxity
Boxed,
[RdrName] -> LPat (GhcPass 'Parsed)
con_pat [RdrName]
cs_needed]) (LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
if Int
con_arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then LHsExpr (GhcPass 'Parsed)
true_Expr
else (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
foldl1 LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
and_Expr (String
-> (RdrName
-> RdrName -> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> [RdrName]
-> [RdrName]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b c d.
HasDebugCallStack =>
String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3Equal String
"single_con_inRange" RdrName
-> RdrName -> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass}.
(IdGhcP p ~ RdrName, NoAnn (XExplicitTuple (GhcPass p)),
IsPass p) =>
RdrName
-> RdrName
-> RdrName
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
in_range
[RdrName]
as_needed [RdrName]
bs_needed [RdrName]
cs_needed)
where
in_range :: RdrName -> RdrName -> RdrName -> LHsExpr (GhcPass p)
in_range RdrName
a RdrName
b RdrName
c
= 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
inRange_RDR [[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsVarTuple [IdP (GhcPass p)
RdrName
a,IdP (GhcPass p)
RdrName
b] XExplicitTuple (GhcPass p)
forall a. NoAnn a => a
noAnn, IdP (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass p)
RdrName
c]
gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> DerivInstTys
-> (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Read_binds :: (Name -> Fixity)
-> SrcSpan
-> DerivInstTys
-> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Read_binds Name -> Fixity
get_fixity SrcSpan
loc dit :: DerivInstTys
dit@(DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
tycon})
= ([LHsBind (GhcPass 'Parsed)
read_prec, LHsBind (GhcPass 'Parsed)
default_readlist, LHsBind (GhcPass 'Parsed)
default_readlistprec], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
default_readlist :: LHsBind (GhcPass 'Parsed)
default_readlist
= SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
readList_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
readListDefault_RDR)
default_readlistprec :: LHsBind (GhcPass 'Parsed)
default_readlistprec
= SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
readListPrec_RDR (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
readListPrecDefault_RDR)
data_cons :: [DataCon]
data_cons = TyCon -> [DataCon]
tyConDataCons TyCon
tycon
([DataCon]
nullary_cons, [DataCon]
non_nullary_cons) = (DataCon -> Bool) -> [DataCon] -> ([DataCon], [DataCon])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition DataCon -> Bool
isNullarySrcDataCon [DataCon]
data_cons
read_prec :: LHsBind (GhcPass 'Parsed)
read_prec = SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
readPrec_RDR LHsExpr (GhcPass 'Parsed)
rhs
where
rhs :: LHsExpr (GhcPass 'Parsed)
rhs | [DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
data_cons
= IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
pfail_RDR
| Bool
otherwise
= 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
parens_RDR)
((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))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_alt ([LocatedA (HsExpr (GhcPass 'Parsed))]
read_nullary_cons [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++
[LocatedA (HsExpr (GhcPass 'Parsed))]
read_non_nullary_cons))
read_non_nullary_cons :: [LocatedA (HsExpr (GhcPass 'Parsed))]
read_non_nullary_cons = (DataCon -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [DataCon] -> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
read_non_nullary_con [DataCon]
non_nullary_cons
read_nullary_cons :: [LocatedA (HsExpr (GhcPass 'Parsed))]
read_nullary_cons
= case [DataCon]
nullary_cons of
[] -> []
[DataCon
con] -> [HsDoFlavour
-> [ExprLStmt (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
nlHsDo (Maybe ModuleName -> HsDoFlavour
DoExpr Maybe ModuleName
forall a. Maybe a
Nothing) (DataCon
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall {a} {e} {idL :: Pass}.
(NamedThing a, HasAnnotation e) =>
a
-> [GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
match_con DataCon
con [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
LocatedA (bodyR (GhcPass idR))
-> StmtLR
(GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkLastStmt (DataCon -> [RdrName] -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {id :: Pass} {thing}.
(IdGhcP id ~ RdrName, NamedThing thing, IsPass id) =>
thing -> [RdrName] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
result_expr DataCon
con [])])]
[DataCon]
_ -> [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
choose_RDR)
([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
nlList ((DataCon -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [DataCon] -> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass} {thing}.
(IdGhcP p ~ RdrName, NamedThing thing,
NoAnn (XExplicitTuple (GhcPass p)), IsPass p) =>
thing -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
mk_pair [DataCon]
nullary_cons))]
match_con :: a
-> [GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
match_con a
con | String -> Bool
isSym String
con_str = [String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
symbol_pat String
con_str]
| Bool
otherwise = String
-> [GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> [GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
ident_h_pat String
con_str
where
con_str :: String
con_str = a -> String
forall a. NamedThing a => a -> String
data_con_str a
con
mk_pair :: thing -> LHsExpr (GhcPass p)
mk_pair thing
con = [LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsTupleExpr [HsLit (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass p)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString (thing -> String
forall a. NamedThing a => a -> String
data_con_str thing
con)),
thing -> [RdrName] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall {id :: Pass} {thing}.
(IdGhcP id ~ RdrName, NamedThing thing, IsPass id) =>
thing -> [RdrName] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
result_expr thing
con []] XExplicitTuple (GhcPass p)
forall a. NoAnn a => a
noAnn
read_non_nullary_con :: DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
read_non_nullary_con DataCon
data_con
| Bool
is_infix = Integer
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_parser Integer
infix_prec [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
infix_stmts LocatedA (HsExpr (GhcPass 'Parsed))
body
| Bool
is_record = Integer
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_parser Integer
record_prec [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
record_stmts LocatedA (HsExpr (GhcPass 'Parsed))
body
| Bool
otherwise = LocatedA (HsExpr (GhcPass 'Parsed))
prefix_parser
where
body :: LocatedA (HsExpr (GhcPass 'Parsed))
body = DataCon -> [RdrName] -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {id :: Pass} {thing}.
(IdGhcP id ~ RdrName, NamedThing thing, IsPass id) =>
thing -> [RdrName] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
result_expr DataCon
data_con [RdrName]
as_needed
con_str :: String
con_str = DataCon -> String
forall a. NamedThing a => a -> String
data_con_str DataCon
data_con
prefix_parser :: LocatedA (HsExpr (GhcPass 'Parsed))
prefix_parser = Integer
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
mk_parser Integer
prefix_prec [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
prefix_stmts LocatedA (HsExpr (GhcPass 'Parsed))
body
read_prefix_con :: [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_prefix_con
| String -> Bool
isSym String
con_str = [String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
"(", String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
symbol_pat String
con_str, String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
")"]
| Bool
otherwise = String
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> [GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
ident_h_pat String
con_str
read_infix_con :: [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_infix_con
| String -> Bool
isSym String
con_str = [String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
symbol_pat String
con_str]
| Bool
otherwise = [String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
"`"] [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ String
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> [GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
ident_h_pat String
con_str [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
"`"]
prefix_stmts :: [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
prefix_stmts
= [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_prefix_con [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_args
infix_stmts :: [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
infix_stmts
= [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_a1]
[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_infix_con
[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_a2]
record_stmts :: [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
record_stmts
= [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_prefix_con
[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
"{"]
[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]]
forall a. a -> [a] -> [a]
intersperse [String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
","] [[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]]
field_stmts)
[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [String
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
"}"]
field_stmts :: [[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]]
field_stmts = String
-> (FastString
-> RdrName
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))])
-> [FastString]
-> [RdrName]
-> [[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]]
forall a b c.
HasDebugCallStack =>
String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"lbl_stmts" FastString
-> RdrName
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall {e}.
HasAnnotation e =>
FastString
-> RdrName
-> [GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_field [FastString]
labels [RdrName]
as_needed
con_arity :: Int
con_arity = DataCon -> Int
dataConSourceArity DataCon
data_con
labels :: [FastString]
labels = (FieldLabel -> FastString) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (FieldLabelString -> FastString
field_label (FieldLabelString -> FastString)
-> (FieldLabel -> FieldLabelString) -> FieldLabel -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel) ([FieldLabel] -> [FastString]) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> a -> b
$ DataCon -> [FieldLabel]
dataConFieldLabels DataCon
data_con
dc_nm :: Name
dc_nm = DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
data_con
is_infix :: Bool
is_infix = DataCon -> Bool
dataConIsInfix DataCon
data_con
is_record :: Bool
is_record = [FastString]
labels [FastString] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthExceeds` Int
0
as_needed :: [RdrName]
as_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
as_RDRs
read_args :: [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_args = String
-> (RdrName
-> Type
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> [RdrName]
-> [Type]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b c.
HasDebugCallStack =>
String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"gen_Read_binds" RdrName
-> Type
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e}.
HasAnnotation e =>
RdrName
-> Type
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_arg [RdrName]
as_needed (DataCon -> DerivInstTys -> [Type]
derivDataConInstArgTys DataCon
data_con DerivInstTys
dit)
(GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_a1:GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_a2:[GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
_) = [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_args
prefix_prec :: Integer
prefix_prec = Integer
appPrecedence
infix_prec :: Integer
infix_prec = (Name -> Fixity) -> Name -> Integer
getPrecedence Name -> Fixity
get_fixity Name
dc_nm
record_prec :: Integer
record_prec = Integer
appPrecedence Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
mk_alt :: LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed)) -> LHsExpr (GhcPass 'Parsed)
mk_alt LocatedA (HsExpr (GhcPass 'Parsed))
e1 LocatedA (HsExpr (GhcPass 'Parsed))
e2 = LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e1 RdrName
alt_RDR LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e2
mk_parser :: Integer
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
mk_parser Integer
p [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
ss LocatedA (HsExpr (GhcPass 'Parsed))
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
prec_RDR [Integer -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
p
, HsDoFlavour
-> [ExprLStmt (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
nlHsDo (Maybe ModuleName -> HsDoFlavour
DoExpr Maybe ModuleName
forall a. Maybe a
Nothing) ([GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
ss [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
SrcSpanAnnA
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
LocatedA (bodyR (GhcPass idR))
-> StmtLR
(GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkLastStmt LocatedA (HsExpr (GhcPass 'Parsed))
b])]
con_app :: thing -> [RdrName] -> LHsExpr (GhcPass p)
con_app thing
con [RdrName]
as = IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps (thing -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName thing
con) [IdP (GhcPass p)]
[RdrName]
as
result_expr :: thing -> [RdrName] -> LHsExpr (GhcPass id)
result_expr thing
con [RdrName]
as = LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (IdP (GhcPass id) -> LHsExpr (GhcPass id)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass id)
RdrName
returnM_RDR) (thing -> [RdrName] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
forall {id :: Pass} {thing}.
(IdGhcP id ~ RdrName, NamedThing thing, IsPass id) =>
thing -> [RdrName] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
con_app thing
con [RdrName]
as)
ident_h_pat :: String
-> [GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
ident_h_pat String
s | Just (String
ss, Char
'#') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
snocView String
s = [ String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
ident_pat String
ss, String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
symbol_pat String
"#" ]
| Bool
otherwise = [ String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
ident_pat String
s ]
bindLex :: LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
bindLex LocatedA (HsExpr (GhcPass 'Parsed))
pat = StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
forall (bodyR :: * -> *) (idL :: Pass).
LocatedA (bodyR (GhcPass 'Parsed))
-> StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (bodyR (GhcPass 'Parsed)))
mkBodyStmt (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
expectP_RDR) LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
pat))
ident_pat :: String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
ident_pat String
s = LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
bindLex (LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (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
ident_RDR [HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
s)]
symbol_pat :: String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
symbol_pat String
s = LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
bindLex (LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (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
symbol_RDR [HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
s)]
read_punc :: String
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_punc String
c = LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall {e} {idL :: Pass}.
HasAnnotation e =>
LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
bindLex (LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> GenLocated
e
(StmtLR
(GhcPass idL)
(GhcPass 'Parsed)
(LocatedA (HsExpr (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
punc_RDR [HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
c)]
data_con_str :: a -> String
data_con_str a
con = OccName -> String
occNameString (a -> OccName
forall a. NamedThing a => a -> OccName
getOccName a
con)
read_arg :: RdrName
-> Type
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
read_arg RdrName
a Type
ty = Bool
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType Type
ty)) (GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$
StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (EpUniToken "<-" "\8592"
-> LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
forall (bodyR :: * -> *).
EpUniToken "<-" "\8592"
-> LPat (GhcPass 'Parsed)
-> LocatedA (bodyR (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (bodyR (GhcPass 'Parsed)))
mkPsBindStmt EpUniToken "<-" "\8592"
forall a. NoAnn a => a
noAnn (IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
a) (IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
step_RDR [IdP (GhcPass 'Parsed)
RdrName
readPrec_RDR]))
read_field :: FastString
-> RdrName
-> [GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))]
read_field FastString
lbl RdrName
a =
[StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
e
(StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed))))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA
(EpUniToken "<-" "\8592"
-> LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (HsExpr (GhcPass 'Parsed)))
forall (bodyR :: * -> *).
EpUniToken "<-" "\8592"
-> LPat (GhcPass 'Parsed)
-> LocatedA (bodyR (GhcPass 'Parsed))
-> StmtLR
(GhcPass 'Parsed)
(GhcPass 'Parsed)
(LocatedA (bodyR (GhcPass 'Parsed)))
mkPsBindStmt EpUniToken "<-" "\8592"
forall a. NoAnn a => a
noAnn
(IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
a)
(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)
LocatedA (HsExpr (GhcPass 'Parsed))
read_field
(IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
reset_RDR [IdP (GhcPass 'Parsed)
RdrName
readPrec_RDR])
)
)
]
where
lbl_str :: String
lbl_str = FastString -> String
unpackFS FastString
lbl
mk_read_field :: IdGhcP p -> FastString -> LHsExpr (GhcPass p)
mk_read_field IdGhcP p
read_field_rdr FastString
lbl
= 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)
IdGhcP p
read_field_rdr [HsLit (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (FastString -> HsLit (GhcPass p)
forall (p :: Pass). FastString -> HsLit (GhcPass p)
mkHsStringFS FastString
lbl)]
read_field :: LocatedA (HsExpr (GhcPass 'Parsed))
read_field
| String -> Bool
isSym String
lbl_str
= IdGhcP 'Parsed -> FastString -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass} {a}.
(Anno (IdGhcP p) ~ EpAnn a, NoAnn a, IsPass p) =>
IdGhcP p
-> FastString -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
mk_read_field RdrName
IdGhcP 'Parsed
readSymField_RDR FastString
lbl
| Just (String
ss, Char
'#') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
snocView String
lbl_str
= IdGhcP 'Parsed -> FastString -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass} {a}.
(Anno (IdGhcP p) ~ EpAnn a, NoAnn a, IsPass p) =>
IdGhcP p
-> FastString -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
mk_read_field RdrName
IdGhcP 'Parsed
readFieldHash_RDR (String -> FastString
mkFastString String
ss)
| Bool
otherwise
= IdGhcP 'Parsed -> FastString -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass} {a}.
(Anno (IdGhcP p) ~ EpAnn a, NoAnn a, IsPass p) =>
IdGhcP p
-> FastString -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
mk_read_field RdrName
IdGhcP 'Parsed
readField_RDR FastString
lbl
gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> DerivInstTys
-> (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Show_binds :: (Name -> Fixity)
-> SrcSpan
-> DerivInstTys
-> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Show_binds Name -> Fixity
get_fixity 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)
shows_prec], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
shows_prec :: LHsBind (GhcPass 'Parsed)
shows_prec = Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
2 SrcSpan
loc RdrName
showsPrec_RDR LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. a -> a
id ((DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed))))
-> [DataCon]
-> [([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
pats_etc [DataCon]
data_cons)
comma_space :: LHsExpr (GhcPass 'Parsed)
comma_space = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
showCommaSpace_RDR
pats_etc :: DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
pats_etc DataCon
data_con
| Bool
nullary_con =
Bool
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => Bool -> a -> a
assert ([RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RdrName]
bs_needed)
([LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
con_pat], String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app String
op_con_str)
| Bool
otherwise =
([LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
a_Pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
con_pat],
LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
showParen_Expr (LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp LHsExpr (GhcPass 'Parsed)
a_Expr RdrName
ge_RDR (HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit
(XHsInt (GhcPass 'Parsed) -> IntegralLit -> HsLit (GhcPass 'Parsed)
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt (GhcPass 'Parsed)
NoExtField
noExtField (Integer -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit Integer
con_prec_plus_one))))
(LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar ([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
nested_compose_Expr [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
show_thingies)))
where
data_con_RDR :: RdrName
data_con_RDR = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con
con_arity :: Int
con_arity = DataCon -> Int
dataConSourceArity DataCon
data_con
bs_needed :: [RdrName]
bs_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
bs_RDRs
arg_tys :: [Type]
arg_tys = DataCon -> DerivInstTys -> [Type]
derivDataConInstArgTys DataCon
data_con DerivInstTys
dit
con_pat :: LPat (GhcPass 'Parsed)
con_pat = RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
bs_needed
nullary_con :: Bool
nullary_con = Int
con_arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
labels :: [FastString]
labels = (FieldLabel -> FastString) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (FieldLabelString -> FastString
field_label (FieldLabelString -> FastString)
-> (FieldLabel -> FieldLabelString) -> FieldLabel -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel) ([FieldLabel] -> [FastString]) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> a -> b
$ DataCon -> [FieldLabel]
dataConFieldLabels DataCon
data_con
lab_fields :: Int
lab_fields = [FastString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FastString]
labels
record_syntax :: Bool
record_syntax = Int
lab_fields Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
dc_nm :: Name
dc_nm = DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
data_con
dc_occ_nm :: OccName
dc_occ_nm = DataCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName DataCon
data_con
con_str :: String
con_str = OccName -> String
occNameString OccName
dc_occ_nm
op_con_str :: String
op_con_str = String -> String
wrapOpParens String
con_str
backquote_str :: String
backquote_str = String -> String
wrapOpBackquotes String
con_str
show_thingies :: [LocatedA (HsExpr (GhcPass 'Parsed))]
show_thingies
| Bool
is_infix = [LocatedA (HsExpr (GhcPass 'Parsed))
show_arg1, String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
backquote_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "), LocatedA (HsExpr (GhcPass 'Parsed))
show_arg2]
| Bool
record_syntax = String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app (String
op_con_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" {") LocatedA (HsExpr (GhcPass 'Parsed))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. a -> [a] -> [a]
:
[LocatedA (HsExpr (GhcPass 'Parsed))]
show_record_args [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app String
"}"]
| Bool
otherwise = String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app (String
op_con_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") LocatedA (HsExpr (GhcPass 'Parsed))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. a -> [a] -> [a]
: [LocatedA (HsExpr (GhcPass 'Parsed))]
show_prefix_args
show_label :: FastString -> LHsExpr (GhcPass 'Parsed)
show_label FastString
l = String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app (String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")
where
nm :: String
nm = String -> String
wrapOpParens (FastString -> String
unpackFS FastString
l)
show_args :: [LocatedA (HsExpr (GhcPass 'Parsed))]
show_args = String
-> (RdrName -> Type -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [RdrName]
-> [Type]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b c.
HasDebugCallStack =>
String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"gen_Show_binds" RdrName -> Type -> LHsExpr (GhcPass 'Parsed)
RdrName -> Type -> LocatedA (HsExpr (GhcPass 'Parsed))
show_arg [RdrName]
bs_needed [Type]
arg_tys
(LocatedA (HsExpr (GhcPass 'Parsed))
show_arg1:LocatedA (HsExpr (GhcPass 'Parsed))
show_arg2:[LocatedA (HsExpr (GhcPass 'Parsed))]
_) = [LocatedA (HsExpr (GhcPass 'Parsed))]
show_args
show_prefix_args :: [LocatedA (HsExpr (GhcPass 'Parsed))]
show_prefix_args = LocatedA (HsExpr (GhcPass 'Parsed))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. a -> [a] -> [a]
intersperse (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
showSpace_RDR) [LocatedA (HsExpr (GhcPass 'Parsed))]
show_args
show_record_args :: [LocatedA (HsExpr (GhcPass 'Parsed))]
show_record_args = [[LocatedA (HsExpr (GhcPass 'Parsed))]]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[LocatedA (HsExpr (GhcPass 'Parsed))]]
-> [LocatedA (HsExpr (GhcPass 'Parsed))])
-> [[LocatedA (HsExpr (GhcPass 'Parsed))]]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> a -> b
$
[LocatedA (HsExpr (GhcPass 'Parsed))]
-> [[LocatedA (HsExpr (GhcPass 'Parsed))]]
-> [[LocatedA (HsExpr (GhcPass 'Parsed))]]
forall a. a -> [a] -> [a]
intersperse [LocatedA (HsExpr (GhcPass 'Parsed))
comma_space] ([[LocatedA (HsExpr (GhcPass 'Parsed))]]
-> [[LocatedA (HsExpr (GhcPass 'Parsed))]])
-> [[LocatedA (HsExpr (GhcPass 'Parsed))]]
-> [[LocatedA (HsExpr (GhcPass 'Parsed))]]
forall a b. (a -> b) -> a -> b
$
[ [FastString -> LocatedA (HsExpr (GhcPass 'Parsed))
show_label FastString
lbl, LocatedA (HsExpr (GhcPass 'Parsed))
arg]
| (FastString
lbl,LocatedA (HsExpr (GhcPass 'Parsed))
arg) <- String
-> [FastString]
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
-> [(FastString, LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. HasDebugCallStack => String -> [a] -> [b] -> [(a, b)]
zipEqual String
"gen_Show_binds"
[FastString]
labels [LocatedA (HsExpr (GhcPass 'Parsed))]
show_args ]
show_arg :: RdrName -> Type -> LHsExpr GhcPs
show_arg :: RdrName -> Type -> LHsExpr (GhcPass 'Parsed)
show_arg RdrName
b Type
arg_ty
| HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType Type
arg_ty
= 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
compose_RDR
[LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
mk_shows_app LHsExpr (GhcPass 'Parsed)
boxed_arg, String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app String
postfixMod]
| Bool
otherwise
= Integer -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
mk_showsPrec_app Integer
arg_prec LHsExpr (GhcPass 'Parsed)
arg
where
arg :: LHsExpr (GhcPass 'Parsed)
arg = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
b
boxed_arg :: LHsExpr (GhcPass 'Parsed)
boxed_arg = String
-> LHsExpr (GhcPass 'Parsed) -> Type -> LHsExpr (GhcPass 'Parsed)
box String
"Show" LHsExpr (GhcPass 'Parsed)
arg Type
arg_ty
postfixMod :: String
postfixMod = String -> [(Type, String)] -> Type -> String
forall a. HasDebugCallStack => String -> [(Type, a)] -> Type -> a
assoc_ty_id String
"Show" [(Type, String)]
postfixModTbl Type
arg_ty
is_infix :: Bool
is_infix = DataCon -> Bool
dataConIsInfix DataCon
data_con
con_prec_plus_one :: Integer
con_prec_plus_one = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Bool -> (Name -> Fixity) -> Name -> Integer
getPrec Bool
is_infix Name -> Fixity
get_fixity Name
dc_nm
arg_prec :: Integer
arg_prec | Bool
record_syntax = Integer
0
| Bool
otherwise = Integer
con_prec_plus_one
wrapOpParens :: String -> String
wrapOpParens :: String -> String
wrapOpParens String
s | String -> Bool
isSym String
s = Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
| Bool
otherwise = String
s
wrapOpBackquotes :: String -> String
wrapOpBackquotes :: String -> String
wrapOpBackquotes String
s | String -> Bool
isSym String
s = String
s
| Bool
otherwise = Char
'`' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`"
isSym :: String -> Bool
isSym :: String -> Bool
isSym String
"" = Bool
False
isSym (Char
c : String
_) = Char -> Bool
startsVarSym Char
c Bool -> Bool -> Bool
|| Char -> Bool
startsConSym Char
c
mk_showString_app :: String -> LHsExpr GhcPs
mk_showString_app :: String -> LHsExpr (GhcPass 'Parsed)
mk_showString_app String
str = 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
showString_RDR) (HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (String -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
str))
mk_showsPrec_app :: Integer -> LHsExpr GhcPs -> LHsExpr GhcPs
mk_showsPrec_app :: Integer -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
mk_showsPrec_app Integer
p 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
showsPrec_RDR [HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (XHsInt (GhcPass 'Parsed) -> IntegralLit -> HsLit (GhcPass 'Parsed)
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt (GhcPass 'Parsed)
NoExtField
noExtField (Integer -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit Integer
p)), LHsExpr (GhcPass 'Parsed)
x]
mk_shows_app :: LHsExpr GhcPs -> LHsExpr GhcPs
mk_shows_app :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
mk_shows_app LHsExpr (GhcPass 'Parsed)
x = 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
shows_RDR) LHsExpr (GhcPass 'Parsed)
x
getPrec :: Bool -> (Name -> Fixity) -> Name -> Integer
getPrec :: Bool -> (Name -> Fixity) -> Name -> Integer
getPrec Bool
is_infix Name -> Fixity
get_fixity Name
nm
| Bool -> Bool
not Bool
is_infix = Integer
appPrecedence
| Bool
otherwise = (Name -> Fixity) -> Name -> Integer
getPrecedence Name -> Fixity
get_fixity Name
nm
appPrecedence :: Integer
appPrecedence :: Integer
appPrecedence = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecedence Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
getPrecedence :: (Name -> Fixity) -> Name -> Integer
getPrecedence :: (Name -> Fixity) -> Name -> Integer
getPrecedence Name -> Fixity
get_fixity Name
nm
= case Name -> Fixity
get_fixity Name
nm of
Fixity Int
x FixityDirection
_assoc -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
gen_Data_binds :: SrcSpan
-> DerivInstTys
-> TcM (LHsBinds GhcPs,
Bag AuxBindSpec)
gen_Data_binds :: SrcSpan
-> DerivInstTys
-> TcM (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Data_binds SrcSpan
loc (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
rep_tc})
= do {
dataT_RDR <- SrcSpan -> TyCon -> TcM RdrName
new_dataT_rdr_name SrcSpan
loc TyCon
rep_tc
; dataC_RDRs <- traverse (new_dataC_rdr_name loc) data_cons
; pure ( [ gfoldl_bind, gunfold_bind
, toCon_bind dataC_RDRs, dataTypeOf_bind dataT_RDR ]
++ gcast_binds
, listToBag
( DerivDataDataType rep_tc dataT_RDR dataC_RDRs
: zipWith (\DataCon
data_con RdrName
dataC_RDR ->
DataCon -> RdrName -> RdrName -> AuxBindSpec
DerivDataConstr DataCon
data_con RdrName
dataC_RDR RdrName
dataT_RDR)
data_cons dataC_RDRs )
) }
where
data_cons :: [DataCon]
data_cons = TyCon -> [DataCon]
tyConDataCons TyCon
rep_tc
n_cons :: Int
n_cons = [DataCon] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataCon]
data_cons
gfoldl_bind :: LHsBind (GhcPass 'Parsed)
gfoldl_bind = Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
3 SrcSpan
loc RdrName
gfoldl_RDR LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. a -> a
id ((DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed))))
-> [DataCon]
-> [([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
gfoldl_eqn [DataCon]
data_cons)
gfoldl_eqn :: DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
gfoldl_eqn DataCon
con
= ([IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
k_RDR, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
z_Pat, RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
con_name [RdrName]
as_needed],
(LocatedA (HsExpr (GhcPass 'Parsed))
-> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> [RdrName]
-> 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))
-> RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
mk_k_app (LHsExpr (GhcPass 'Parsed)
z_Expr LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`nlHsApp` (DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass}.
(XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
~ Origin,
IdGhcP p ~ RdrName, IsPass p) =>
DataCon -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
eta_expand_data_con DataCon
con)) [RdrName]
as_needed)
where
con_name :: RdrName
con_name :: RdrName
con_name = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
con
as_needed :: [RdrName]
as_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take (DataCon -> Int
dataConSourceArity DataCon
con) [RdrName]
as_RDRs
mk_k_app :: LocatedA (HsExpr (GhcPass 'Parsed))
-> RdrName -> LHsExpr (GhcPass 'Parsed)
mk_k_app LocatedA (HsExpr (GhcPass 'Parsed))
e RdrName
v = LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (LHsExpr (GhcPass 'Parsed)
-> IdP (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsOpApp LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e IdP (GhcPass 'Parsed)
RdrName
k_RDR (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))
gunfold_bind :: LHsBind (GhcPass 'Parsed)
gunfold_bind = SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc
RdrName
gunfold_RDR
([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))
k_Pat, LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
z_Pat, if Int
n_cons Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat else LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
c_Pat])
LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
gunfold_rhs
gunfold_rhs :: LocatedA (HsExpr (GhcPass 'Parsed))
gunfold_rhs
| [DataCon
con] <- [DataCon]
data_cons = DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
mk_unfold_rhs DataCon
con
| Bool
otherwise = LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
conIndex_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)
c_Expr)
((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) (LocatedA (HsExpr (GhcPass 'Parsed)))
DataCon
-> GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
gunfold_alt [DataCon]
data_cons)
gunfold_alt :: DataCon
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
gunfold_alt DataCon
dc = LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (DataCon -> LPat (GhcPass 'Parsed)
mk_unfold_pat DataCon
dc) (DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
mk_unfold_rhs DataCon
dc)
mk_unfold_rhs :: DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
mk_unfold_rhs DataCon
dc = (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)
z_Expr LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`nlHsApp` (DataCon -> LocatedA (HsExpr (GhcPass 'Parsed))
forall {p :: Pass}.
(XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
~ Origin,
IdGhcP p ~ RdrName, IsPass p) =>
DataCon -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
eta_expand_data_con DataCon
dc))
(Int
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a. Int -> a -> [a]
replicate (DataCon -> Int
dataConSourceArity DataCon
dc) (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
k_RDR))
eta_expand_data_con :: DataCon -> LHsExpr (GhcPass p)
eta_expand_data_con DataCon
dc =
LocatedE [LPat (GhcPass p)]
-> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
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 p))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
eta_expand_pats)
((GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (IdP (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
dc)) [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
eta_expand_hsvars)
where
eta_expand_pats :: [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
eta_expand_pats = (RdrName -> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> [RdrName] -> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass p) -> LPat (GhcPass p)
RdrName -> GenLocated SrcSpanAnnA (Pat (GhcPass p))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat [RdrName]
eta_expand_vars
eta_expand_hsvars :: [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
eta_expand_hsvars = (RdrName -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> [RdrName] -> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass p) -> LHsExpr (GhcPass p)
RdrName -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar [RdrName]
eta_expand_vars
eta_expand_vars :: [RdrName]
eta_expand_vars = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take (DataCon -> Int
dataConSourceArity DataCon
dc) [RdrName]
as_RDRs
mk_unfold_pat :: DataCon -> LPat (GhcPass 'Parsed)
mk_unfold_pat DataCon
dc
| Int
tagInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
fIRST_TAG Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n_consInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = LPat (GhcPass 'Parsed)
nlWildPat
| Bool
otherwise = RdrName -> [LPat (GhcPass 'Parsed)] -> LPat (GhcPass 'Parsed)
nlConPat RdrName
intDataCon_RDR
[HsLit (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
nlLitPat (XHsIntPrim (GhcPass 'Parsed) -> Integer -> HsLit (GhcPass 'Parsed)
forall x. XHsIntPrim x -> Integer -> HsLit x
HsIntPrim XHsIntPrim (GhcPass 'Parsed)
SourceText
NoSourceText (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
tag))]
where
tag :: Int
tag = DataCon -> Int
dataConTag DataCon
dc
toCon_bind :: [RdrName] -> LHsBind (GhcPass 'Parsed)
toCon_bind [RdrName]
dataC_RDRs
= Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
1 SrcSpan
loc RdrName
toConstr_RDR LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. a -> a
id
((DataCon
-> RdrName
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed))))
-> [DataCon]
-> [RdrName]
-> [([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith DataCon
-> RdrName
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
DataCon
-> IdGhcP 'Parsed
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
forall {p :: Pass} {a}.
(Anno (IdGhcP p) ~ EpAnn a, NoAnn a, IsPass p) =>
DataCon
-> IdGhcP p
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
to_con_eqn [DataCon]
data_cons [RdrName]
dataC_RDRs)
to_con_eqn :: DataCon
-> IdGhcP p
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
to_con_eqn DataCon
dc IdGhcP p
con_name = ([DataCon -> LPat (GhcPass 'Parsed)
nlWildConPat DataCon
dc], IdP (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass p)
IdGhcP p
con_name)
dataTypeOf_bind :: RdrName -> LHsBind (GhcPass 'Parsed)
dataTypeOf_bind RdrName
dataT_RDR
= SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind
SrcSpan
loc
RdrName
dataTypeOf_RDR
([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])
(IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
dataT_RDR)
tycon_kind :: Type
tycon_kind = case TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe TyCon
rep_tc of
Just (TyCon
fam_tc, [Type]
_) -> TyCon -> Type
tyConKind TyCon
fam_tc
Maybe (TyCon, [Type])
Nothing -> TyCon -> Type
tyConKind TyCon
rep_tc
gcast_binds :: [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
gcast_binds | Type
tycon_kind HasDebugCallStack => Type -> Type -> Bool
Type -> Type -> Bool
`tcEqKind` Type
kind1 = RdrName
-> RdrName
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
mk_gcast RdrName
dataCast1_RDR RdrName
gcast1_RDR
| Type
tycon_kind HasDebugCallStack => Type -> Type -> Bool
Type -> Type -> Bool
`tcEqKind` Type
kind2 = RdrName
-> RdrName
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
mk_gcast RdrName
dataCast2_RDR RdrName
gcast2_RDR
| Bool
otherwise = []
mk_gcast :: RdrName
-> RdrName
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
mk_gcast RdrName
dataCast_RDR RdrName
gcast_RDR
= [SrcSpan
-> RdrName
-> LocatedE [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
dataCast_RDR ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [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])
(IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
gcast_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` 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)]
kind1, kind2 :: Kind
kind1 :: Type
kind1 = Type
typeToTypeKind
kind2 :: Type
kind2 = Type
liftedTypeKind HasDebugCallStack => Type -> Type -> Type
Type -> Type -> Type
`mkVisFunTyMany` Type
kind1
gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstrTag_RDR,
mkDataType_RDR, conIndex_RDR, prefix_RDR, infix_RDR,
dataCast1_RDR, dataCast2_RDR, gcast1_RDR, gcast2_RDR,
constr_RDR, dataType_RDR,
eqChar_RDR , ltChar_RDR , geChar_RDR , gtChar_RDR , leChar_RDR ,
eqInt_RDR , ltInt_RDR , geInt_RDR , gtInt_RDR , leInt_RDR , neInt_RDR ,
eqInt8_RDR , ltInt8_RDR , geInt8_RDR , gtInt8_RDR , leInt8_RDR ,
eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR ,
eqInt32_RDR , ltInt32_RDR , geInt32_RDR , gtInt32_RDR , leInt32_RDR ,
eqInt64_RDR , ltInt64_RDR , geInt64_RDR , gtInt64_RDR , leInt64_RDR ,
eqWord_RDR , ltWord_RDR , geWord_RDR , gtWord_RDR , leWord_RDR ,
eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR ,
eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_RDR,
eqWord32_RDR, ltWord32_RDR, geWord32_RDR, gtWord32_RDR, leWord32_RDR,
eqWord64_RDR, ltWord64_RDR, geWord64_RDR, gtWord64_RDR, leWord64_RDR,
eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR ,
eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR ,
eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,
int8DataCon_RDR, int16DataCon_RDR, int32DataCon_RDR, int64DataCon_RDR,
word8DataCon_RDR, word16DataCon_RDR, word32DataCon_RDR, word64DataCon_RDR
:: RdrName
gfoldl_RDR :: RdrName
gfoldl_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"gfoldl")
gunfold_RDR :: RdrName
gunfold_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"gunfold")
toConstr_RDR :: RdrName
toConstr_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"toConstr")
dataTypeOf_RDR :: RdrName
dataTypeOf_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"dataTypeOf")
dataCast1_RDR :: RdrName
dataCast1_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"dataCast1")
dataCast2_RDR :: RdrName
dataCast2_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"dataCast2")
gcast1_RDR :: RdrName
gcast1_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_TYPEABLE (String -> FastString
fsLit String
"gcast1")
gcast2_RDR :: RdrName
gcast2_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_TYPEABLE (String -> FastString
fsLit String
"gcast2")
mkConstrTag_RDR :: RdrName
mkConstrTag_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"mkConstrTag")
constr_RDR :: RdrName
constr_RDR = Module -> FastString -> RdrName
tcQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"Constr")
mkDataType_RDR :: RdrName
mkDataType_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"mkDataType")
dataType_RDR :: RdrName
dataType_RDR = Module -> FastString -> RdrName
tcQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"DataType")
conIndex_RDR :: RdrName
conIndex_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"constrIndex")
prefix_RDR :: RdrName
prefix_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"Prefix")
infix_RDR :: RdrName
infix_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_DATA_DATA (String -> FastString
fsLit String
"Infix")
eqChar_RDR :: RdrName
eqChar_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqChar#")
ltChar_RDR :: RdrName
ltChar_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltChar#")
leChar_RDR :: RdrName
leChar_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leChar#")
gtChar_RDR :: RdrName
gtChar_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtChar#")
geChar_RDR :: RdrName
geChar_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geChar#")
eqInt_RDR :: RdrName
eqInt_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"==#")
neInt_RDR :: RdrName
neInt_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"/=#")
ltInt_RDR :: RdrName
ltInt_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"<#" )
leInt_RDR :: RdrName
leInt_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"<=#")
gtInt_RDR :: RdrName
gtInt_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
">#" )
geInt_RDR :: RdrName
geInt_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
">=#")
eqInt8_RDR :: RdrName
eqInt8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqInt8#")
ltInt8_RDR :: RdrName
ltInt8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltInt8#" )
leInt8_RDR :: RdrName
leInt8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leInt8#")
gtInt8_RDR :: RdrName
gtInt8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtInt8#" )
geInt8_RDR :: RdrName
geInt8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geInt8#")
eqInt16_RDR :: RdrName
eqInt16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqInt16#")
ltInt16_RDR :: RdrName
ltInt16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltInt16#" )
leInt16_RDR :: RdrName
leInt16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leInt16#")
gtInt16_RDR :: RdrName
gtInt16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtInt16#" )
geInt16_RDR :: RdrName
geInt16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geInt16#")
eqInt32_RDR :: RdrName
eqInt32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqInt32#")
ltInt32_RDR :: RdrName
ltInt32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltInt32#" )
leInt32_RDR :: RdrName
leInt32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leInt32#")
gtInt32_RDR :: RdrName
gtInt32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtInt32#" )
geInt32_RDR :: RdrName
geInt32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geInt32#")
eqInt64_RDR :: RdrName
eqInt64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqInt64#")
ltInt64_RDR :: RdrName
ltInt64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltInt64#" )
leInt64_RDR :: RdrName
leInt64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leInt64#")
gtInt64_RDR :: RdrName
gtInt64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtInt64#" )
geInt64_RDR :: RdrName
geInt64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geInt64#")
eqWord_RDR :: RdrName
eqWord_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqWord#")
ltWord_RDR :: RdrName
ltWord_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltWord#")
leWord_RDR :: RdrName
leWord_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leWord#")
gtWord_RDR :: RdrName
gtWord_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtWord#")
geWord_RDR :: RdrName
geWord_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geWord#")
eqWord8_RDR :: RdrName
eqWord8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqWord8#")
ltWord8_RDR :: RdrName
ltWord8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltWord8#" )
leWord8_RDR :: RdrName
leWord8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leWord8#")
gtWord8_RDR :: RdrName
gtWord8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtWord8#" )
geWord8_RDR :: RdrName
geWord8_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geWord8#")
eqWord16_RDR :: RdrName
eqWord16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqWord16#")
ltWord16_RDR :: RdrName
ltWord16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltWord16#" )
leWord16_RDR :: RdrName
leWord16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leWord16#")
gtWord16_RDR :: RdrName
gtWord16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtWord16#" )
geWord16_RDR :: RdrName
geWord16_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geWord16#")
eqWord32_RDR :: RdrName
eqWord32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqWord32#")
ltWord32_RDR :: RdrName
ltWord32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltWord32#" )
leWord32_RDR :: RdrName
leWord32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leWord32#")
gtWord32_RDR :: RdrName
gtWord32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtWord32#" )
geWord32_RDR :: RdrName
geWord32_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geWord32#")
eqWord64_RDR :: RdrName
eqWord64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqWord64#")
ltWord64_RDR :: RdrName
ltWord64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltWord64#" )
leWord64_RDR :: RdrName
leWord64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leWord64#")
gtWord64_RDR :: RdrName
gtWord64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtWord64#" )
geWord64_RDR :: RdrName
geWord64_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geWord64#")
eqAddr_RDR :: RdrName
eqAddr_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqAddr#")
ltAddr_RDR :: RdrName
ltAddr_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltAddr#")
leAddr_RDR :: RdrName
leAddr_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leAddr#")
gtAddr_RDR :: RdrName
gtAddr_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtAddr#")
geAddr_RDR :: RdrName
geAddr_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geAddr#")
eqFloat_RDR :: RdrName
eqFloat_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"eqFloat#")
ltFloat_RDR :: RdrName
ltFloat_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"ltFloat#")
leFloat_RDR :: RdrName
leFloat_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"leFloat#")
gtFloat_RDR :: RdrName
gtFloat_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"gtFloat#")
geFloat_RDR :: RdrName
geFloat_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"geFloat#")
eqDouble_RDR :: RdrName
eqDouble_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"==##")
ltDouble_RDR :: RdrName
ltDouble_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"<##" )
leDouble_RDR :: RdrName
leDouble_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
"<=##")
gtDouble_RDR :: RdrName
gtDouble_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
">##" )
geDouble_RDR :: RdrName
geDouble_RDR = Module -> FastString -> RdrName
varQual_RDR Module
gHC_PRIM (String -> FastString
fsLit String
">=##")
int8DataCon_RDR :: RdrName
int8DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_INT (String -> FastString
fsLit String
"I8#")
int16DataCon_RDR :: RdrName
int16DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_INT (String -> FastString
fsLit String
"I16#")
int32DataCon_RDR :: RdrName
int32DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_INT (String -> FastString
fsLit String
"I32#")
int64DataCon_RDR :: RdrName
int64DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_INT (String -> FastString
fsLit String
"I64#")
word8DataCon_RDR :: RdrName
word8DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_WORD (String -> FastString
fsLit String
"W8#")
word16DataCon_RDR :: RdrName
word16DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_WORD (String -> FastString
fsLit String
"W16#")
word32DataCon_RDR :: RdrName
word32DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_WORD (String -> FastString
fsLit String
"W32#")
word64DataCon_RDR :: RdrName
word64DataCon_RDR = Module -> FastString -> RdrName
dataQual_RDR Module
gHC_INTERNAL_WORD (String -> FastString
fsLit String
"W64#")
gen_Lift_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
gen_Lift_binds :: SrcSpan
-> DerivInstTys -> (LHsBinds (GhcPass 'Parsed), Bag AuxBindSpec)
gen_Lift_binds SrcSpan
loc (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)
lift_bind, LHsBind (GhcPass 'Parsed)
liftTyped_bind], Bag AuxBindSpec
forall a. Bag a
emptyBag)
where
lift_bind :: LHsBind (GhcPass 'Parsed)
lift_bind = Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
1 SrcSpan
loc RdrName
lift_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)
pure_Expr)
((DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed))))
-> [DataCon]
-> [([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map ((LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> (LocatedA (HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed))
-> Name
-> DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
forall {e} {a}.
HasAnnotation e =>
(LocatedA (HsExpr (GhcPass 'Parsed)) -> a)
-> (LocatedA (HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed))
-> Name
-> DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
GenLocated e a)
pats_etc LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
mk_untyped_bracket LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
mk_usplice Name
liftName) [DataCon]
data_cons)
liftTyped_bind :: LHsBind (GhcPass 'Parsed)
liftTyped_bind = Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
1 SrcSpan
loc RdrName
liftTyped_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)
unsafeCodeCoerce_Expr (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 c a. (b -> c) -> (a -> b) -> a -> c
. 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)
((DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed))))
-> [DataCon]
-> [([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map ((LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> (LocatedA (HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed))
-> Name
-> DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))
forall {e} {a}.
HasAnnotation e =>
(LocatedA (HsExpr (GhcPass 'Parsed)) -> a)
-> (LocatedA (HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed))
-> Name
-> DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
GenLocated e a)
pats_etc LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
mk_typed_bracket LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
mk_tsplice Name
liftTypedName) [DataCon]
data_cons)
mk_untyped_bracket :: LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
mk_untyped_bracket = XUntypedBracket (GhcPass 'Parsed)
-> HsQuote (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XUntypedBracket p -> HsQuote p -> HsExpr p
HsUntypedBracket XUntypedBracket (GhcPass 'Parsed)
NoExtField
noExtField (HsQuote (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> (LHsExpr (GhcPass 'Parsed) -> HsQuote (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XExpBr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsQuote (GhcPass 'Parsed)
forall p. XExpBr p -> LHsExpr p -> HsQuote p
ExpBr XExpBr (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn
mk_typed_bracket :: LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
mk_typed_bracket = XTypedBracket (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XTypedBracket p -> LHsExpr p -> HsExpr p
HsTypedBracket XTypedBracket (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn
mk_tsplice :: LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
mk_tsplice = XTypedSplice (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XTypedSplice p -> LHsExpr p -> HsExpr p
HsTypedSplice XTypedSplice (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn
mk_usplice :: LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
mk_usplice = XUntypedSplice (GhcPass 'Parsed)
-> HsUntypedSplice (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XUntypedSplice p -> HsUntypedSplice p -> HsExpr p
HsUntypedSplice XUntypedSplice (GhcPass 'Parsed)
NoExtField
noExtField (HsUntypedSplice (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> (LHsExpr (GhcPass 'Parsed) -> HsUntypedSplice (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XUntypedSpliceExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsUntypedSplice (GhcPass 'Parsed)
forall id.
XUntypedSpliceExpr id -> LHsExpr id -> HsUntypedSplice id
HsUntypedSpliceExpr XUntypedSpliceExpr (GhcPass 'Parsed)
forall a. NoAnn a => a
noAnn
data_cons :: [DataCon]
data_cons = TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args
pats_etc :: (LocatedA (HsExpr (GhcPass 'Parsed)) -> a)
-> (LocatedA (HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed))
-> Name
-> DataCon
-> ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
GenLocated e a)
pats_etc LocatedA (HsExpr (GhcPass 'Parsed)) -> a
mk_bracket LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
mk_splice Name
lift_name DataCon
data_con
= ([LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
con_pat], GenLocated e a
lift_Expr)
where
con_pat :: LPat (GhcPass 'Parsed)
con_pat = RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
data_con_RDR [RdrName]
as_needed
data_con_RDR :: RdrName
data_con_RDR = DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
data_con
con_arity :: Int
con_arity = DataCon -> Int
dataConSourceArity DataCon
data_con
as_needed :: [RdrName]
as_needed = Int -> [RdrName] -> [RdrName]
forall a. Int -> [a] -> [a]
take Int
con_arity [RdrName]
as_RDRs
lift_Expr :: GenLocated e a
lift_Expr = a -> GenLocated e a
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (LocatedA (HsExpr (GhcPass 'Parsed)) -> a
mk_bracket LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
br_body)
br_body :: LHsExpr (GhcPass 'Parsed)
br_body = 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 (Name -> RdrName
Exact (DataCon -> Name
dataConName DataCon
data_con))
((RdrName -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [RdrName] -> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> LHsExpr (GhcPass 'Parsed)
RdrName -> LocatedA (HsExpr (GhcPass 'Parsed))
lift_var [RdrName]
as_needed)
lift_var :: RdrName -> LHsExpr (GhcPass 'Parsed)
lift_var :: RdrName -> LHsExpr (GhcPass 'Parsed)
lift_var RdrName
x = HsExpr (GhcPass 'Parsed) -> LocatedA (HsExpr (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
mk_splice (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (RdrName -> LHsExpr (GhcPass 'Parsed)
mk_lift_expr RdrName
x)))
mk_lift_expr :: RdrName -> LHsExpr (GhcPass 'Parsed)
mk_lift_expr :: RdrName -> LHsExpr (GhcPass 'Parsed)
mk_lift_expr RdrName
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 (Name -> RdrName
Exact Name
lift_name) [IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
x]
gen_Newtype_binds :: SrcSpan
-> Class
-> [TyVar]
-> [Type]
-> Type
-> LHsBinds GhcPs
gen_Newtype_binds :: SrcSpan
-> Class -> [Id] -> [Type] -> Type -> LHsBinds (GhcPass 'Parsed)
gen_Newtype_binds SrcSpan
loc' Class
cls [Id]
inst_tvs [Type]
inst_tys Type
rhs_ty
= (Id
-> GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)))
-> [Id]
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map Id -> LHsBind (GhcPass 'Parsed)
Id
-> GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
mk_bind (Class -> [Id]
classMethods Class
cls)
where
underlying_inst_tys :: [Type]
underlying_inst_tys :: [Type]
underlying_inst_tys = [Type] -> Type -> [Type]
forall a. [a] -> a -> [a]
changeLast [Type]
inst_tys Type
rhs_ty
locn :: SrcSpanAnnN
locn = SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc'
mk_bind :: Id -> LHsBind GhcPs
mk_bind :: Id -> LHsBind (GhcPass 'Parsed)
mk_bind Id
meth_id
=
GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBind GenLocated SrcSpanAnnN RdrName
loc_meth_RDR [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
(GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
loc_meth_RDR AnnFunRhs
forall a. NoAnn a => a
noAnn)
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA ((VarBndr Id Specificity
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [VarBndr Id Specificity]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map VarBndr Id Specificity -> LPat (GhcPass 'Parsed)
VarBndr Id Specificity
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
mk_ty_pat [VarBndr Id Specificity]
to_tvbs)) LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
rhs_expr]
where
Pair Type
from_ty Type
to_ty = Class -> [Id] -> [Type] -> Type -> Id -> Pair Type
mkCoerceClassMethEqn Class
cls [Id]
inst_tvs [Type]
inst_tys Type
rhs_ty Id
meth_id
([Id]
_, [Type]
_, Type
from_tau) = Type -> ([Id], [Type], Type)
tcSplitSigmaTy Type
from_ty
([VarBndr Id Specificity]
to_tvbs, Type
to_rho) = Type -> ([VarBndr Id Specificity], Type)
tcSplitForAllInvisTVBinders Type
to_ty
([Type]
_, Type
to_tau) = Type -> ([Type], Type)
tcSplitPhiTy Type
to_rho
mk_ty_pat :: VarBndr TyVar Specificity -> LPat GhcPs
mk_ty_pat :: VarBndr Id Specificity -> LPat (GhcPass 'Parsed)
mk_ty_pat (Bndr Id
tv Specificity
spec) = Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XInvisPat (GhcPass 'Parsed)
-> HsTyPat (NoGhcTc (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed)
forall p. XInvisPat p -> HsTyPat (NoGhcTc p) -> Pat p
InvisPat (EpToken "@"
forall a. NoAnn a => a
noAnn, Specificity
spec) (HsTyPat (NoGhcTc (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed))
-> HsTyPat (NoGhcTc (GhcPass 'Parsed)) -> Pat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ LHsType (GhcPass 'Parsed) -> HsTyPat (GhcPass 'Parsed)
mkHsTyPat (LHsType (GhcPass 'Parsed) -> HsTyPat (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> HsTyPat (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
PromotionFlag -> IdP (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted (IdP (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed))
-> IdP (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ Id -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Id
tv
meth_RDR :: RdrName
meth_RDR = Id -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Id
meth_id
loc_meth_RDR :: GenLocated SrcSpanAnnN RdrName
loc_meth_RDR = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
locn RdrName
meth_RDR
rhs_expr :: LHsExpr (GhcPass 'Parsed)
rhs_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)
LHsExpr (GhcPass 'Parsed) -> Type -> LHsExpr (GhcPass 'Parsed)
`nlHsAppType` Type
from_tau
LHsExpr (GhcPass 'Parsed) -> Type -> LHsExpr (GhcPass 'Parsed)
`nlHsAppType` Type
to_tau
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)
LocatedA (HsExpr (GhcPass 'Parsed))
meth_app
meth_app :: LocatedA (HsExpr (GhcPass 'Parsed))
meth_app = (LocatedA (HsExpr (GhcPass 'Parsed))
-> Type -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> [Type]
-> 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' LHsExpr (GhcPass 'Parsed) -> Type -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> Type -> LocatedA (HsExpr (GhcPass 'Parsed))
nlHsAppType (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
meth_RDR) ([Type] -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [Type] -> LocatedA (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
TyCon -> [Type] -> [Type]
filterOutInferredTypes (Class -> TyCon
classTyCon Class
cls) [Type]
underlying_inst_tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++
[Id -> Type
mkTyVarTy Id
tv | Bndr Id
tv Specificity
spec <- [VarBndr Id Specificity]
to_tvbs, Specificity
spec Specificity -> Specificity -> Bool
forall a. Eq a => a -> a -> Bool
/= Specificity
InferredSpec]
gen_Newtype_fam_insts :: SrcSpan
-> Class
-> [TyVar]
-> [Type]
-> Type
-> TcM [FamInst]
gen_Newtype_fam_insts :: SrcSpan -> Class -> [Id] -> [Type] -> Type -> TcM [FamInst]
gen_Newtype_fam_insts SrcSpan
loc' Class
cls [Id]
inst_tvs [Type]
inst_tys Type
rhs_ty
= Bool -> TcM [FamInst] -> TcM [FamInst]
forall a. HasCallStack => Bool -> a -> a
assert ((TyCon -> Bool) -> [TyCon] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (TyCon -> Bool) -> TyCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Bool
isDataFamilyTyCon) [TyCon]
ats) (TcM [FamInst] -> TcM [FamInst]) -> TcM [FamInst] -> TcM [FamInst]
forall a b. (a -> b) -> a -> b
$
(TyCon -> IOEnv (Env TcGblEnv TcLclEnv) FamInst)
-> [TyCon] -> TcM [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyCon -> IOEnv (Env TcGblEnv TcLclEnv) FamInst
mk_atf_inst [TyCon]
ats
where
underlying_inst_tys :: [Type]
underlying_inst_tys :: [Type]
underlying_inst_tys = [Type] -> Type -> [Type]
forall a. [a] -> a -> [a]
changeLast [Type]
inst_tys Type
rhs_ty
ats :: [TyCon]
ats = Class -> [TyCon]
classATs Class
cls
locn :: SrcSpanAnnN
locn = SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc'
cls_tvs :: [Id]
cls_tvs = Class -> [Id]
classTyVars Class
cls
in_scope :: InScopeSet
in_scope = [Id] -> InScopeSet
mkInScopeSetList [Id]
inst_tvs
lhs_env :: TvSubstEnv
lhs_env = [Id] -> [Type] -> TvSubstEnv
HasDebugCallStack => [Id] -> [Type] -> TvSubstEnv
zipTyEnv [Id]
cls_tvs [Type]
inst_tys
lhs_subst :: Subst
lhs_subst = InScopeSet -> TvSubstEnv -> Subst
mkTvSubst InScopeSet
in_scope TvSubstEnv
lhs_env
rhs_env :: TvSubstEnv
rhs_env = [Id] -> [Type] -> TvSubstEnv
HasDebugCallStack => [Id] -> [Type] -> TvSubstEnv
zipTyEnv [Id]
cls_tvs [Type]
underlying_inst_tys
rhs_subst :: Subst
rhs_subst = InScopeSet -> TvSubstEnv -> Subst
mkTvSubst InScopeSet
in_scope TvSubstEnv
rhs_env
mk_atf_inst :: TyCon -> TcM FamInst
mk_atf_inst :: TyCon -> IOEnv (Env TcGblEnv TcLclEnv) FamInst
mk_atf_inst TyCon
fam_tc = do
rep_tc_name <- LocatedN Name -> [Type] -> TcM Name
newFamInstTyConName (SrcSpanAnnN -> Name -> LocatedN Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
locn (TyCon -> Name
tyConName TyCon
fam_tc))
[Type]
rep_lhs_tys
let axiom = Role
-> Name
-> [Id]
-> [Id]
-> [Id]
-> TyCon
-> [Type]
-> Type
-> CoAxiom Unbranched
mkSingleCoAxiom Role
Nominal Name
rep_tc_name [Id]
rep_tvs' [] [Id]
rep_cvs'
TyCon
fam_tc [Type]
rep_lhs_tys Type
rep_rhs_ty
checkFamPatBinders fam_tc (rep_tvs' ++ rep_cvs') emptyVarSet rep_lhs_tys rep_rhs_ty
checkValidCoAxBranch fam_tc (coAxiomSingleBranch axiom)
newFamInst SynFamilyInst axiom
where
fam_tvs :: [Id]
fam_tvs = TyCon -> [Id]
tyConTyVars TyCon
fam_tc
(Subst
_, [Type]
rep_lhs_tys) = Subst -> [Id] -> (Subst, [Type])
substATBndrs Subst
lhs_subst [Id]
fam_tvs
(Subst
_, [Type]
rep_rhs_tys) = Subst -> [Id] -> (Subst, [Type])
substATBndrs Subst
rhs_subst [Id]
fam_tvs
rep_rhs_ty :: Type
rep_rhs_ty = TyCon -> [Type] -> Type
mkTyConApp TyCon
fam_tc [Type]
rep_rhs_tys
rep_tcvs :: [Id]
rep_tcvs = [Type] -> [Id]
tyCoVarsOfTypesList [Type]
rep_lhs_tys
([Id]
rep_tvs, [Id]
rep_cvs) = (Id -> Bool) -> [Id] -> ([Id], [Id])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Id -> Bool
isTyVar [Id]
rep_tcvs
rep_tvs' :: [Id]
rep_tvs' = [Id] -> [Id]
scopedSort [Id]
rep_tvs
rep_cvs' :: [Id]
rep_cvs' = [Id] -> [Id]
scopedSort [Id]
rep_cvs
nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
nlHsAppType :: LHsExpr (GhcPass 'Parsed) -> Type -> LHsExpr (GhcPass 'Parsed)
nlHsAppType LHsExpr (GhcPass 'Parsed)
e Type
s = HsExpr (GhcPass 'Parsed) -> LocatedA (HsExpr (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XAppTypeE (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsWcType (NoGhcTc (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE (GhcPass 'Parsed)
EpToken "@"
forall a. NoAnn a => a
noAnn LHsExpr (GhcPass 'Parsed)
e LHsWcType (NoGhcTc (GhcPass 'Parsed))
HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
hs_ty)
where
hs_ty :: HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
hs_ty = GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall thing. thing -> HsWildCardBndrs (GhcPass 'Parsed) thing
mkHsWildCardBndrs (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec (LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ Type -> LHsType (GhcPass 'Parsed)
nlHsCoreTy Type
s
nlHsCoreTy :: HsCoreTy -> LHsType GhcPs
nlHsCoreTy :: Type -> LHsType (GhcPass 'Parsed)
nlHsCoreTy = HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> (Type -> HsType (GhcPass 'Parsed))
-> Type
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XXType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
Type -> HsType (GhcPass 'Parsed)
forall pass. XXType pass -> HsType pass
XHsType
mkCoerceClassMethEqn :: Class
-> [TyVar]
-> [Type]
-> Type
-> Id
-> Pair Type
mkCoerceClassMethEqn :: Class -> [Id] -> [Type] -> Type -> Id -> Pair Type
mkCoerceClassMethEqn Class
cls [Id]
inst_tvs [Type]
inst_tys Type
rhs_ty Id
id
= Type -> Type -> Pair Type
forall a. a -> a -> Pair a
Pair (HasDebugCallStack => Subst -> Type -> Type
Subst -> Type -> Type
substTy Subst
rhs_subst Type
user_meth_ty)
(HasDebugCallStack => Subst -> Type -> Type
Subst -> Type -> Type
substTy Subst
lhs_subst Type
user_meth_ty)
where
cls_tvs :: [Id]
cls_tvs = Class -> [Id]
classTyVars Class
cls
in_scope :: InScopeSet
in_scope = [Id] -> InScopeSet
mkInScopeSetList [Id]
inst_tvs
lhs_subst :: Subst
lhs_subst = InScopeSet -> TvSubstEnv -> Subst
mkTvSubst InScopeSet
in_scope ([Id] -> [Type] -> TvSubstEnv
HasDebugCallStack => [Id] -> [Type] -> TvSubstEnv
zipTyEnv [Id]
cls_tvs [Type]
inst_tys)
rhs_subst :: Subst
rhs_subst = InScopeSet -> TvSubstEnv -> Subst
mkTvSubst InScopeSet
in_scope ([Id] -> [Type] -> TvSubstEnv
HasDebugCallStack => [Id] -> [Type] -> TvSubstEnv
zipTyEnv [Id]
cls_tvs ([Type] -> Type -> [Type]
forall a. [a] -> a -> [a]
changeLast [Type]
inst_tys Type
rhs_ty))
([Id]
_class_tvs, Type
_class_constraint, Type
user_meth_ty)
= Type -> ([Id], Type, Type)
tcSplitMethodTy (Id -> Type
varType Id
id)
genAuxBindSpecOriginal :: SrcSpan -> AuxBindSpec
-> (LHsBind GhcPs, LSig GhcPs)
genAuxBindSpecOriginal :: SrcSpan
-> AuxBindSpec
-> (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
genAuxBindSpecOriginal SrcSpan
loc AuxBindSpec
spec
= (AuxBindSpec -> LHsBind (GhcPass 'Parsed)
gen_bind AuxBindSpec
spec,
SrcSpanAnnA
-> Sig (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loca (XTypeSig (GhcPass 'Parsed)
-> [LIdP (GhcPass 'Parsed)]
-> LHsSigWcType (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed)
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig (GhcPass 'Parsed)
AnnSig
forall a. NoAnn a => a
noAnn [SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
locn (AuxBindSpec -> RdrName
auxBindSpecRdrName AuxBindSpec
spec)]
(SrcSpan -> AuxBindSpec -> LHsSigWcType (GhcPass 'Parsed)
genAuxBindSpecSig SrcSpan
loc AuxBindSpec
spec)))
where
loca :: SrcSpanAnnA
loca = SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc
locn :: SrcSpanAnnN
locn = SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc
gen_bind :: AuxBindSpec -> LHsBind GhcPs
gen_bind :: AuxBindSpec -> LHsBind (GhcPass 'Parsed)
gen_bind (DerivTag2Con TyCon
_ RdrName
tag2con_RDR)
= Int
-> SrcSpan
-> RdrName
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindSE Int
0 SrcSpan
loc RdrName
tag2con_RDR
[([RdrName -> [RdrName] -> LPat (GhcPass 'Parsed)
nlConVarPat RdrName
intDataCon_RDR [RdrName
a_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 (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
tagToEnum_RDR) LHsExpr (GhcPass 'Parsed)
a_Expr)]
gen_bind (DerivMaxTag TyCon
tycon RdrName
maxtag_RDR)
= SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
maxtag_RDR LHsExpr (GhcPass 'Parsed)
rhs
where
rhs :: LHsExpr (GhcPass 'Parsed)
rhs = 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
intDataCon_RDR)
(HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (XHsIntPrim (GhcPass 'Parsed) -> Integer -> HsLit (GhcPass 'Parsed)
forall x. XHsIntPrim x -> Integer -> HsLit x
HsIntPrim XHsIntPrim (GhcPass 'Parsed)
SourceText
NoSourceText Integer
max_tag))
max_tag :: Integer
max_tag = case (TyCon -> [DataCon]
tyConDataCons TyCon
tycon) of
[DataCon]
data_cons -> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (([DataCon] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataCon]
data_cons) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fIRST_TAG)
gen_bind (DerivDataDataType TyCon
tycon RdrName
dataT_RDR [RdrName]
dataC_RDRs)
= SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
dataT_RDR LHsExpr (GhcPass 'Parsed)
rhs
where
tc_name :: Name
tc_name = TyCon -> Name
tyConName TyCon
tycon
tc_name_string :: FastString
tc_name_string = OccName -> FastString
occNameFS (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
tc_name)
definition_mod_name :: FastString
definition_mod_name = ModuleName -> FastString
moduleNameFS (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (String -> Maybe Module -> Module
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"gen_bind DerivDataDataType" (Maybe Module -> Module) -> Maybe Module -> Module
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Module
nameModule_maybe Name
tc_name))
rhs :: LHsExpr (GhcPass 'Parsed)
rhs = IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
mkDataType_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` HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (FastString -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). FastString -> HsLit (GhcPass p)
mkHsStringFS ([FastString] -> FastString
concatFS [FastString
definition_mod_name, String -> FastString
fsLit String
".", FastString
tc_name_string]))
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)] -> LHsExpr (GhcPass 'Parsed)
nlList ((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]
dataC_RDRs)
gen_bind (DerivDataConstr DataCon
dc RdrName
dataC_RDR RdrName
dataT_RDR)
= SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
dataC_RDR LHsExpr (GhcPass 'Parsed)
rhs
where
rhs :: LHsExpr (GhcPass 'Parsed)
rhs = 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
mkConstrTag_RDR [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
constr_args
constr_args :: [LocatedA (HsExpr (GhcPass 'Parsed))]
constr_args
= [ IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
dataT_RDR
, HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (FastString -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). FastString -> HsLit (GhcPass p)
mkHsStringFS (OccName -> FastString
occNameFS OccName
dc_occ))
, Integer -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (DataCon -> Int
dataConTag DataCon
dc))
, [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
nlList [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
labels
, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
fixity ]
labels :: [LocatedA (HsExpr (GhcPass 'Parsed))]
labels = (FieldLabel -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> [FieldLabel] -> [LocatedA (HsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map (HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
HsLit (GhcPass 'Parsed) -> LocatedA (HsExpr (GhcPass 'Parsed))
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (HsLit (GhcPass 'Parsed) -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> (FieldLabel -> HsLit (GhcPass 'Parsed))
-> FieldLabel
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). FastString -> HsLit (GhcPass p)
mkHsStringFS (FastString -> HsLit (GhcPass 'Parsed))
-> (FieldLabel -> FastString)
-> FieldLabel
-> HsLit (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelString -> FastString
field_label (FieldLabelString -> FastString)
-> (FieldLabel -> FieldLabelString) -> FieldLabel -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel)
(DataCon -> [FieldLabel]
dataConFieldLabels DataCon
dc)
dc_occ :: OccName
dc_occ = DataCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName DataCon
dc
is_infix :: Bool
is_infix = OccName -> Bool
isDataSymOcc OccName
dc_occ
fixity :: RdrName
fixity | Bool
is_infix = RdrName
infix_RDR
| Bool
otherwise = RdrName
prefix_RDR
genAuxBindSpecDup :: SrcSpan -> RdrName -> AuxBindSpec
-> (LHsBind GhcPs, LSig GhcPs)
genAuxBindSpecDup :: SrcSpan
-> RdrName
-> AuxBindSpec
-> (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
genAuxBindSpecDup SrcSpan
loc RdrName
original_rdr_name AuxBindSpec
dup_spec
= (SrcSpan
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsBind (GhcPass 'Parsed)
mkHsVarBind SrcSpan
loc RdrName
dup_rdr_name (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
original_rdr_name),
SrcSpanAnnA
-> Sig (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loca (XTypeSig (GhcPass 'Parsed)
-> [LIdP (GhcPass 'Parsed)]
-> LHsSigWcType (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed)
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig (GhcPass 'Parsed)
AnnSig
forall a. NoAnn a => a
noAnn [SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
locn RdrName
dup_rdr_name]
(SrcSpan -> AuxBindSpec -> LHsSigWcType (GhcPass 'Parsed)
genAuxBindSpecSig SrcSpan
loc AuxBindSpec
dup_spec)))
where
loca :: SrcSpanAnnA
loca = SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc
locn :: SrcSpanAnnN
locn = SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc
dup_rdr_name :: RdrName
dup_rdr_name = AuxBindSpec -> RdrName
auxBindSpecRdrName AuxBindSpec
dup_spec
genAuxBindSpecSig :: SrcSpan -> AuxBindSpec -> LHsSigWcType GhcPs
genAuxBindSpecSig :: SrcSpan -> AuxBindSpec -> LHsSigWcType (GhcPass 'Parsed)
genAuxBindSpecSig SrcSpan
loc AuxBindSpec
spec = case AuxBindSpec
spec of
DerivTag2Con TyCon
tycon RdrName
_
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
mk_sig (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) (HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
XXType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XXType pass -> HsType pass
XHsType (XXType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed))
-> XXType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ [Id] -> Type -> Type
mkSpecForAllTys (TyCon -> [Id]
tyConTyVars TyCon
tycon) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
Type
intTy HasDebugCallStack => Type -> Type -> Type
Type -> Type -> Type
`mkVisFunTyMany` TyCon -> Type
mkParentType TyCon
tycon
DerivMaxTag TyCon
_ RdrName
_
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
mk_sig (SrcSpanAnnA
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) (XXType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XXType pass -> HsType pass
XHsType XXType (GhcPass 'Parsed)
Type
intTy))
DerivDataDataType TyCon
_ RdrName
_ [RdrName]
_
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
mk_sig (PromotionFlag -> IdP (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted IdP (GhcPass 'Parsed)
RdrName
dataType_RDR)
DerivDataConstr DataCon
_ RdrName
_ RdrName
_
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
mk_sig (PromotionFlag -> IdP (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted IdP (GhcPass 'Parsed)
RdrName
constr_RDR)
where
mk_sig :: GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
mk_sig = GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall thing. thing -> HsWildCardBndrs (GhcPass 'Parsed) thing
mkHsWildCardBndrs (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))))
-> (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
(GhcPass 'Parsed)
(GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> HsSigType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) (HsSigType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
-> (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsSigType (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsSigType (GhcPass 'Parsed)
mkHsImplicitSigType
genAuxBinds :: SrcSpan -> Bag AuxBindSpec
-> Bag (LHsBind GhcPs, LSig GhcPs)
genAuxBinds :: SrcSpan
-> Bag AuxBindSpec
-> Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
genAuxBinds SrcSpan
loc = (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
forall a b. (a, b) -> b
snd ((OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
-> (Bag AuxBindSpec
-> (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))))
-> Bag AuxBindSpec
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AuxBindSpec
-> (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
-> (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))))
-> (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
-> Bag AuxBindSpec
-> (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AuxBindSpec
-> (OccEnv RdrName,
Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed)))
-> (OccEnv RdrName,
Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed)))
AuxBindSpec
-> (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
-> (OccEnv RdrName,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))))
gen_aux_bind_spec (OccEnv RdrName
forall a. OccEnv a
emptyOccEnv, Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
forall a. Bag a
emptyBag)
where
gen_aux_bind_spec :: AuxBindSpec
-> (OccEnv RdrName, Bag (LHsBind GhcPs, LSig GhcPs))
-> (OccEnv RdrName, Bag (LHsBind GhcPs, LSig GhcPs))
gen_aux_bind_spec :: AuxBindSpec
-> (OccEnv RdrName,
Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed)))
-> (OccEnv RdrName,
Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed)))
gen_aux_bind_spec AuxBindSpec
spec (OccEnv RdrName
original_rdr_name_env, Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
spec_bag) =
case OccEnv RdrName -> OccName -> Maybe RdrName
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv RdrName
original_rdr_name_env OccName
spec_occ of
Maybe RdrName
Nothing
-> ( OccEnv RdrName -> OccName -> RdrName -> OccEnv RdrName
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv OccEnv RdrName
original_rdr_name_env OccName
spec_occ RdrName
spec_rdr_name
, SrcSpan
-> AuxBindSpec
-> (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
genAuxBindSpecOriginal SrcSpan
loc AuxBindSpec
spec (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
forall a. a -> Bag a -> Bag a
`consBag` Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
spec_bag )
Just RdrName
original_rdr_name
-> ( OccEnv RdrName
original_rdr_name_env
, SrcSpan
-> RdrName
-> AuxBindSpec
-> (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
genAuxBindSpecDup SrcSpan
loc RdrName
original_rdr_name AuxBindSpec
spec (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
forall a. a -> Bag a -> Bag a
`consBag` Bag (LHsBind (GhcPass 'Parsed), LSig (GhcPass 'Parsed))
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)),
GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
spec_bag )
where
spec_rdr_name :: RdrName
spec_rdr_name = AuxBindSpec -> RdrName
auxBindSpecRdrName AuxBindSpec
spec
spec_occ :: OccName
spec_occ = RdrName -> OccName
rdrNameOcc RdrName
spec_rdr_name
mkParentType :: TyCon -> Type
mkParentType :: TyCon -> Type
mkParentType TyCon
tc
= case TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe TyCon
tc of
Maybe (TyCon, [Type])
Nothing -> TyCon -> [Type] -> Type
mkTyConApp TyCon
tc ([Id] -> [Type]
mkTyVarTys (TyCon -> [Id]
tyConTyVars TyCon
tc))
Just (TyCon
fam_tc,[Type]
tys) -> TyCon -> [Type] -> Type
mkTyConApp TyCon
fam_tc [Type]
tys
mkFunBindSE :: Arity -> SrcSpan -> RdrName
-> [([LPat GhcPs], LHsExpr GhcPs)]
-> LHsBind GhcPs
mkFunBindSE :: Int
-> SrcSpan
-> RdrName
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindSE Int
arity SrcSpan
loc RdrName
fun [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
pats_and_exprs
= Int
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindSE Int
arity (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
fun) [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches
where
matches :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches = [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 (GenLocated (Anno (IdGhcP (NoGhcTcPass 'Parsed))) RdrName
-> AnnFunRhs
-> HsMatchContext
(GenLocated (Anno (IdGhcP (NoGhcTcPass 'Parsed))) RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs (Anno (IdGhcP (NoGhcTcPass 'Parsed))
-> RdrName
-> GenLocated (Anno (IdGhcP (NoGhcTcPass 'Parsed))) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> Anno (IdGhcP (NoGhcTcPass 'Parsed))
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
fun) AnnFunRhs
forall a. NoAnn a => a
noAnn)
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA ((GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
p)) LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e
HsLocalBinds (GhcPass 'Parsed)
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds
| ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
p,LocatedA (HsExpr (GhcPass 'Parsed))
e) <-[([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
[([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
pats_and_exprs]
mkRdrFunBind :: LocatedN RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsBind GhcPs
mkRdrFunBind :: GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBind fun :: GenLocated SrcSpanAnnN RdrName
fun@(L SrcSpanAnnN
loc RdrName
_fun_rdr) [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
matches
= SrcSpanAnnA
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
loc) (Origin
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
mkFunBind (GenReason -> DoPmc -> Origin
Generated GenReason
OtherExpansion DoPmc
SkipPmc) GenLocated SrcSpanAnnN RdrName
fun [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
matches)
mkFunBindEC :: Arity -> SrcSpan -> RdrName
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> [([LPat GhcPs], LHsExpr GhcPs)]
-> LHsBind GhcPs
mkFunBindEC :: Int
-> SrcSpan
-> RdrName
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkFunBindEC Int
arity SrcSpan
loc RdrName
fun LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
catch_all [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
pats_and_exprs
= Int
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindEC Int
arity LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
catch_all (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
fun) [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches
where
matches :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches = [ 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 (GenLocated (Anno (IdGhcP (NoGhcTcPass 'Parsed))) RdrName
-> AnnFunRhs
-> HsMatchContext
(GenLocated (Anno (IdGhcP (NoGhcTcPass 'Parsed))) RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs (Anno (IdGhcP (NoGhcTcPass 'Parsed))
-> RdrName
-> GenLocated (Anno (IdGhcP (NoGhcTcPass 'Parsed))) RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> Anno (IdGhcP (NoGhcTcPass 'Parsed))
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) RdrName
fun) AnnFunRhs
forall a. NoAnn a => a
noAnn)
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA ((GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
p)) LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e
HsLocalBinds (GhcPass 'Parsed)
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds
| ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
p,LocatedA (HsExpr (GhcPass 'Parsed))
e) <- [([LPat (GhcPass 'Parsed)], LHsExpr (GhcPass 'Parsed))]
[([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))],
LocatedA (HsExpr (GhcPass 'Parsed)))]
pats_and_exprs ]
mkRdrFunBindEC :: Arity
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LocatedN RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsBind GhcPs
mkRdrFunBindEC :: Int
-> (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindEC Int
arity LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
catch_all fun :: GenLocated SrcSpanAnnN RdrName
fun@(L SrcSpanAnnN
loc RdrName
_fun_rdr) [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
matches
= SrcSpanAnnA
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
loc) (Origin
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
mkFunBind (GenReason -> DoPmc -> Origin
Generated GenReason
OtherExpansion DoPmc
SkipPmc) GenLocated SrcSpanAnnN RdrName
fun [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches')
where
matches' :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches' = if [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches
then [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 (GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
fun AnnFunRhs
forall a. NoAnn a => a
noAnn)
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Int
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a. Int -> a -> [a]
replicate (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat) [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
z_Pat]))
(LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
catch_all (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase LHsExpr (GhcPass 'Parsed)
z_Expr [])
HsLocalBinds (GhcPass 'Parsed)
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds]
else [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches
mkRdrFunBindSE :: Arity -> LocatedN RdrName ->
[LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
mkRdrFunBindSE :: Int
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsBind (GhcPass 'Parsed)
mkRdrFunBindSE Int
arity fun :: GenLocated SrcSpanAnnN RdrName
fun@(L SrcSpanAnnN
loc RdrName
fun_rdr) [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
matches
= SrcSpanAnnA
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
loc) (Origin
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
mkFunBind (GenReason -> DoPmc -> Origin
Generated GenReason
OtherExpansion DoPmc
SkipPmc) GenLocated SrcSpanAnnN RdrName
fun [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches')
where
matches' :: [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches' = if [GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches
then [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 (GenLocated SrcSpanAnnN RdrName
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN RdrName)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs GenLocated SrcSpanAnnN RdrName
fun AnnFunRhs
forall a. NoAnn a => a
noAnn)
([GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Int
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a. Int -> a -> [a]
replicate Int
arity LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
nlWildPat))
(FastString -> LHsExpr (GhcPass 'Parsed)
error_Expr FastString
str) HsLocalBinds (GhcPass 'Parsed)
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds]
else [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
SrcSpanAnnA
(Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches
str :: FastString
str = String -> FastString
fsLit String
"Void " FastString -> FastString -> FastString
`appendFS` OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
fun_rdr)
box :: String
-> LHsExpr GhcPs
-> Type
-> LHsExpr GhcPs
box :: String
-> LHsExpr (GhcPass 'Parsed) -> Type -> LHsExpr (GhcPass 'Parsed)
box String
cls_str LHsExpr (GhcPass 'Parsed)
arg Type
arg_ty = LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (String
-> [(Type, LocatedA (HsExpr (GhcPass 'Parsed)))]
-> Type
-> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. HasDebugCallStack => String -> [(Type, a)] -> Type -> a
assoc_ty_id String
cls_str [(Type, LHsExpr (GhcPass 'Parsed))]
[(Type, LocatedA (HsExpr (GhcPass 'Parsed)))]
boxConTbl Type
arg_ty) LHsExpr (GhcPass 'Parsed)
arg
primOrdOps :: String
-> Type
-> (RdrName, RdrName, RdrName, RdrName, RdrName)
primOrdOps :: String -> Type -> (RdrName, RdrName, RdrName, RdrName, RdrName)
primOrdOps String
str Type
ty = String
-> [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
-> Type
-> (RdrName, RdrName, RdrName, RdrName, RdrName)
forall a. HasDebugCallStack => String -> [(Type, a)] -> Type -> a
assoc_ty_id String
str [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
ordOpTbl Type
ty
ordOpTbl :: [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
ordOpTbl :: [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
ordOpTbl
= [(Type
charPrimTy , (RdrName
ltChar_RDR , RdrName
leChar_RDR
, RdrName
eqChar_RDR , RdrName
geChar_RDR , RdrName
gtChar_RDR ))
,(Type
intPrimTy , (RdrName
ltInt_RDR , RdrName
leInt_RDR
, RdrName
eqInt_RDR , RdrName
geInt_RDR , RdrName
gtInt_RDR ))
,(Type
int8PrimTy , (RdrName
ltInt8_RDR , RdrName
leInt8_RDR
, RdrName
eqInt8_RDR , RdrName
geInt8_RDR , RdrName
gtInt8_RDR ))
,(Type
int16PrimTy , (RdrName
ltInt16_RDR , RdrName
leInt16_RDR
, RdrName
eqInt16_RDR , RdrName
geInt16_RDR , RdrName
gtInt16_RDR ))
,(Type
int32PrimTy , (RdrName
ltInt32_RDR , RdrName
leInt32_RDR
, RdrName
eqInt32_RDR , RdrName
geInt32_RDR , RdrName
gtInt32_RDR ))
,(Type
int64PrimTy , (RdrName
ltInt64_RDR , RdrName
leInt64_RDR
, RdrName
eqInt64_RDR , RdrName
geInt64_RDR , RdrName
gtInt64_RDR ))
,(Type
wordPrimTy , (RdrName
ltWord_RDR , RdrName
leWord_RDR
, RdrName
eqWord_RDR , RdrName
geWord_RDR , RdrName
gtWord_RDR ))
,(Type
word8PrimTy , (RdrName
ltWord8_RDR , RdrName
leWord8_RDR
, RdrName
eqWord8_RDR , RdrName
geWord8_RDR , RdrName
gtWord8_RDR ))
,(Type
word16PrimTy, (RdrName
ltWord16_RDR, RdrName
leWord16_RDR
, RdrName
eqWord16_RDR, RdrName
geWord16_RDR, RdrName
gtWord16_RDR ))
,(Type
word32PrimTy, (RdrName
ltWord32_RDR, RdrName
leWord32_RDR
, RdrName
eqWord32_RDR, RdrName
geWord32_RDR, RdrName
gtWord32_RDR ))
,(Type
word64PrimTy, (RdrName
ltWord64_RDR, RdrName
leWord64_RDR
, RdrName
eqWord64_RDR, RdrName
geWord64_RDR, RdrName
gtWord64_RDR ))
,(Type
addrPrimTy , (RdrName
ltAddr_RDR , RdrName
leAddr_RDR
, RdrName
eqAddr_RDR , RdrName
geAddr_RDR , RdrName
gtAddr_RDR ))
,(Type
floatPrimTy , (RdrName
ltFloat_RDR , RdrName
leFloat_RDR
, RdrName
eqFloat_RDR , RdrName
geFloat_RDR , RdrName
gtFloat_RDR ))
,(Type
doublePrimTy, (RdrName
ltDouble_RDR, RdrName
leDouble_RDR
, RdrName
eqDouble_RDR, RdrName
geDouble_RDR, RdrName
gtDouble_RDR)) ]
boxConTbl :: [(Type, LHsExpr GhcPs)]
boxConTbl :: [(Type, LHsExpr (GhcPass 'Parsed))]
boxConTbl =
[ (Type
charPrimTy , IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
charDataCon)
, (Type
intPrimTy , IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
intDataCon)
, (Type
wordPrimTy , IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
wordDataCon)
, (Type
floatPrimTy , IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
floatDataCon)
, (Type
doublePrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
doubleDataCon)
, (Type
int8PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
int8DataCon_RDR)
, (Type
word8PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
word8DataCon_RDR)
, (Type
int16PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
int16DataCon_RDR)
, (Type
word16PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
word16DataCon_RDR)
, (Type
int32PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
int32DataCon_RDR)
, (Type
word32PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
word32DataCon_RDR)
, (Type
int64PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
int64DataCon_RDR)
, (Type
word64PrimTy, IdP (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass 'Parsed)
RdrName
word64DataCon_RDR)
]
postfixModTbl :: [(Type, String)]
postfixModTbl :: [(Type, String)]
postfixModTbl
= [(Type
charPrimTy , String
"#" )
,(Type
intPrimTy , String
"#" )
,(Type
wordPrimTy , String
"##")
,(Type
floatPrimTy , String
"#" )
,(Type
doublePrimTy, String
"##")
,(Type
int8PrimTy , String
"#Int8")
,(Type
word8PrimTy , String
"#Word8")
,(Type
int16PrimTy , String
"#Int16")
,(Type
word16PrimTy, String
"#Word16")
,(Type
int32PrimTy , String
"#Int32")
,(Type
word32PrimTy, String
"#Word32")
,(Type
int64PrimTy , String
"#Int64")
,(Type
word64PrimTy, String
"#Word64")
]
assoc_ty_id :: HasDebugCallStack => String
-> [(Type,a)]
-> Type
-> a
assoc_ty_id :: forall a. HasDebugCallStack => String -> [(Type, a)] -> Type -> a
assoc_ty_id String
cls_str [(Type, a)]
tbl Type
ty
| Just a
a <- [(Type, a)] -> Type -> Maybe a
forall a. [(Type, a)] -> Type -> Maybe a
assoc_ty_id_maybe [(Type, a)]
tbl Type
ty = a
a
| Bool
otherwise =
String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Error in deriving:"
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't derive" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
cls_str SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for primitive type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
assoc_ty_id_maybe :: [(Type, a)] -> Type -> Maybe a
assoc_ty_id_maybe :: forall a. [(Type, a)] -> Type -> Maybe a
assoc_ty_id_maybe [(Type, a)]
tbl Type
ty = (Type, a) -> a
forall a b. (a, b) -> b
snd ((Type, a) -> a) -> Maybe (Type, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Type, a) -> Bool) -> [(Type, a)] -> Maybe (Type, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Type
t, a
_) -> Type
t HasCallStack => Type -> Type -> Bool
Type -> Type -> Bool
`eqType` Type
ty) [(Type, a)]
tbl
and_Expr :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
and_Expr :: LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
and_Expr LHsExpr (GhcPass 'Parsed)
a LHsExpr (GhcPass 'Parsed)
b = LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp LHsExpr (GhcPass 'Parsed)
a RdrName
and_RDR LHsExpr (GhcPass 'Parsed)
b
eq_Expr :: Type -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
eq_Expr :: Type
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
eq_Expr Type
ty LHsExpr (GhcPass 'Parsed)
a LHsExpr (GhcPass 'Parsed)
b
| Bool -> Bool
not (HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType Type
ty) = LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp LHsExpr (GhcPass 'Parsed)
a RdrName
eq_RDR LHsExpr (GhcPass 'Parsed)
b
| Bool
otherwise = LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp LHsExpr (GhcPass 'Parsed)
a RdrName
prim_eq LHsExpr (GhcPass 'Parsed)
b
where
(RdrName
_, RdrName
_, RdrName
prim_eq, RdrName
_, RdrName
_) = String -> Type -> (RdrName, RdrName, RdrName, RdrName, RdrName)
primOrdOps String
"Eq" Type
ty
untag_Expr :: [(RdrName, RdrName)]
-> LHsExpr GhcPs -> LHsExpr GhcPs
untag_Expr :: [(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [] LHsExpr (GhcPass 'Parsed)
expr = LHsExpr (GhcPass 'Parsed)
expr
untag_Expr ((RdrName
untag_this, RdrName
put_tag_here) : [(RdrName, RdrName)]
more) LHsExpr (GhcPass 'Parsed)
expr
= LHsExpr (GhcPass 'Parsed)
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
nlHsCase (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (IdP (GhcPass 'Parsed)
-> [IdP (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass 'Parsed)
RdrName
dataToTag_RDR [IdP (GhcPass 'Parsed)
RdrName
untag_this]))
[LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnn NoEpAnns,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt (IdP (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass 'Parsed)
RdrName
put_tag_here) ([(RdrName, RdrName)]
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
untag_Expr [(RdrName, RdrName)]
more LHsExpr (GhcPass 'Parsed)
expr)]
enum_from_to_Expr
:: LHsExpr GhcPs -> LHsExpr GhcPs
-> LHsExpr GhcPs
enum_from_then_to_Expr
:: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
-> LHsExpr GhcPs
enum_from_to_Expr :: LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
enum_from_to_Expr LHsExpr (GhcPass 'Parsed)
f LHsExpr (GhcPass 'Parsed)
t2 = 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)
-> 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
enumFromTo_RDR) LHsExpr (GhcPass 'Parsed)
f) LHsExpr (GhcPass 'Parsed)
t2
enum_from_then_to_Expr :: LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
enum_from_then_to_Expr LHsExpr (GhcPass 'Parsed)
f LHsExpr (GhcPass 'Parsed)
t LHsExpr (GhcPass 'Parsed)
t2 = 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)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (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
enumFromThenTo_RDR) LHsExpr (GhcPass 'Parsed)
f) LHsExpr (GhcPass 'Parsed)
t) LHsExpr (GhcPass 'Parsed)
t2
showParen_Expr
:: LHsExpr GhcPs -> LHsExpr GhcPs
-> LHsExpr GhcPs
showParen_Expr :: LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
showParen_Expr LHsExpr (GhcPass 'Parsed)
e1 LHsExpr (GhcPass 'Parsed)
e2 = 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)
-> 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
showParen_RDR) LHsExpr (GhcPass 'Parsed)
e1) LHsExpr (GhcPass 'Parsed)
e2
nested_compose_Expr :: [LHsExpr GhcPs] -> LHsExpr GhcPs
nested_compose_Expr :: [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
nested_compose_Expr [] = String -> LocatedA (HsExpr (GhcPass 'Parsed))
forall a. HasCallStack => String -> a
panic String
"nested_compose_expr"
nested_compose_Expr [LHsExpr (GhcPass 'Parsed)
e] = LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
parenify LHsExpr (GhcPass 'Parsed)
e
nested_compose_Expr (LHsExpr (GhcPass 'Parsed)
e:[LHsExpr (GhcPass 'Parsed)]
es)
= 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)
-> 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
compose_RDR) (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
parenify LHsExpr (GhcPass 'Parsed)
e)) ([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
nested_compose_Expr [LHsExpr (GhcPass 'Parsed)]
es)
error_Expr :: FastString -> LHsExpr GhcPs
error_Expr :: FastString -> LHsExpr (GhcPass 'Parsed)
error_Expr FastString
string = 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
error_RDR) (HsLit (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (FastString -> HsLit (GhcPass 'Parsed)
forall (p :: Pass). FastString -> HsLit (GhcPass p)
mkHsStringFS FastString
string))
parenify :: LHsExpr GhcPs -> LHsExpr GhcPs
parenify :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
parenify e :: LHsExpr (GhcPass 'Parsed)
e@(L SrcSpanAnnA
_ (HsVar XVar (GhcPass 'Parsed)
_ LIdP (GhcPass 'Parsed)
_)) = LHsExpr (GhcPass 'Parsed)
e
parenify LHsExpr (GhcPass 'Parsed)
e = LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsPar LHsExpr (GhcPass 'Parsed)
e
genOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs
genOpApp :: LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genOpApp LHsExpr (GhcPass 'Parsed)
e1 RdrName
op LHsExpr (GhcPass 'Parsed)
e2 = LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (LHsExpr (GhcPass 'Parsed)
-> IdP (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsOpApp LHsExpr (GhcPass 'Parsed)
e1 IdP (GhcPass 'Parsed)
RdrName
op LHsExpr (GhcPass 'Parsed)
e2)
genPrimOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs
genPrimOpApp :: LHsExpr (GhcPass 'Parsed)
-> RdrName
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
genPrimOpApp LHsExpr (GhcPass 'Parsed)
e1 RdrName
op LHsExpr (GhcPass 'Parsed)
e2 = LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsPar (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
tagToEnum_RDR) (LHsExpr (GhcPass 'Parsed)
-> IdP (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
nlHsOpApp LHsExpr (GhcPass 'Parsed)
e1 IdP (GhcPass 'Parsed)
RdrName
op LHsExpr (GhcPass 'Parsed)
e2))
a_RDR, b_RDR, c_RDR, d_RDR, f_RDR, k_RDR, z_RDR, ah_RDR, bh_RDR, ch_RDR, dh_RDR
:: RdrName
a_RDR :: RdrName
a_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"a")
b_RDR :: RdrName
b_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"b")
c_RDR :: RdrName
c_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"c")
d_RDR :: RdrName
d_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"d")
f_RDR :: RdrName
f_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"f")
k_RDR :: RdrName
k_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"k")
z_RDR :: RdrName
z_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"z")
ah_RDR :: RdrName
ah_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"a#")
bh_RDR :: RdrName
bh_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"b#")
ch_RDR :: RdrName
ch_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"c#")
dh_RDR :: RdrName
dh_RDR = FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"d#")
as_RDRs, bs_RDRs, cs_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) .. ] ]
cs_RDRs :: [RdrName]
cs_RDRs = [ FastString -> RdrName
mkVarUnqual (String -> FastString
mkFastString (String
"c"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i)) | Int
i <- [(Int
1::Int) .. ] ]
a_Expr, b_Expr, c_Expr, z_Expr, ltTag_Expr, eqTag_Expr, gtTag_Expr, false_Expr,
true_Expr, pure_Expr, unsafeCodeCoerce_Expr :: LHsExpr GhcPs
a_Expr :: LHsExpr (GhcPass 'Parsed)
a_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
a_RDR
b_Expr :: LHsExpr (GhcPass 'Parsed)
b_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
b_RDR
c_Expr :: LHsExpr (GhcPass 'Parsed)
c_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
c_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
ltTag_Expr :: LHsExpr (GhcPass 'Parsed)
ltTag_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
ltTag_RDR
eqTag_Expr :: LHsExpr (GhcPass 'Parsed)
eqTag_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
eqTag_RDR
gtTag_Expr :: LHsExpr (GhcPass 'Parsed)
gtTag_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
gtTag_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
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
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
unsafeCodeCoerce_Expr :: LHsExpr (GhcPass 'Parsed)
unsafeCodeCoerce_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
unsafeCodeCoerce_RDR
a_Pat, b_Pat, c_Pat, d_Pat, k_Pat, z_Pat :: LPat GhcPs
a_Pat :: LPat (GhcPass 'Parsed)
a_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
a_RDR
b_Pat :: LPat (GhcPass 'Parsed)
b_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
b_RDR
c_Pat :: LPat (GhcPass 'Parsed)
c_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
c_RDR
d_Pat :: LPat (GhcPass 'Parsed)
d_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
d_RDR
k_Pat :: LPat (GhcPass 'Parsed)
k_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
k_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
minusInt_RDR, tagToEnum_RDR :: RdrName
minusInt_RDR :: RdrName
minusInt_RDR = Id -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (PrimOp -> Id
primOpId PrimOp
IntSubOp )
tagToEnum_RDR :: RdrName
tagToEnum_RDR = Id -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (PrimOp -> Id
primOpId PrimOp
TagToEnumOp)
new_tag2con_rdr_name, new_maxtag_rdr_name
:: SrcSpan -> TyCon -> TcM RdrName
new_tag2con_rdr_name :: SrcSpan -> TyCon -> TcM RdrName
new_tag2con_rdr_name SrcSpan
dflags TyCon
tycon = SrcSpan -> TyCon -> (OccName -> OccName) -> TcM RdrName
new_tc_deriv_rdr_name SrcSpan
dflags TyCon
tycon OccName -> OccName
mkTag2ConOcc
new_maxtag_rdr_name :: SrcSpan -> TyCon -> TcM RdrName
new_maxtag_rdr_name SrcSpan
dflags TyCon
tycon = SrcSpan -> TyCon -> (OccName -> OccName) -> TcM RdrName
new_tc_deriv_rdr_name SrcSpan
dflags TyCon
tycon OccName -> OccName
mkMaxTagOcc
new_dataT_rdr_name :: SrcSpan -> TyCon -> TcM RdrName
new_dataT_rdr_name :: SrcSpan -> TyCon -> TcM RdrName
new_dataT_rdr_name SrcSpan
dflags TyCon
tycon = SrcSpan -> TyCon -> (OccName -> OccName) -> TcM RdrName
new_tc_deriv_rdr_name SrcSpan
dflags TyCon
tycon OccName -> OccName
mkDataTOcc
new_dataC_rdr_name :: SrcSpan -> DataCon -> TcM RdrName
new_dataC_rdr_name :: SrcSpan -> DataCon -> TcM RdrName
new_dataC_rdr_name SrcSpan
dflags DataCon
dc = SrcSpan -> DataCon -> (OccName -> OccName) -> TcM RdrName
new_dc_deriv_rdr_name SrcSpan
dflags DataCon
dc OccName -> OccName
mkDataCOcc
new_tc_deriv_rdr_name :: SrcSpan -> TyCon -> (OccName -> OccName) -> TcM RdrName
new_tc_deriv_rdr_name :: SrcSpan -> TyCon -> (OccName -> OccName) -> TcM RdrName
new_tc_deriv_rdr_name SrcSpan
loc TyCon
tycon OccName -> OccName
occ_fun
= SrcSpan -> Name -> (OccName -> OccName) -> TcM RdrName
newAuxBinderRdrName SrcSpan
loc (TyCon -> Name
tyConName TyCon
tycon) OccName -> OccName
occ_fun
new_dc_deriv_rdr_name :: SrcSpan -> DataCon -> (OccName -> OccName) -> TcM RdrName
new_dc_deriv_rdr_name :: SrcSpan -> DataCon -> (OccName -> OccName) -> TcM RdrName
new_dc_deriv_rdr_name SrcSpan
loc DataCon
dc OccName -> OccName
occ_fun
= SrcSpan -> Name -> (OccName -> OccName) -> TcM RdrName
newAuxBinderRdrName SrcSpan
loc (DataCon -> Name
dataConName DataCon
dc) OccName -> OccName
occ_fun
newAuxBinderRdrName :: SrcSpan -> Name -> (OccName -> OccName) -> TcM RdrName
newAuxBinderRdrName :: SrcSpan -> Name -> (OccName -> OccName) -> TcM RdrName
newAuxBinderRdrName SrcSpan
loc Name
parent OccName -> OccName
occ_fun = do
uniq <- TcRnIf TcGblEnv TcLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
pure $ Exact $ mkSystemNameAt uniq (occ_fun (nameOccName parent)) loc
getPossibleDataCons :: TyCon -> [Type] -> [DataCon]
getPossibleDataCons :: TyCon -> [Type] -> [DataCon]
getPossibleDataCons TyCon
tycon [Type]
tycon_args = (DataCon -> Bool) -> [DataCon] -> [DataCon]
forall a. (a -> Bool) -> [a] -> [a]
filter DataCon -> Bool
isPossible ([DataCon] -> [DataCon]) -> [DataCon] -> [DataCon]
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
tycon
where
isPossible :: DataCon -> Bool
isPossible DataCon
dc = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Type] -> DataCon -> Bool
dataConCannotMatch (DataCon -> [Type] -> [Type]
dataConInstUnivs DataCon
dc [Type]
tycon_args) DataCon
dc
data DerivInstTys = DerivInstTys
{ DerivInstTys -> [Type]
dit_cls_tys :: [Type]
, DerivInstTys -> TyCon
dit_tc :: TyCon
, DerivInstTys -> [Type]
dit_tc_args :: [Type]
, DerivInstTys -> TyCon
dit_rep_tc :: TyCon
, DerivInstTys -> [Type]
dit_rep_tc_args :: [Type]
, DerivInstTys -> DataConEnv [Type]
dit_dc_inst_arg_env :: DataConEnv [Type]
}
instance Outputable DerivInstTys where
ppr :: DerivInstTys -> SDoc
ppr (DerivInstTys { dit_cls_tys :: DerivInstTys -> [Type]
dit_cls_tys = [Type]
cls_tys, dit_tc :: DerivInstTys -> TyCon
dit_tc = TyCon
tc, dit_tc_args :: DerivInstTys -> [Type]
dit_tc_args = [Type]
tc_args
, dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
rep_tc, dit_rep_tc_args :: DerivInstTys -> [Type]
dit_rep_tc_args = [Type]
rep_tc_args
, dit_dc_inst_arg_env :: DerivInstTys -> DataConEnv [Type]
dit_dc_inst_arg_env = DataConEnv [Type]
dc_inst_arg_env })
= SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DerivInstTys")
Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dit_cls_tys" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
cls_tys
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dit_tc" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dit_tc_args" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
tc_args
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dit_rep_tc" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dit_rep_tc_args" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rep_tc_args
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dit_dc_inst_arg_env" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataConEnv [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataConEnv [Type]
dc_inst_arg_env ])
derivDataConInstArgTys :: DataCon -> DerivInstTys -> [Type]
derivDataConInstArgTys :: DataCon -> DerivInstTys -> [Type]
derivDataConInstArgTys DataCon
dc DerivInstTys
dit =
case DataConEnv [Type] -> DataCon -> Maybe [Type]
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (DerivInstTys -> DataConEnv [Type]
dit_dc_inst_arg_env DerivInstTys
dit) DataCon
dc of
Just [Type]
inst_arg_tys -> [Type]
inst_arg_tys
Maybe [Type]
Nothing -> String -> SDoc -> [Type]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"derivDataConInstArgTys" (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc)
buildDataConInstArgEnv :: TyCon -> [Type] -> DataConEnv [Type]
buildDataConInstArgEnv :: TyCon -> [Type] -> DataConEnv [Type]
buildDataConInstArgEnv TyCon
rep_tc [Type]
rep_tc_args =
[(DataCon, [Type])] -> DataConEnv [Type]
forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM [ (DataCon
dc, [Type]
inst_arg_tys)
| DataCon
dc <- TyCon -> [DataCon]
tyConDataCons TyCon
rep_tc
, let ([Id]
_, [Type]
_, [Type]
inst_arg_tys) =
DataCon -> [Type] -> ([Id], [Type], [Type])
dataConInstSig DataCon
dc ([Type] -> ([Id], [Type], [Type]))
-> [Type] -> ([Id], [Type], [Type])
forall a b. (a -> b) -> a -> b
$ DataCon -> [Type] -> [Type]
dataConInstUnivs DataCon
dc [Type]
rep_tc_args
]
substDerivInstTys :: Subst -> DerivInstTys -> DerivInstTys
substDerivInstTys :: Subst -> DerivInstTys -> DerivInstTys
substDerivInstTys Subst
subst
dit :: DerivInstTys
dit@(DerivInstTys { dit_cls_tys :: DerivInstTys -> [Type]
dit_cls_tys = [Type]
cls_tys, dit_tc_args :: DerivInstTys -> [Type]
dit_tc_args = [Type]
tc_args
, dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
rep_tc, dit_rep_tc_args :: DerivInstTys -> [Type]
dit_rep_tc_args = [Type]
rep_tc_args })
| Subst -> Bool
isEmptyTCvSubst Subst
subst
= DerivInstTys
dit
| Bool
otherwise
= DerivInstTys
dit{ dit_cls_tys = cls_tys'
, dit_tc_args = tc_args'
, dit_rep_tc_args = rep_tc_args'
, dit_dc_inst_arg_env = buildDataConInstArgEnv rep_tc rep_tc_args'
}
where
cls_tys' :: [Type]
cls_tys' = HasDebugCallStack => Subst -> [Type] -> [Type]
Subst -> [Type] -> [Type]
substTys Subst
subst [Type]
cls_tys
tc_args' :: [Type]
tc_args' = HasDebugCallStack => Subst -> [Type] -> [Type]
Subst -> [Type] -> [Type]
substTys Subst
subst [Type]
tc_args
rep_tc_args' :: [Type]
rep_tc_args' = HasDebugCallStack => Subst -> [Type] -> [Type]
Subst -> [Type] -> [Type]
substTys Subst
subst [Type]
rep_tc_args
zonkDerivInstTys :: DerivInstTys -> ZonkT TcM DerivInstTys
zonkDerivInstTys :: DerivInstTys -> ZonkT TcM DerivInstTys
zonkDerivInstTys dit :: DerivInstTys
dit@(DerivInstTys { dit_cls_tys :: DerivInstTys -> [Type]
dit_cls_tys = [Type]
cls_tys
, dit_tc_args :: DerivInstTys -> [Type]
dit_tc_args = [Type]
tc_args
, dit_rep_tc :: DerivInstTys -> TyCon
dit_rep_tc = TyCon
rep_tc
, dit_rep_tc_args :: DerivInstTys -> [Type]
dit_rep_tc_args = [Type]
rep_tc_args }) = do
cls_tys' <- [Type] -> ZonkTcM [Type]
zonkTcTypesToTypesX [Type]
cls_tys
tc_args' <- zonkTcTypesToTypesX tc_args
rep_tc_args' <- zonkTcTypesToTypesX rep_tc_args
pure dit{ dit_cls_tys = cls_tys'
, dit_tc_args = tc_args'
, dit_rep_tc_args = rep_tc_args'
, dit_dc_inst_arg_env = buildDataConInstArgEnv rep_tc rep_tc_args'
}