{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
module GHC.Parser.PostProcess (
mkRdrGetField, mkRdrProjection, Fbind,
mkHsOpApp,
mkHsIntegral, mkHsFractional, mkHsIsString,
mkHsDo, mkSpliceDecl,
mkRoleAnnotDecl,
mkClassDecl,
mkTyData, mkDataFamInst,
mkTySynonym, mkTyFamInstEqn,
mkStandaloneKindSig,
mkTyFamInst,
mkFamDecl,
mkInlinePragma,
mkOpaquePragma,
mkPatSynMatchGroup,
mkRecConstrOrUpdate,
mkTyClD, mkInstD,
mkRdrRecordCon, mkRdrRecordUpd,
setRdrNameSpace,
fromSpecTyVarBndr, fromSpecTyVarBndrs,
annBinds,
fixValbindsAnn,
stmtsAnchor, stmtsLoc,
cvBindGroup,
cvBindsAndSigs,
cvTopDecls,
placeHolderPunRhs,
mkImport,
parseCImport,
mkExport,
mkExtName,
mkGadtDecl,
mkConDeclH98,
checkImportDecl,
checkExpBlockArguments, checkCmdBlockArguments,
checkPrecP,
checkContext,
checkPattern,
checkPattern_details,
incompleteDoBlock,
ParseContext(..),
checkMonadComp,
checkValDef,
checkValSigLhs,
LRuleTyTmVar, RuleTyTmVar(..),
mkRuleBndrs, mkRuleTyVarBndrs,
checkRuleTyVarBndrNames,
checkRecordSyntax,
checkEmptyGADTs,
addFatalError, hintBangPat,
mkBangTy,
UnpackednessPragma(..),
mkMultTy,
mkMultAnn,
mkTokenLocation,
ImpExpSubSpec(..),
ImpExpQcSpec(..),
mkModuleImpExp,
mkTypeImpExp,
mkImpExpSubSpec,
checkImportSpec,
starSym,
warnStarIsType,
warnPrepositiveQualifiedModule,
failOpFewArgs,
failNotEnabledImportQualifiedPost,
failImportQualifiedTwice,
requireExplicitNamespaces,
SumOrTuple (..),
PV,
runPV,
ECP(ECP, unECP),
DisambInfixOp(..),
DisambECP(..),
ecpFromExp,
ecpFromCmd,
PatBuilder,
hsHoleExpr,
DisambTD(..),
addUnpackednessP,
dataConBuilderCon,
dataConBuilderDetails,
mkUnboxedSumCon,
mkTupleSyntaxTy,
mkTupleSyntaxTycon,
mkListSyntaxTy0,
mkListSyntaxTy1,
withCombinedComments,
requireLTPuns,
) where
import GHC.Prelude
import GHC.Hs
import GHC.Core.TyCon ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
import GHC.Core.DataCon ( DataCon, dataConTyCon )
import GHC.Core.ConLike ( ConLike(..) )
import GHC.Core.Coercion.Axiom ( Role, fsFromRole )
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Types.Error
import GHC.Types.Fixity
import GHC.Types.Hint
import GHC.Types.SourceText
import GHC.Parser.Types
import GHC.Parser.Lexer
import GHC.Parser.Errors.Types
import GHC.Parser.Errors.Ppr ()
import GHC.Utils.Lexeme ( okConOcc )
import GHC.Types.TyThing
import GHC.Core.Type ( Specificity(..) )
import GHC.Builtin.Types( cTupleTyConName, tupleTyCon, tupleDataCon,
nilDataConName, nilDataConKey,
listTyConName, listTyConKey, sumDataCon,
unrestrictedFunTyCon , listTyCon_RDR )
import GHC.Types.ForeignCall
import GHC.Types.SrcLoc
import GHC.Types.Unique ( hasKey )
import GHC.Data.OrdList
import GHC.Utils.Outputable as Outputable
import GHC.Data.FastString
import GHC.Data.Maybe
import GHC.Utils.Error
import GHC.Utils.Misc
import GHC.Utils.Monad (unlessM)
import Data.Either
import Data.List ( findIndex )
import Data.Foldable
import qualified Data.Semigroup as Semi
import GHC.Unit.Module.Warnings
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import Control.Monad
import Text.ParserCombinators.ReadP as ReadP
import Data.Char
import Data.Data ( dataTypeOf, fromConstr, dataTypeConstrs )
import Data.Kind ( Type )
import Data.List.NonEmpty (NonEmpty)
mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkTyClD :: forall (p :: Pass). LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkTyClD (L SrcSpanAnnA
loc TyClDecl (GhcPass p)
d) = SrcSpanAnnA
-> HsDecl (GhcPass p)
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass p))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XTyClD (GhcPass p) -> TyClDecl (GhcPass p) -> HsDecl (GhcPass p)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass p)
NoExtField
noExtField TyClDecl (GhcPass p)
d)
mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkInstD :: forall (p :: Pass). LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkInstD (L SrcSpanAnnA
loc InstDecl (GhcPass p)
d) = SrcSpanAnnA
-> HsDecl (GhcPass p)
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass p))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XInstD (GhcPass p) -> InstDecl (GhcPass p) -> HsDecl (GhcPass p)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD (GhcPass p)
NoExtField
noExtField InstDecl (GhcPass p)
d)
mkClassDecl :: SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a,[LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
-> EpLayout
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkClassDecl :: forall a.
SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a, [LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
-> EpLayout
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkClassDecl SrcSpan
loc' (L SrcSpan
_ (Maybe (LHsContext GhcPs)
mcxt, LHsType GhcPs
tycl_hdr)) Located (a, [LHsFunDep GhcPs])
fds OrdList (LHsDecl GhcPs)
where_cls EpLayout
layout [AddEpAnn]
annsIn
= do { (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
binds, [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs, [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
ats, [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
at_defs, [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
_, [GenLocated SrcSpanAnnA (DocDecl GhcPs)]
docs) <- OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
where_cls
; (LocatedN RdrName
cls, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann, EpAnnComments
cs) <- Bool
-> LHsType GhcPs
-> P (LocatedN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
[AddEpAnn], EpAnnComments)
checkTyClHdr Bool
True LHsType GhcPs
tycl_hdr
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> LocatedN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"class") SDoc
whereDots LocatedN RdrName
cls [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; let anns' :: [AddEpAnn]
anns' = [AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
ann
; let loc :: SrcSpanAnnA
loc = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc') AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs
; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (ClassDecl { tcdCExt :: XClassDecl GhcPs
tcdCExt = ([AddEpAnn]
anns', EpLayout
layout, AnnSortKey DeclTag
forall tag. AnnSortKey tag
NoAnnSortKey)
, tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt = Maybe (LHsContext GhcPs)
mcxt
, tcdLName :: XRec GhcPs (IdP GhcPs)
tcdLName = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
cls, tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tyvars
, tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
fixity
, tcdFDs :: [LHsFunDep GhcPs]
tcdFDs = (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
-> [GenLocated SrcSpanAnnA (FunDep GhcPs)]
forall a b. (a, b) -> b
snd (GenLocated SrcSpan (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
-> (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
forall l e. GenLocated l e -> e
unLoc Located (a, [LHsFunDep GhcPs])
GenLocated SrcSpan (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
fds)
, tcdSigs :: [LSig GhcPs]
tcdSigs = [LSig GhcPs] -> [LSig GhcPs]
mkClassOpSigs [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs
, tcdMeths :: LHsBinds GhcPs
tcdMeths = LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
binds
, tcdATs :: [LFamilyDecl GhcPs]
tcdATs = [LFamilyDecl GhcPs]
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
ats, tcdATDefs :: [LTyFamInstDecl GhcPs]
tcdATDefs = [LTyFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
at_defs
, tcdDocs :: [LDocDecl GhcPs]
tcdDocs = [LDocDecl GhcPs]
[GenLocated SrcSpanAnnA (DocDecl GhcPs)]
docs })) }
mkTyData :: SrcSpan
-> Bool
-> NewOrData
-> Maybe (LocatedP CType)
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Maybe (LHsKind GhcPs)
-> [LConDecl GhcPs]
-> Located (HsDeriving GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkTyData :: SrcSpan
-> Bool
-> NewOrData
-> Maybe (LocatedP CType)
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Maybe (LHsType GhcPs)
-> [LConDecl GhcPs]
-> Located (HsDeriving GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkTyData SrcSpan
loc' Bool
is_type_data NewOrData
new_or_data Maybe (LocatedP CType)
cType (L SrcSpan
_ (Maybe (LHsContext GhcPs)
mcxt, LHsType GhcPs
tycl_hdr))
Maybe (LHsType GhcPs)
ksig [LConDecl GhcPs]
data_cons (L SrcSpan
_ HsDeriving GhcPs
maybe_deriv) [AddEpAnn]
annsIn
= do { (LocatedN RdrName
tc, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann, EpAnnComments
cs) <- Bool
-> LHsType GhcPs
-> P (LocatedN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
[AddEpAnn], EpAnnComments)
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> LocatedN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (NewOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr NewOrData
new_or_data) SDoc
equalsDots LocatedN RdrName
tc [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; let anns' :: [AddEpAnn]
anns' = [AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
ann
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
data_cons <- SrcSpan
-> RdrName
-> Bool
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData SrcSpan
loc' (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
tc) Bool
is_type_data NewOrData
new_or_data [LConDecl GhcPs]
data_cons
; HsDataDefn GhcPs
defn <- Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsType GhcPs)
-> DataDefnCons (LConDecl GhcPs)
-> HsDeriving GhcPs
-> P (HsDataDefn GhcPs)
mkDataDefn Maybe (LocatedP CType)
cType Maybe (LHsContext GhcPs)
mcxt Maybe (LHsType GhcPs)
ksig DataDefnCons (LConDecl GhcPs)
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
data_cons HsDeriving GhcPs
maybe_deriv
; !EpAnnComments
cs' <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc'
; let loc :: SrcSpanAnnA
loc = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc') AnnListItem
forall a. NoAnn a => a
noAnn (EpAnnComments
cs' EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs)
; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (DataDecl { tcdDExt :: XDataDecl GhcPs
tcdDExt = [AddEpAnn]
XDataDecl GhcPs
anns',
tcdLName :: XRec GhcPs (IdP GhcPs)
tcdLName = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
tc, tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tyvars,
tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
fixity,
tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn = HsDataDefn GhcPs
defn })) }
mkDataDefn :: Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsKind GhcPs)
-> DataDefnCons (LConDecl GhcPs)
-> HsDeriving GhcPs
-> P (HsDataDefn GhcPs)
mkDataDefn :: Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsType GhcPs)
-> DataDefnCons (LConDecl GhcPs)
-> HsDeriving GhcPs
-> P (HsDataDefn GhcPs)
mkDataDefn Maybe (LocatedP CType)
cType Maybe (LHsContext GhcPs)
mcxt Maybe (LHsType GhcPs)
ksig DataDefnCons (LConDecl GhcPs)
data_cons HsDeriving GhcPs
maybe_deriv
= do { Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Maybe (LHsContext GhcPs)
mcxt
; HsDataDefn GhcPs -> P (HsDataDefn GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsDataDefn { dd_ext :: XCHsDataDefn GhcPs
dd_ext = XCHsDataDefn GhcPs
NoExtField
noExtField
, dd_cType :: Maybe (XRec GhcPs CType)
dd_cType = Maybe (XRec GhcPs CType)
Maybe (LocatedP CType)
cType
, dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ctxt = Maybe (LHsContext GhcPs)
mcxt
, dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_cons = DataDefnCons (LConDecl GhcPs)
data_cons
, dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig = Maybe (LHsType GhcPs)
ksig
, dd_derivs :: HsDeriving GhcPs
dd_derivs = HsDeriving GhcPs
maybe_deriv }) }
mkTySynonym :: SrcSpan
-> LHsType GhcPs
-> LHsType GhcPs
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkTySynonym :: SrcSpan
-> LHsType GhcPs
-> LHsType GhcPs
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkTySynonym SrcSpan
loc LHsType GhcPs
lhs LHsType GhcPs
rhs [AddEpAnn]
annsIn
= do { (LocatedN RdrName
tc, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann, EpAnnComments
cs) <- Bool
-> LHsType GhcPs
-> P (LocatedN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
[AddEpAnn], EpAnnComments)
checkTyClHdr Bool
False LHsType GhcPs
lhs
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> LocatedN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type") SDoc
equalsDots LocatedN RdrName
tc [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; let anns' :: [AddEpAnn]
anns' = [AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
ann
; let loc' :: SrcSpanAnnA
loc' = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs
; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc' (SynDecl { tcdSExt :: XSynDecl GhcPs
tcdSExt = [AddEpAnn]
XSynDecl GhcPs
anns'
, tcdLName :: XRec GhcPs (IdP GhcPs)
tcdLName = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
tc, tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tyvars
, tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
fixity
, tcdRhs :: LHsType GhcPs
tcdRhs = LHsType GhcPs
rhs })) }
mkStandaloneKindSig
:: SrcSpan
-> Located [LocatedN RdrName]
-> LHsSigType GhcPs
-> [AddEpAnn]
-> P (LStandaloneKindSig GhcPs)
mkStandaloneKindSig :: SrcSpan
-> Located [LocatedN RdrName]
-> LHsSigType GhcPs
-> [AddEpAnn]
-> P (LStandaloneKindSig GhcPs)
mkStandaloneKindSig SrcSpan
loc Located [LocatedN RdrName]
lhs LHsSigType GhcPs
rhs [AddEpAnn]
anns =
do { [LocatedN RdrName]
vs <- (LocatedN RdrName -> P (LocatedN RdrName))
-> [LocatedN RdrName] -> P [LocatedN RdrName]
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 LocatedN RdrName -> P (LocatedN RdrName)
forall {m :: * -> *} {l}.
(MonadP m, HasLoc l) =>
GenLocated l RdrName -> m (GenLocated l RdrName)
check_lhs_name (Located [LocatedN RdrName] -> [LocatedN RdrName]
forall l e. GenLocated l e -> e
unLoc Located [LocatedN RdrName]
lhs)
; LocatedN RdrName
v <- [LocatedN RdrName] -> P (LocatedN RdrName)
check_singular_lhs ([LocatedN RdrName] -> [LocatedN RdrName]
forall a. [a] -> [a]
reverse [LocatedN RdrName]
vs)
; GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
-> P (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
-> P (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)))
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
-> P (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> StandaloneKindSig GhcPs
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc)
(StandaloneKindSig GhcPs
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
-> StandaloneKindSig GhcPs
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
forall a b. (a -> b) -> a -> b
$ XStandaloneKindSig GhcPs
-> XRec GhcPs (IdP GhcPs)
-> LHsSigType GhcPs
-> StandaloneKindSig GhcPs
forall pass.
XStandaloneKindSig pass
-> LIdP pass -> LHsSigType pass -> StandaloneKindSig pass
StandaloneKindSig [AddEpAnn]
XStandaloneKindSig GhcPs
anns XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v LHsSigType GhcPs
rhs }
where
check_lhs_name :: GenLocated l RdrName -> m (GenLocated l RdrName)
check_lhs_name v :: GenLocated l RdrName
v@(GenLocated l RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc->RdrName
name) =
if RdrName -> Bool
isUnqual RdrName
name Bool -> Bool -> Bool
&& OccName -> Bool
isTcOcc (RdrName -> OccName
rdrNameOcc RdrName
name)
then GenLocated l RdrName -> m (GenLocated l RdrName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated l RdrName
v
else MsgEnvelope PsMessage -> m (GenLocated l RdrName)
forall a. MsgEnvelope PsMessage -> m a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> m (GenLocated l RdrName))
-> MsgEnvelope PsMessage -> m (GenLocated l RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated l RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated l RdrName
v) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> PsMessage
PsErrUnexpectedQualifiedConstructor (GenLocated l RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated l RdrName
v))
check_singular_lhs :: [LocatedN RdrName] -> P (LocatedN RdrName)
check_singular_lhs [LocatedN RdrName]
vs =
case [LocatedN RdrName]
vs of
[] -> String -> P (LocatedN RdrName)
forall a. HasCallStack => String -> a
panic String
"mkStandaloneKindSig: empty left-hand side"
[LocatedN RdrName
v] -> LocatedN RdrName -> P (LocatedN RdrName)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedN RdrName
v
[LocatedN RdrName]
_ -> MsgEnvelope PsMessage -> P (LocatedN RdrName)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (LocatedN RdrName))
-> MsgEnvelope PsMessage -> P (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (Located [LocatedN RdrName] -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located [LocatedN RdrName]
lhs) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
([XRec GhcPs (IdP GhcPs)] -> PsMessage
PsErrMultipleNamesInStandaloneKindSignature [XRec GhcPs (IdP GhcPs)]
[LocatedN RdrName]
vs)
mkTyFamInstEqn :: SrcSpan
-> HsOuterFamEqnTyVarBndrs GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
-> [AddEpAnn]
-> P (LTyFamInstEqn GhcPs)
mkTyFamInstEqn :: SrcSpan
-> HsOuterFamEqnTyVarBndrs GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
-> [AddEpAnn]
-> P (LTyFamInstEqn GhcPs)
mkTyFamInstEqn SrcSpan
loc HsOuterFamEqnTyVarBndrs GhcPs
bndrs LHsType GhcPs
lhs LHsType GhcPs
rhs [AddEpAnn]
anns
= do { (LocatedN RdrName
tc, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann, EpAnnComments
cs) <- Bool
-> LHsType GhcPs
-> P (LocatedN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
[AddEpAnn], EpAnnComments)
checkTyClHdr Bool
False LHsType GhcPs
lhs
; let loc' :: SrcSpanAnnA
loc' = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs
; GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> P (GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc' (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
-> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall a b. (a -> b) -> a -> b
$ FamEqn
{ feqn_ext :: XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_ext = [AddEpAnn]
anns [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Monoid a => a -> a -> a
`mappend` [AddEpAnn]
ann
, feqn_tycon :: XRec GhcPs (IdP GhcPs)
feqn_tycon = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
tc
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
, feqn_pats :: [LHsTypeArg GhcPs]
feqn_pats = [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
, feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
fixity
, feqn_rhs :: GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_rhs = LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs })}
mkDataFamInst :: SrcSpan
-> NewOrData
-> Maybe (LocatedP CType)
-> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs
, LHsType GhcPs)
-> Maybe (LHsKind GhcPs)
-> [LConDecl GhcPs]
-> Located (HsDeriving GhcPs)
-> [AddEpAnn]
-> P (LInstDecl GhcPs)
mkDataFamInst :: SrcSpan
-> NewOrData
-> Maybe (LocatedP CType)
-> (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs,
LHsType GhcPs)
-> Maybe (LHsType GhcPs)
-> [LConDecl GhcPs]
-> Located (HsDeriving GhcPs)
-> [AddEpAnn]
-> P (LInstDecl GhcPs)
mkDataFamInst SrcSpan
loc NewOrData
new_or_data Maybe (LocatedP CType)
cType (Maybe (LHsContext GhcPs)
mcxt, HsOuterFamEqnTyVarBndrs GhcPs
bndrs, LHsType GhcPs
tycl_hdr)
Maybe (LHsType GhcPs)
ksig [LConDecl GhcPs]
data_cons (L SrcSpan
_ HsDeriving GhcPs
maybe_deriv) [AddEpAnn]
anns
= do { (LocatedN RdrName
tc, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann, EpAnnComments
cs) <- Bool
-> LHsType GhcPs
-> P (LocatedN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
[AddEpAnn], EpAnnComments)
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
data_cons <- SrcSpan
-> RdrName
-> Bool
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData SrcSpan
loc (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
tc) Bool
False NewOrData
new_or_data [LConDecl GhcPs]
data_cons
; HsDataDefn GhcPs
defn <- Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsType GhcPs)
-> DataDefnCons (LConDecl GhcPs)
-> HsDeriving GhcPs
-> P (HsDataDefn GhcPs)
mkDataDefn Maybe (LocatedP CType)
cType Maybe (LHsContext GhcPs)
mcxt Maybe (LHsType GhcPs)
ksig DataDefnCons (LConDecl GhcPs)
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
data_cons HsDeriving GhcPs
maybe_deriv
; let loc' :: SrcSpanAnnA
loc' = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs
; GenLocated SrcSpanAnnA (InstDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (InstDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> InstDecl GhcPs -> GenLocated SrcSpanAnnA (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc' (XDataFamInstD GhcPs -> DataFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XDataFamInstD pass -> DataFamInstDecl pass -> InstDecl pass
DataFamInstD XDataFamInstD GhcPs
NoExtField
noExtField (FamEqn GhcPs (HsDataDefn GhcPs) -> DataFamInstDecl GhcPs
forall pass. FamEqn pass (HsDataDefn pass) -> DataFamInstDecl pass
DataFamInstDecl
(FamEqn { feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext = [AddEpAnn]
ann [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
anns
, feqn_tycon :: XRec GhcPs (IdP GhcPs)
feqn_tycon = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
tc
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
, feqn_pats :: [LHsTypeArg GhcPs]
feqn_pats = [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
, feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
fixity
, feqn_rhs :: HsDataDefn GhcPs
feqn_rhs = HsDataDefn GhcPs
defn })))) }
mkTyFamInst :: SrcSpan
-> TyFamInstEqn GhcPs
-> [AddEpAnn]
-> P (LInstDecl GhcPs)
mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs -> [AddEpAnn] -> P (LInstDecl GhcPs)
mkTyFamInst SrcSpan
loc TyFamInstEqn GhcPs
eqn [AddEpAnn]
anns = do
GenLocated SrcSpanAnnA (InstDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (InstDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> InstDecl GhcPs -> GenLocated SrcSpanAnnA (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) (XTyFamInstD GhcPs -> TyFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XTyFamInstD pass -> TyFamInstDecl pass -> InstDecl pass
TyFamInstD XTyFamInstD GhcPs
NoExtField
noExtField
(XCTyFamInstDecl GhcPs -> TyFamInstEqn GhcPs -> TyFamInstDecl GhcPs
forall pass.
XCTyFamInstDecl pass -> TyFamInstEqn pass -> TyFamInstDecl pass
TyFamInstDecl [AddEpAnn]
XCTyFamInstDecl GhcPs
anns TyFamInstEqn GhcPs
eqn)))
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LHsType GhcPs
-> LFamilyResultSig GhcPs
-> Maybe (LInjectivityAnn GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LHsType GhcPs
-> LFamilyResultSig GhcPs
-> Maybe (LInjectivityAnn GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkFamDecl SrcSpan
loc FamilyInfo GhcPs
info TopLevelFlag
topLevel LHsType GhcPs
lhs LFamilyResultSig GhcPs
ksig Maybe (LInjectivityAnn GhcPs)
injAnn [AddEpAnn]
annsIn
= do { (LocatedN RdrName
tc, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann, EpAnnComments
cs) <- Bool
-> LHsType GhcPs
-> P (LocatedN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
[AddEpAnn], EpAnnComments)
checkTyClHdr Bool
False LHsType GhcPs
lhs
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> LocatedN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (FamilyInfo GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr FamilyInfo GhcPs
info) SDoc
equals_or_where LocatedN RdrName
tc [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; let loc' :: SrcSpanAnnA
loc' = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs
; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc' (XFamDecl GhcPs -> FamilyDecl GhcPs -> TyClDecl GhcPs
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl GhcPs
NoExtField
noExtField (FamilyDecl
{ fdExt :: XCFamilyDecl GhcPs
fdExt = [AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
ann
, fdTopLevel :: TopLevelFlag
fdTopLevel = TopLevelFlag
topLevel
, fdInfo :: FamilyInfo GhcPs
fdInfo = FamilyInfo GhcPs
info, fdLName :: XRec GhcPs (IdP GhcPs)
fdLName = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
tc
, fdTyVars :: LHsQTyVars GhcPs
fdTyVars = LHsQTyVars GhcPs
tyvars
, fdFixity :: LexicalFixity
fdFixity = LexicalFixity
fixity
, fdResultSig :: LFamilyResultSig GhcPs
fdResultSig = LFamilyResultSig GhcPs
ksig
, fdInjectivityAnn :: Maybe (LInjectivityAnn GhcPs)
fdInjectivityAnn = Maybe (LInjectivityAnn GhcPs)
injAnn }))) }
where
equals_or_where :: SDoc
equals_or_where = case FamilyInfo GhcPs
info of
FamilyInfo GhcPs
DataFamily -> SDoc
forall doc. IsOutput doc => doc
empty
FamilyInfo GhcPs
OpenTypeFamily -> SDoc
forall doc. IsOutput doc => doc
empty
ClosedTypeFamily {} -> SDoc
whereDots
mkSpliceDecl :: LHsExpr GhcPs -> (LHsDecl GhcPs)
mkSpliceDecl :: LHsExpr GhcPs -> LHsDecl GhcPs
mkSpliceDecl lexpr :: LHsExpr GhcPs
lexpr@(L SrcSpanAnnA
loc HsExpr GhcPs
expr)
| HsUntypedSplice XUntypedSplice GhcPs
_ splice :: HsUntypedSplice GhcPs
splice@(HsUntypedSpliceExpr {}) <- HsExpr GhcPs
expr
= SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
NoExtField
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsUntypedSplice GhcPs)
-> SpliceDecoration
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsUntypedSplice p) -> SpliceDecoration -> SpliceDecl p
SpliceDecl XSpliceDecl GhcPs
NoExtField
noExtField (SrcSpanAnnA
-> HsUntypedSplice GhcPs
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) HsUntypedSplice GhcPs
splice) SpliceDecoration
DollarSplice)
| HsUntypedSplice XUntypedSplice GhcPs
_ splice :: HsUntypedSplice GhcPs
splice@(HsQuasiQuote {}) <- HsExpr GhcPs
expr
= SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
NoExtField
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsUntypedSplice GhcPs)
-> SpliceDecoration
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsUntypedSplice p) -> SpliceDecoration -> SpliceDecl p
SpliceDecl XSpliceDecl GhcPs
NoExtField
noExtField (SrcSpanAnnA
-> HsUntypedSplice GhcPs
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) HsUntypedSplice GhcPs
splice) SpliceDecoration
DollarSplice)
| Bool
otherwise
= SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
NoExtField
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsUntypedSplice GhcPs)
-> SpliceDecoration
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsUntypedSplice p) -> SpliceDecoration -> SpliceDecl p
SpliceDecl XSpliceDecl GhcPs
NoExtField
noExtField
(SrcSpanAnnA
-> HsUntypedSplice GhcPs
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) (XUntypedSpliceExpr GhcPs -> LHsExpr GhcPs -> HsUntypedSplice GhcPs
forall id.
XUntypedSpliceExpr id -> LHsExpr id -> HsUntypedSplice id
HsUntypedSpliceExpr [AddEpAnn]
XUntypedSpliceExpr GhcPs
forall a. NoAnn a => a
noAnn (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lexpr)))
SpliceDecoration
BareSplice)
mkRoleAnnotDecl :: SrcSpan
-> LocatedN RdrName
-> [Located (Maybe FastString)]
-> [AddEpAnn]
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl :: SrcSpan
-> LocatedN RdrName
-> [Located (Maybe FastString)]
-> [AddEpAnn]
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl SrcSpan
loc LocatedN RdrName
tycon [Located (Maybe FastString)]
roles [AddEpAnn]
anns
= do { [GenLocated EpAnnCO (Maybe Role)]
roles' <- (Located (Maybe FastString) -> P (GenLocated EpAnnCO (Maybe Role)))
-> [Located (Maybe FastString)]
-> P [GenLocated EpAnnCO (Maybe Role)]
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 Located (Maybe FastString) -> P (GenLocated EpAnnCO (Maybe Role))
parse_role [Located (Maybe FastString)]
roles
; !EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)))
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> RoleAnnotDecl GhcPs
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs)
(RoleAnnotDecl GhcPs
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
-> RoleAnnotDecl GhcPs
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XCRoleAnnotDecl GhcPs
-> XRec GhcPs (IdP GhcPs)
-> [XRec GhcPs (Maybe Role)]
-> RoleAnnotDecl GhcPs
forall pass.
XCRoleAnnotDecl pass
-> LIdP pass -> [XRec pass (Maybe Role)] -> RoleAnnotDecl pass
RoleAnnotDecl [AddEpAnn]
XCRoleAnnotDecl GhcPs
anns XRec GhcPs (IdP GhcPs)
LocatedN RdrName
tycon [XRec GhcPs (Maybe Role)]
[GenLocated EpAnnCO (Maybe Role)]
roles' }
where
role_data_type :: DataType
role_data_type = Role -> DataType
forall a. Data a => a -> DataType
dataTypeOf (Role
forall a. HasCallStack => a
undefined :: Role)
all_roles :: [Role]
all_roles = (Constr -> Role) -> [Constr] -> [Role]
forall a b. (a -> b) -> [a] -> [b]
map Constr -> Role
forall a. Data a => Constr -> a
fromConstr ([Constr] -> [Role]) -> [Constr] -> [Role]
forall a b. (a -> b) -> a -> b
$ DataType -> [Constr]
dataTypeConstrs DataType
role_data_type
possible_roles :: [(FastString, Role)]
possible_roles = [(Role -> FastString
fsFromRole Role
role, Role
role) | Role
role <- [Role]
all_roles]
parse_role :: Located (Maybe FastString) -> P (GenLocated EpAnnCO (Maybe Role))
parse_role (L SrcSpan
loc_role Maybe FastString
Nothing) = GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role)))
-> GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a b. (a -> b) -> a -> b
$ EpAnnCO -> Maybe Role -> GenLocated EpAnnCO (Maybe Role)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnnCO
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc_role) Maybe Role
forall a. Maybe a
Nothing
parse_role (L SrcSpan
loc_role (Just FastString
role))
= case FastString -> [(FastString, Role)] -> Maybe Role
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FastString
role [(FastString, Role)]
possible_roles of
Just Role
found_role -> GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role)))
-> GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a b. (a -> b) -> a -> b
$ EpAnnCO -> Maybe Role -> GenLocated EpAnnCO (Maybe Role)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnnCO
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc_role) (Maybe Role -> GenLocated EpAnnCO (Maybe Role))
-> Maybe Role -> GenLocated EpAnnCO (Maybe Role)
forall a b. (a -> b) -> a -> b
$ Role -> Maybe Role
forall a. a -> Maybe a
Just Role
found_role
Maybe Role
Nothing ->
let nearby :: [Role]
nearby = String -> [(String, Role)] -> [Role]
forall a. String -> [(String, a)] -> [a]
fuzzyLookup (FastString -> String
unpackFS FastString
role)
((FastString -> String) -> [(FastString, Role)] -> [(String, Role)]
forall (f :: * -> *) a c b.
Functor f =>
(a -> c) -> f (a, b) -> f (c, b)
mapFst FastString -> String
unpackFS [(FastString, Role)]
possible_roles)
in
MsgEnvelope PsMessage -> P (GenLocated EpAnnCO (Maybe Role))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (GenLocated EpAnnCO (Maybe Role)))
-> MsgEnvelope PsMessage -> P (GenLocated EpAnnCO (Maybe Role))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc_role (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(FastString -> [Role] -> PsMessage
PsErrIllegalRoleName FastString
role [Role]
nearby)
fromSpecTyVarBndrs :: [LHsTyVarBndr Specificity GhcPs] -> P [LHsTyVarBndr () GhcPs]
fromSpecTyVarBndrs :: [LHsTyVarBndr Specificity GhcPs] -> P [LHsTyVarBndr () GhcPs]
fromSpecTyVarBndrs = (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> P [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
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 LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)
GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
fromSpecTyVarBndr
fromSpecTyVarBndr :: LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)
fromSpecTyVarBndr :: LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)
fromSpecTyVarBndr LHsTyVarBndr Specificity GhcPs
bndr = case LHsTyVarBndr Specificity GhcPs
bndr of
(L SrcSpanAnnA
loc (UserTyVar XUserTyVar GhcPs
xtv Specificity
flag XRec GhcPs (IdP GhcPs)
idp)) -> (Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
flag SrcSpanAnnA
loc)
P ()
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall a b. (a -> b) -> a -> b
$ XUserTyVar GhcPs
-> () -> XRec GhcPs (IdP GhcPs) -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar GhcPs
xtv () XRec GhcPs (IdP GhcPs)
idp)
(L SrcSpanAnnA
loc (KindedTyVar XKindedTyVar GhcPs
xtv Specificity
flag XRec GhcPs (IdP GhcPs)
idp LHsType GhcPs
k)) -> (Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
flag SrcSpanAnnA
loc)
P ()
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall a b. (a -> b) -> a -> b
$ XKindedTyVar GhcPs
-> ()
-> XRec GhcPs (IdP GhcPs)
-> LHsType GhcPs
-> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar GhcPs
xtv () XRec GhcPs (IdP GhcPs)
idp LHsType GhcPs
k)
where
check_spec :: Specificity -> SrcSpanAnnA -> P ()
check_spec :: Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
SpecifiedSpec SrcSpanAnnA
_ = () -> P ()
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
check_spec Specificity
InferredSpec SrcSpanAnnA
loc = MsgEnvelope PsMessage -> P ()
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrInferredTypeVarNotAllowed
annBinds :: AddEpAnn -> EpAnnComments -> HsLocalBinds GhcPs
-> (HsLocalBinds GhcPs, Maybe EpAnnComments)
annBinds :: AddEpAnn
-> EpAnnComments
-> HsLocalBinds GhcPs
-> (HsLocalBinds GhcPs, Maybe EpAnnComments)
annBinds AddEpAnn
a EpAnnComments
cs (HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
bs) = (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds (AddEpAnn -> SrcSpanAnnL -> EpAnnComments -> SrcSpanAnnL
add_where AddEpAnn
a XHsValBinds GhcPs GhcPs
SrcSpanAnnL
an EpAnnComments
cs) HsValBindsLR GhcPs GhcPs
bs, Maybe EpAnnComments
forall a. Maybe a
Nothing)
annBinds AddEpAnn
a EpAnnComments
cs (HsIPBinds XHsIPBinds GhcPs GhcPs
an HsIPBinds GhcPs
bs) = (XHsIPBinds GhcPs GhcPs -> HsIPBinds GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds (AddEpAnn -> SrcSpanAnnL -> EpAnnComments -> SrcSpanAnnL
add_where AddEpAnn
a XHsIPBinds GhcPs GhcPs
SrcSpanAnnL
an EpAnnComments
cs) HsIPBinds GhcPs
bs, Maybe EpAnnComments
forall a. Maybe a
Nothing)
annBinds AddEpAnn
_ EpAnnComments
cs (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
x) = (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
x, EpAnnComments -> Maybe EpAnnComments
forall a. a -> Maybe a
Just EpAnnComments
cs)
add_where :: AddEpAnn -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
add_where :: AddEpAnn -> SrcSpanAnnL -> EpAnnComments -> SrcSpanAnnL
add_where an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
_ (EpaSpan (RealSrcSpan RealSrcSpan
rs Maybe BufSpan
_))) (EpAnn EpaLocation
a (AnnList Maybe EpaLocation
anc Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs) EpAnnComments
cs2
| EpaLocation -> Bool
valid_anchor EpaLocation
a
= EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (EpaLocation -> [AddEpAnn] -> EpaLocation
widenAnchor EpaLocation
a [AddEpAnn
an]) (Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe EpaLocation
anc Maybe AddEpAnn
o Maybe AddEpAnn
c (AddEpAnn
anAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
r) [TrailingAnn]
t) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
| Bool
otherwise
= EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> EpaLocation -> EpaLocation
patch_anchor RealSrcSpan
rs EpaLocation
a)
(Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList ((EpaLocation -> EpaLocation)
-> Maybe EpaLocation -> Maybe EpaLocation
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcSpan -> EpaLocation -> EpaLocation
patch_anchor RealSrcSpan
rs) Maybe EpaLocation
anc) Maybe AddEpAnn
o Maybe AddEpAnn
c (AddEpAnn
anAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
r) [TrailingAnn]
t) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
add_where (AddEpAnn AnnKeywordId
_ EpaLocation
_) SrcSpanAnnL
_ EpAnnComments
_ = String -> SrcSpanAnnL
forall a. HasCallStack => String -> a
panic String
"add_where"
valid_anchor :: Anchor -> Bool
valid_anchor :: EpaLocation -> Bool
valid_anchor (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_)) = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
valid_anchor EpaLocation
_ = Bool
False
patch_anchor :: RealSrcSpan -> Anchor -> Anchor
patch_anchor :: RealSrcSpan -> EpaLocation -> EpaLocation
patch_anchor RealSrcSpan
r (EpaDelta DeltaPos
_ [LEpaComment]
_) = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
patch_anchor RealSrcSpan
r1 (EpaSpan (RealSrcSpan RealSrcSpan
r0 Maybe BufSpan
mb)) = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
mb)
where
r :: RealSrcSpan
r = if RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then RealSrcSpan
r1 else RealSrcSpan
r0
patch_anchor RealSrcSpan
_ (EpaSpan SrcSpan
ss) = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan SrcSpan
ss
fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn :: SrcSpanAnnL -> SrcSpanAnnL
fixValbindsAnn (EpAnn EpaLocation
anchor (AnnList Maybe EpaLocation
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
= (EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (EpaLocation -> [AddEpAnn] -> EpaLocation
widenAnchor EpaLocation
anchor ([AddEpAnn]
r [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ (TrailingAnn -> AddEpAnn) -> [TrailingAnn] -> [AddEpAnn]
forall a b. (a -> b) -> [a] -> [b]
map TrailingAnn -> AddEpAnn
trailingAnnToAddEpAnn [TrailingAnn]
t)) (Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe EpaLocation
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
stmtsAnchor :: Located (OrdList AddEpAnn,a) -> Maybe Anchor
stmtsAnchor :: forall a. Located (OrdList AddEpAnn, a) -> Maybe EpaLocation
stmtsAnchor (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb) ((ConsOL (AddEpAnn AnnKeywordId
_ (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
rb))) OrdList AddEpAnn
_), a
_))
= EpaLocation -> Maybe EpaLocation
forall a. a -> Maybe a
Just (EpaLocation -> Maybe EpaLocation)
-> EpaLocation -> Maybe EpaLocation
forall a b. (a -> b) -> a -> b
$ EpaLocation -> SrcSpan -> EpaLocation
widenAnchorS (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb)) (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
rb)
stmtsAnchor (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb) (OrdList AddEpAnn, a)
_) = EpaLocation -> Maybe EpaLocation
forall a. a -> Maybe a
Just (EpaLocation -> Maybe EpaLocation)
-> EpaLocation -> Maybe EpaLocation
forall a b. (a -> b) -> a -> b
$ SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb)
stmtsAnchor GenLocated SrcSpan (OrdList AddEpAnn, a)
_ = Maybe EpaLocation
forall a. Maybe a
Nothing
stmtsLoc :: Located (OrdList AddEpAnn,a) -> SrcSpan
stmtsLoc :: forall a. Located (OrdList AddEpAnn, a) -> SrcSpan
stmtsLoc (L SrcSpan
l ((ConsOL AddEpAnn
aa OrdList AddEpAnn
_), a
_))
= SrcSpan -> [AddEpAnn] -> SrcSpan
widenSpan SrcSpan
l [AddEpAnn
aa]
stmtsLoc (L SrcSpan
l (OrdList AddEpAnn, a)
_) = SrcSpan
l
cvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
cvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
cvTopDecls OrdList (LHsDecl GhcPs)
decls = [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll (OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. OrdList a -> [a]
fromOL OrdList (LHsDecl GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
decls)
cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)
cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBindsLR GhcPs GhcPs)
cvBindGroup OrdList (LHsDecl GhcPs)
binding
= do { (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
mbs, [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs, [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fam_ds, [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
tfam_insts
, [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
dfam_insts, [GenLocated SrcSpanAnnA (DocDecl GhcPs)]
_) <- OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
binding
; Bool -> P ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert ([GenLocated SrcSpanAnnA (FamilyDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fam_ds Bool -> Bool -> Bool
&& [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
tfam_insts Bool -> Bool -> Bool
&& [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
dfam_insts)
; HsValBindsLR GhcPs GhcPs -> P (HsValBindsLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsValBindsLR GhcPs GhcPs -> P (HsValBindsLR GhcPs GhcPs))
-> HsValBindsLR GhcPs GhcPs -> P (HsValBindsLR GhcPs GhcPs)
forall a b. (a -> b) -> a -> b
$ XValBinds GhcPs GhcPs
-> LHsBinds GhcPs -> [LSig GhcPs] -> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
AnnSortKey BindTag
forall tag. AnnSortKey tag
NoAnnSortKey LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
mbs [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs }
cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]
, [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
fb = do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
fb' <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> P [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *} {a}.
(MonadP m, HasLoc a) =>
[GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls (OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. OrdList a -> [a]
fromOL OrdList (LHsDecl GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
fb)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
[GenLocated SrcSpanAnnA (Sig GhcPs)],
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (DocDecl GhcPs)])
-> P (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
[GenLocated SrcSpanAnnA (Sig GhcPs)],
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (DocDecl GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs]
-> (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
partitionBindsAndSigs ([LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
fb'))
where
drop_bad_decls :: [GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls [] = [GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
drop_bad_decls (L a
l (SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
d) : [GenLocated a (HsDecl GhcPs)]
ds) = do
MsgEnvelope PsMessage -> m ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> m ()) -> MsgEnvelope PsMessage -> m ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SpliceDecl GhcPs -> PsMessage
PsErrDeclSpliceNotAtTopLevel SpliceDecl GhcPs
d
[GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls [GenLocated a (HsDecl GhcPs)]
ds
drop_bad_decls (GenLocated a (HsDecl GhcPs)
d:[GenLocated a (HsDecl GhcPs)]
ds) = (GenLocated a (HsDecl GhcPs)
d:) ([GenLocated a (HsDecl GhcPs)] -> [GenLocated a (HsDecl GhcPs)])
-> m [GenLocated a (HsDecl GhcPs)]
-> m [GenLocated a (HsDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls [GenLocated a (HsDecl GhcPs)]
ds
getMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
getMonoBind :: LHsBind GhcPs
-> [LHsDecl GhcPs] -> (LHsBind GhcPs, [LHsDecl GhcPs])
getMonoBind (L SrcSpanAnnA
loc1 (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = fun_id1 :: XRec GhcPs (IdP GhcPs)
fun_id1@(L SrcSpanAnnN
_ RdrName
f1)
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches =
MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ m1 :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
m1@[L SrcSpanAnnA
_ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs1]) } }))
[LHsDecl GhcPs]
binds
| [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
has_args [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
m1
= [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc1 Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs1] (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc1) [LHsDecl GhcPs]
binds []
where
go :: [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go :: [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs SrcSpanAnnA
loc
((L SrcSpanAnnA
loc2 (ValD XValD GhcPs
_ (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = (L SrcSpanAnnN
_ RdrName
f2)
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches =
MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [L SrcSpanAnnA
lm2 Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs2]) } })))
: [LHsDecl GhcPs]
binds) [LHsDecl GhcPs]
_
| RdrName
f1 RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
f2 =
let (SrcSpanAnnA
loc2', SrcSpanAnnA
lm2') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferAnnsA SrcSpanAnnA
loc2 SrcSpanAnnA
lm2
in [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lm2' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs2 GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mtchs)
(SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => EpAnn a -> EpAnn a -> EpAnn a
combineSrcSpansA SrcSpanAnnA
loc SrcSpanAnnA
loc2') [LHsDecl GhcPs]
binds []
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs SrcSpanAnnA
loc (doc_decl :: LHsDecl GhcPs
doc_decl@(L SrcSpanAnnA
loc2 (DocD {})) : [LHsDecl GhcPs]
binds) [LHsDecl GhcPs]
doc_decls
= let doc_decls' :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls' = LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
doc_decl GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls
in [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs (SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => EpAnn a -> EpAnn a -> EpAnn a
combineSrcSpansA SrcSpanAnnA
loc SrcSpanAnnA
loc2) [LHsDecl GhcPs]
binds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls'
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs SrcSpanAnnA
loc [LHsDecl GhcPs]
binds [LHsDecl GhcPs]
doc_decls
= let
L SrcSpanAnnA
llm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
last_m = [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => [a] -> a
head [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mtchs
(SrcSpanAnnA
llm',SrcSpanAnnA
loc') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferAnnsOnlyA SrcSpanAnnA
llm SrcSpanAnnA
loc
matches' :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches' = [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
llm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
last_mGenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. HasCallStack => [a] -> [a]
tail [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mtchs)
L SrcSpanAnnA
lfm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
first_m = [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => [a] -> a
head [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches'
(SrcSpanAnnA
lfm', SrcSpanAnnA
loc'') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
lfm SrcSpanAnnA
loc'
in
( SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc'' (LocatedN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind XRec GhcPs (IdP GhcPs)
LocatedN RdrName
fun_id1 ([GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a an e2.
(Semigroup a, NoAnn an) =>
[GenLocated (EpAnn a) e2] -> LocatedAn an [GenLocated (EpAnn a) e2]
mkLocatedList ([GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lfm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
first_mGenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. HasCallStack => [a] -> [a]
tail [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches')))
, ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a]
reverse [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
binds)
getMonoBind LHsBind GhcPs
bind [LHsDecl GhcPs]
binds = (LHsBind GhcPs
bind, [LHsDecl GhcPs]
binds)
getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [] = []
getMonoBindAll (L SrcSpanAnnA
l (ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
b) : [LHsDecl GhcPs]
ds) =
let (L SrcSpanAnnA
l' HsBindLR GhcPs GhcPs
b', [LHsDecl GhcPs]
ds') = LHsBind GhcPs
-> [LHsDecl GhcPs] -> (LHsBind GhcPs, [LHsDecl GhcPs])
getMonoBind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
b) [LHsDecl GhcPs]
ds
in SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
NoExtField
noExtField HsBindLR GhcPs GhcPs
b') GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [LHsDecl GhcPs]
ds'
getMonoBindAll (LHsDecl GhcPs
d : [LHsDecl GhcPs]
ds) = LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
d GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [LHsDecl GhcPs]
ds
has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
has_args [] = String -> Bool
forall a. HasCallStack => String -> a
panic String
"GHC.Parser.PostProcess.has_args"
has_args (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcPs]
args }) : [LMatch GhcPs (LHsExpr GhcPs)]
_) = Bool -> Bool
not ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
args)
tyConToDataCon :: LocatedN RdrName -> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
tyConToDataCon :: LocatedN RdrName
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
tyConToDataCon (L SrcSpanAnnN
loc RdrName
tc)
| String -> Bool
okConOcc (OccName -> String
occNameString OccName
occ)
= LocatedN RdrName
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
forall a. a -> Either (MsgEnvelope PsMessage) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc (RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
tc NameSpace
srcDataName))
| Bool
otherwise
= MsgEnvelope PsMessage
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
forall a b. a -> Either a b
Left (MsgEnvelope PsMessage
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName))
-> MsgEnvelope PsMessage
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ (RdrName -> PsMessage
PsErrNotADataCon RdrName
tc)
where
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
tc
mkPatSynMatchGroup :: LocatedN RdrName
-> LocatedL (OrdList (LHsDecl GhcPs))
-> P (MatchGroup GhcPs (LHsExpr GhcPs))
mkPatSynMatchGroup :: LocatedN RdrName
-> LocatedL (OrdList (LHsDecl GhcPs))
-> P (MatchGroup GhcPs (LHsExpr GhcPs))
mkPatSynMatchGroup (L SrcSpanAnnN
loc RdrName
patsyn_name) (L SrcSpanAnnL
ld OrdList (LHsDecl GhcPs)
decls) =
do { [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches <- (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> P [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
fromDecl (OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. OrdList a -> [a]
fromOL OrdList (LHsDecl GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
decls)
; Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches) (SrcSpan -> P ()
wrongNumberErr (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc))
; MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ Origin
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
FromSource (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
ld [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches) }
where
fromDecl :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
fromDecl (L SrcSpanAnnA
loc decl :: HsDecl GhcPs
decl@(ValD XValD GhcPs
_ (PatBind XPatBind GhcPs GhcPs
_
pat :: LPat GhcPs
pat@(L SrcSpanAnnA
_ (ConPat XConPat GhcPs
noAnn ln :: XRec GhcPs (ConLikeP GhcPs)
ln@(L SrcSpanAnnN
_ RdrName
name) HsConPatDetails GhcPs
details))
HsMultAnn GhcPs
_ GRHSs GhcPs (LHsExpr GhcPs)
rhs))) =
do { Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RdrName
name RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
patsyn_name) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
SrcSpan -> HsDecl GhcPs -> P ()
wrongNameBindingErr (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) HsDecl GhcPs
decl
; Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
match <- case HsConPatDetails GhcPs
details of
PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
_ [LPat GhcPs]
pats -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = XConPat GhcPs
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
noAnn
, m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt = HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (LocatedN RdrName)
ctxt, m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs]
pats
, m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
rhs }
where
ctxt :: HsMatchContext (LocatedN RdrName)
ctxt = FunRhs { mc_fun :: LocatedN RdrName
mc_fun = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
ln
, mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Prefix
, mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
NoSrcStrict }
InfixCon LPat GhcPs
p1 LPat GhcPs
p2 -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = XConPat GhcPs
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
noAnn
, m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt = HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (LocatedN RdrName)
ctxt
, m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs
p1, LPat GhcPs
p2]
, m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
rhs }
where
ctxt :: HsMatchContext (LocatedN RdrName)
ctxt = FunRhs { mc_fun :: LocatedN RdrName
mc_fun = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
ln
, mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Infix
, mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
NoSrcStrict }
RecCon{} -> SrcSpan
-> LPat GhcPs
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. SrcSpan -> LPat GhcPs -> P a
recordPatSynErr (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) LPat GhcPs
pat
; GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
match }
fromDecl (L SrcSpanAnnA
loc HsDecl GhcPs
decl) = SrcSpan
-> HsDecl GhcPs
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
extraDeclErr (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) HsDecl GhcPs
decl
extraDeclErr :: SrcSpan
-> HsDecl GhcPs
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
extraDeclErr SrcSpan
loc HsDecl GhcPs
decl =
MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> HsDecl GhcPs -> PsMessage
PsErrNoSingleWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl)
wrongNameBindingErr :: SrcSpan -> HsDecl GhcPs -> P ()
wrongNameBindingErr SrcSpan
loc HsDecl GhcPs
decl =
MsgEnvelope PsMessage -> P ()
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> HsDecl GhcPs -> PsMessage
PsErrInvalidWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl)
wrongNumberErr :: SrcSpan -> P ()
wrongNumberErr SrcSpan
loc =
MsgEnvelope PsMessage -> P ()
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> PsMessage
PsErrEmptyWhereInPatSynDecl RdrName
patsyn_name)
recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a
recordPatSynErr :: forall a. SrcSpan -> LPat GhcPs -> P a
recordPatSynErr SrcSpan
loc LPat GhcPs
pat =
MsgEnvelope PsMessage -> P a
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P a) -> MsgEnvelope PsMessage -> P a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LPat GhcPs -> PsMessage
PsErrRecordSyntaxInPatSynDecl LPat GhcPs
pat)
mkConDeclH98 :: [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 :: [AddEpAnn]
-> LocatedN RdrName
-> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs)
-> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 [AddEpAnn]
ann LocatedN RdrName
name Maybe [LHsTyVarBndr Specificity GhcPs]
mb_forall Maybe (LHsContext GhcPs)
mb_cxt HsConDeclH98Details GhcPs
args
= ConDeclH98 { con_ext :: XConDeclH98 GhcPs
con_ext = [AddEpAnn]
XConDeclH98 GhcPs
ann
, con_name :: XRec GhcPs (IdP GhcPs)
con_name = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
name
, con_forall :: Bool
con_forall = Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> Bool
forall a. Maybe a -> Bool
isJust Maybe [LHsTyVarBndr Specificity GhcPs]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
mb_forall
, con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs = Maybe [LHsTyVarBndr Specificity GhcPs]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
mb_forall Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
forall a. Maybe a -> a -> a
`orElse` []
, con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt = Maybe (LHsContext GhcPs)
mb_cxt
, con_args :: HsConDeclH98Details GhcPs
con_args = HsConDeclH98Details GhcPs
args
, con_doc :: Maybe (LHsDoc GhcPs)
con_doc = Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing }
mkGadtDecl :: SrcSpan
-> NonEmpty (LocatedN RdrName)
-> EpUniToken "::" "∷"
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl :: SrcSpan
-> NonEmpty (LocatedN RdrName)
-> EpUniToken "::" "\8759"
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl SrcSpan
loc NonEmpty (LocatedN RdrName)
names EpUniToken "::" "\8759"
dcol LHsSigType GhcPs
ty = do
(HsConDeclGADTDetails GhcPs
args, GenLocated SrcSpanAnnA (HsType GhcPs)
res_ty, [AddEpAnn]
annsa, EpAnnComments
csa) <-
case LHsType GhcPs
body_ty of
L SrcSpanAnnA
ll (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
hsArr (L (EpAnn EpaLocation
anc AnnListItem
_ EpAnnComments
cs) (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
rf)) LHsType GhcPs
res_ty) -> do
EpUniToken "->" "\8594"
arr <- case HsArrow GhcPs
hsArr of
HsUnrestrictedArrow XUnrestrictedArrow GhcPs
arr -> EpUniToken "->" "\8594" -> P (EpUniToken "->" "\8594")
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return EpUniToken "->" "\8594"
XUnrestrictedArrow GhcPs
arr
HsArrow GhcPs
_ -> do MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
body_ty) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsArrow GhcPs -> PsMessage
PsErrIllegalGadtRecordMultiplicity HsArrow GhcPs
hsArr)
EpUniToken "->" "\8594" -> P (EpUniToken "->" "\8594")
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return EpUniToken "->" "\8594"
forall a. NoAnn a => a
noAnn
(HsConDeclGADTDetails GhcPs, GenLocated SrcSpanAnnA (HsType GhcPs),
[AddEpAnn], EpAnnComments)
-> P (HsConDeclGADTDetails GhcPs,
GenLocated SrcSpanAnnA (HsType GhcPs), [AddEpAnn], EpAnnComments)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ( XRecConGADT GhcPs
-> XRec GhcPs [LConDeclField GhcPs] -> HsConDeclGADTDetails GhcPs
forall pass.
XRecConGADT pass
-> XRec pass [LConDeclField pass] -> HsConDeclGADTDetails pass
RecConGADT EpUniToken "->" "\8594"
XRecConGADT GhcPs
arr (SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc XRecTy GhcPs
AnnList
an EpAnnComments
cs) [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
rf), LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
res_ty
, [], SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments SrcSpanAnnA
ll)
LHsType GhcPs
_ -> do
let ([AddEpAnn]
anns, EpAnnComments
cs, [HsScaled GhcPs (LHsType GhcPs)]
arg_types, LHsType GhcPs
res_type) = LHsType GhcPs
-> ([AddEpAnn], EpAnnComments, [HsScaled GhcPs (LHsType GhcPs)],
LHsType GhcPs)
forall (p :: Pass).
LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
[HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType LHsType GhcPs
body_ty
(HsConDeclGADTDetails GhcPs, GenLocated SrcSpanAnnA (HsType GhcPs),
[AddEpAnn], EpAnnComments)
-> P (HsConDeclGADTDetails GhcPs,
GenLocated SrcSpanAnnA (HsType GhcPs), [AddEpAnn], EpAnnComments)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPrefixConGADT GhcPs
-> [HsScaled GhcPs (LHsType GhcPs)] -> HsConDeclGADTDetails GhcPs
forall pass.
XPrefixConGADT pass
-> [HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
PrefixConGADT NoExtField
XPrefixConGADT GhcPs
noExtField [HsScaled GhcPs (LHsType GhcPs)]
arg_types, LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
res_type, [AddEpAnn]
anns, EpAnnComments
cs)
let bndrs_loc :: SrcSpanAnnA
bndrs_loc = case HsOuterSigTyVarBndrs GhcPs
outer_bndrs of
HsOuterImplicit{} -> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
HsOuterExplicit XHsOuterExplicit GhcPs Specificity
an [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
_ -> EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (EpAnn (AddEpAnn, AddEpAnn) -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry XHsOuterExplicit GhcPs Specificity
EpAnn (AddEpAnn, AddEpAnn)
an) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
emptyComments
let l :: SrcSpanAnnA
l = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
csa
GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> ConDecl GhcPs -> GenLocated SrcSpanAnnA (ConDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ConDeclGADT
{ con_g_ext :: XConDeclGADT GhcPs
con_g_ext = (EpUniToken "::" "\8759"
dcol, [AddEpAnn]
annsa)
, con_names :: NonEmpty (XRec GhcPs (IdP GhcPs))
con_names = NonEmpty (XRec GhcPs (IdP GhcPs))
NonEmpty (LocatedN RdrName)
names
, con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs = SrcSpanAnnA
-> HsOuterSigTyVarBndrs GhcPs
-> GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
bndrs_loc HsOuterSigTyVarBndrs GhcPs
outer_bndrs
, con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt = Maybe (LHsContext GhcPs)
mcxt
, con_g_args :: HsConDeclGADTDetails GhcPs
con_g_args = HsConDeclGADTDetails GhcPs
args
, con_res_ty :: LHsType GhcPs
con_res_ty = LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
res_ty
, con_doc :: Maybe (LHsDoc GhcPs)
con_doc = Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing }
where
(HsOuterSigTyVarBndrs GhcPs
outer_bndrs, Maybe (LHsContext GhcPs)
mcxt, LHsType GhcPs
body_ty) = LHsSigType GhcPs
-> (HsOuterSigTyVarBndrs GhcPs, Maybe (LHsContext GhcPs),
LHsType GhcPs)
splitLHsGadtTy LHsSigType GhcPs
ty
setRdrNameSpace :: RdrName -> NameSpace -> RdrName
setRdrNameSpace :: RdrName -> NameSpace -> RdrName
setRdrNameSpace (Unqual OccName
occ) NameSpace
ns = OccName -> RdrName
Unqual (NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
ns OccName
occ)
setRdrNameSpace (Qual ModuleName
m OccName
occ) NameSpace
ns = ModuleName -> OccName -> RdrName
Qual ModuleName
m (NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
ns OccName
occ)
setRdrNameSpace (Orig Module
m OccName
occ) NameSpace
ns = Module -> OccName -> RdrName
Orig Module
m (NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
ns OccName
occ)
setRdrNameSpace (Exact Name
n) NameSpace
ns
| Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
n
= TyThing -> NameSpace -> RdrName
setWiredInNameSpace TyThing
thing NameSpace
ns
| Name -> Bool
isExternalName Name
n
= Module -> OccName -> RdrName
Orig ((() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
n) OccName
occ
| Bool
otherwise
= Name -> RdrName
Exact (Unique -> OccName -> SrcSpan -> Name
mkSystemNameAt (Name -> Unique
nameUnique Name
n) OccName
occ (Name -> SrcSpan
nameSrcSpan Name
n))
where
occ :: OccName
occ = NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
ns (Name -> OccName
nameOccName Name
n)
setWiredInNameSpace :: TyThing -> NameSpace -> RdrName
setWiredInNameSpace :: TyThing -> NameSpace -> RdrName
setWiredInNameSpace (ATyCon TyCon
tc) NameSpace
ns
| NameSpace -> Bool
isDataConNameSpace NameSpace
ns
= TyCon -> RdrName
ty_con_data_con TyCon
tc
| NameSpace -> Bool
isTcClsNameSpace NameSpace
ns
= Name -> RdrName
Exact (TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc)
setWiredInNameSpace (AConLike (RealDataCon DataCon
dc)) NameSpace
ns
| NameSpace -> Bool
isTcClsNameSpace NameSpace
ns
= DataCon -> RdrName
data_con_ty_con DataCon
dc
| NameSpace -> Bool
isDataConNameSpace NameSpace
ns
= Name -> RdrName
Exact (DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
dc)
setWiredInNameSpace TyThing
thing NameSpace
ns
= String -> SDoc -> RdrName
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"setWiredinNameSpace" (NameSpace -> SDoc
pprNameSpace NameSpace
ns SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing)
ty_con_data_con :: TyCon -> RdrName
ty_con_data_con :: TyCon -> RdrName
ty_con_data_con TyCon
tc
| TyCon -> Bool
isTupleTyCon TyCon
tc
, Just DataCon
dc <- TyCon -> Maybe DataCon
tyConSingleDataCon_maybe TyCon
tc
= Name -> RdrName
Exact (DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
dc)
| TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
listTyConKey
= Name -> RdrName
Exact Name
nilDataConName
| Bool
otherwise
= OccName -> RdrName
Unqual (NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
srcDataName (TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
tc))
data_con_ty_con :: DataCon -> RdrName
data_con_ty_con :: DataCon -> RdrName
data_con_ty_con DataCon
dc
| let tc :: TyCon
tc = DataCon -> TyCon
dataConTyCon DataCon
dc
, TyCon -> Bool
isTupleTyCon TyCon
tc
= Name -> RdrName
Exact (TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc)
| DataCon
dc DataCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
nilDataConKey
= Name -> RdrName
Exact Name
listTyConName
| Bool
otherwise
= OccName -> RdrName
Unqual (NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
tcClsName (DataCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName DataCon
dc))
eitherToP :: MonadP m => Either (MsgEnvelope PsMessage) a -> m a
eitherToP :: forall (m :: * -> *) a.
MonadP m =>
Either (MsgEnvelope PsMessage) a -> m a
eitherToP (Left MsgEnvelope PsMessage
err) = MsgEnvelope PsMessage -> m a
forall a. MsgEnvelope PsMessage -> m a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError MsgEnvelope PsMessage
err
eitherToP (Right a
thing) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
thing
checkTyVars :: SDoc -> SDoc -> LocatedN RdrName -> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars :: SDoc
-> SDoc
-> LocatedN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars SDoc
pp_what SDoc
equals_or_where LocatedN RdrName
tc [LHsTypeArg GhcPs]
tparms
= do { [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
tvs <- (HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated
SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> P [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
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 HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
check [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparms
; LHsQTyVars GhcPs -> P (LHsQTyVars GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsTyVarBndr (HsBndrVis GhcPs) GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
tvs) }
where
check :: HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
check (HsTypeArg XTypeArg GhcPs
at GenLocated SrcSpanAnnA (HsType GhcPs)
ki) = [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens [] [] (XBndrInvisible GhcPs -> HsBndrVis GhcPs
forall pass. XBndrInvisible pass -> HsBndrVis pass
HsBndrInvisible XTypeArg GhcPs
XBndrInvisible GhcPs
at) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki
check (HsValArg XValArg GhcPs
_ GenLocated SrcSpanAnnA (HsType GhcPs)
ty) = [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens [] [] (XBndrRequired GhcPs -> HsBndrVis GhcPs
forall pass. XBndrRequired pass -> HsBndrVis pass
HsBndrRequired NoExtField
XBndrRequired GhcPs
noExtField) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
check (HsArgPar XArgPar GhcPs
sp) = MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)))
-> MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
XArgPar GhcPs
sp (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(SDoc -> RdrName -> PsMessage
PsErrMalformedDecl SDoc
pp_what (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
tc))
chkParens :: [AddEpAnn] -> [AddEpAnn] -> HsBndrVis GhcPs -> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens :: [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis (L SrcSpanAnnA
l (HsParTy XParTy GhcPs
_ (L SrcSpanAnnA
lt HsType GhcPs
ty)))
= let
(AddEpAnn
o,AddEpAnn
c) = RealSrcSpan -> (AddEpAnn, AddEpAnn)
mkParensEpAnn (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
(SrcSpanAnnA
_,SrcSpanAnnA
lt') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
l SrcSpanAnnA
lt
in
[AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps) HsBndrVis GhcPs
bvis (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lt' HsType GhcPs
ty)
chkParens [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis LHsType GhcPs
ty = [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chk [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis LHsType GhcPs
ty
chk :: [AddEpAnn] -> [AddEpAnn] -> HsBndrVis GhcPs -> LHsType GhcPs -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chk :: [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chk [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis (L SrcSpanAnnA
l (HsKindSig XKindSig GhcPs
annk (L SrcSpanAnnA
annt (HsTyVar XTyVar GhcPs
ann PromotionFlag
_ (L SrcSpanAnnN
lv RdrName
tv))) LHsType GhcPs
k))
| RdrName -> Bool
isRdrTyVar RdrName
tv
= let
an :: [AddEpAnn]
an = ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps
in
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> [AddEpAnn] -> SrcSpanAnnA
forall an. EpAnn an -> [AddEpAnn] -> EpAnn an
widenLocatedAn (SrcSpanAnnA
l SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA
annt) (HsBndrVis GhcPs -> AddEpAnn
for_widening HsBndrVis GhcPs
bvisAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
an))
(XKindedTyVar GhcPs
-> HsBndrVis GhcPs
-> XRec GhcPs (IdP GhcPs)
-> LHsType GhcPs
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar ([AddEpAnn]
an [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
XKindSig GhcPs
annk [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
XTyVar GhcPs
ann) HsBndrVis GhcPs
bvis (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lv RdrName
tv) LHsType GhcPs
k))
chk [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis (L SrcSpanAnnA
l (HsTyVar XTyVar GhcPs
ann PromotionFlag
_ (L SrcSpanAnnN
ltv RdrName
tv)))
| RdrName -> Bool
isRdrTyVar RdrName
tv
= let
an :: [AddEpAnn]
an = ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps
in
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> [AddEpAnn] -> SrcSpanAnnA
forall an. EpAnn an -> [AddEpAnn] -> EpAnn an
widenLocatedAn SrcSpanAnnA
l (HsBndrVis GhcPs -> AddEpAnn
for_widening HsBndrVis GhcPs
bvisAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
an))
(XUserTyVar GhcPs
-> HsBndrVis GhcPs
-> XRec GhcPs (IdP GhcPs)
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar ([AddEpAnn]
an [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
XTyVar GhcPs
ann) HsBndrVis GhcPs
bvis (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
ltv RdrName
tv)))
chk [AddEpAnn]
_ [AddEpAnn]
_ HsBndrVis GhcPs
_ t :: LHsType GhcPs
t@(L SrcSpanAnnA
loc HsType GhcPs
_)
= MsgEnvelope PsMessage -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> MsgEnvelope PsMessage
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LHsType GhcPs
-> SDoc -> RdrName -> [LHsTypeArg GhcPs] -> SDoc -> PsMessage
PsErrUnexpectedTypeInDecl LHsType GhcPs
t SDoc
pp_what (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
tc) [LHsTypeArg GhcPs]
tparms SDoc
equals_or_where)
for_widening :: HsBndrVis GhcPs -> AddEpAnn
for_widening :: HsBndrVis GhcPs -> AddEpAnn
for_widening (HsBndrInvisible (EpTok EpaLocation
loc)) = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnAnyclass EpaLocation
loc
for_widening HsBndrVis GhcPs
_ = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnAnyclass (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])
whereDots, equalsDots :: SDoc
whereDots :: SDoc
whereDots = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where ..."
equalsDots :: SDoc
equalsDots = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"= ..."
checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Maybe (LHsContext GhcPs)
Nothing = () -> P ()
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkDatatypeContext (Just LHsContext GhcPs
c)
= do Bool
allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
DatatypeContextsBit
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowed (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
c) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LHsContext GhcPs -> PsMessage
PsErrIllegalDataTypeContext LHsContext GhcPs
c)
type LRuleTyTmVar = LocatedAn NoEpAnns RuleTyTmVar
data RuleTyTmVar = RuleTyTmVar [AddEpAnn] (LocatedN RdrName) (Maybe (LHsType GhcPs))
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs = (LRuleTyTmVar -> GenLocated EpAnnCO (RuleBndr GhcPs))
-> [LRuleTyTmVar] -> [GenLocated EpAnnCO (RuleBndr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RuleTyTmVar -> RuleBndr GhcPs)
-> LRuleTyTmVar -> GenLocated EpAnnCO (RuleBndr GhcPs)
forall a b.
(a -> b) -> GenLocated EpAnnCO a -> GenLocated EpAnnCO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleTyTmVar -> RuleBndr GhcPs
cvt_one)
where cvt_one :: RuleTyTmVar -> RuleBndr GhcPs
cvt_one (RuleTyTmVar [AddEpAnn]
ann LocatedN RdrName
v Maybe (LHsType GhcPs)
Nothing) = XCRuleBndr GhcPs -> XRec GhcPs (IdP GhcPs) -> RuleBndr GhcPs
forall pass. XCRuleBndr pass -> LIdP pass -> RuleBndr pass
RuleBndr [AddEpAnn]
XCRuleBndr GhcPs
ann XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v
cvt_one (RuleTyTmVar [AddEpAnn]
ann LocatedN RdrName
v (Just LHsType GhcPs
sig)) =
XRuleBndrSig GhcPs
-> XRec GhcPs (IdP GhcPs) -> HsPatSigType GhcPs -> RuleBndr GhcPs
forall pass.
XRuleBndrSig pass
-> LIdP pass -> HsPatSigType pass -> RuleBndr pass
RuleBndrSig [AddEpAnn]
XRuleBndrSig GhcPs
ann XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v (EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnnCO
forall a. NoAnn a => a
noAnn LHsType GhcPs
sig)
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs]
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs]
mkRuleTyVarBndrs = (LRuleTyTmVar -> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> [LRuleTyTmVar]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LRuleTyTmVar -> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall {a} {l}.
(HasLoc a, HasAnnotation l) =>
GenLocated a RuleTyTmVar -> GenLocated l (HsTyVarBndr () GhcPs)
cvt_one
where cvt_one :: GenLocated a RuleTyTmVar -> GenLocated l (HsTyVarBndr () GhcPs)
cvt_one (L a
l (RuleTyTmVar [AddEpAnn]
ann LocatedN RdrName
v Maybe (LHsType GhcPs)
Nothing))
= l -> HsTyVarBndr () GhcPs -> GenLocated l (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (a -> l
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l a
l) (XUserTyVar GhcPs
-> () -> XRec GhcPs (IdP GhcPs) -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar [AddEpAnn]
XUserTyVar GhcPs
ann () ((RdrName -> RdrName) -> LocatedN RdrName -> LocatedN RdrName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> RdrName
tm_to_ty LocatedN RdrName
v))
cvt_one (L a
l (RuleTyTmVar [AddEpAnn]
ann LocatedN RdrName
v (Just LHsType GhcPs
sig)))
= l -> HsTyVarBndr () GhcPs -> GenLocated l (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (a -> l
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l a
l) (XKindedTyVar GhcPs
-> ()
-> XRec GhcPs (IdP GhcPs)
-> LHsType GhcPs
-> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar [AddEpAnn]
XKindedTyVar GhcPs
ann () ((RdrName -> RdrName) -> LocatedN RdrName -> LocatedN RdrName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> RdrName
tm_to_ty LocatedN RdrName
v) LHsType GhcPs
sig)
tm_to_ty :: RdrName -> RdrName
tm_to_ty (Unqual OccName
occ) = OccName -> RdrName
Unqual (NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
tvName OccName
occ)
tm_to_ty RdrName
_ = String -> RdrName
forall a. HasCallStack => String -> a
panic String
"mkRuleTyVarBndrs"
checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P ()
checkRuleTyVarBndrNames :: forall flag. [LHsTyVarBndr flag GhcPs] -> P ()
checkRuleTyVarBndrNames = (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs) -> P ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)] -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GenLocated SrcSpanAnnA RdrName -> P ()
forall {f :: * -> *} {a}.
(MonadP f, HasLoc a) =>
GenLocated a RdrName -> f ()
check (GenLocated SrcSpanAnnA RdrName -> P ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnA RdrName)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr flag GhcPs -> RdrName)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnA RdrName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr flag GhcPs -> IdP GhcPs
HsTyVarBndr flag GhcPs -> RdrName
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName)
where check :: GenLocated a RdrName -> f ()
check (L a
loc (Unqual OccName
occ)) =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OccName -> FastString
occNameFS OccName
occ FastString -> [FastString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String -> FastString
fsLit String
"family",String -> FastString
fsLit String
"role"])
(MsgEnvelope PsMessage -> f ()
forall a. MsgEnvelope PsMessage -> f a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> f ()) -> MsgEnvelope PsMessage -> f ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(OccName -> PsMessage
PsErrParseErrorOnInput OccName
occ))
check GenLocated a RdrName
_ = String -> f ()
forall a. HasCallStack => String -> a
panic String
"checkRuleTyVarBndrNames"
checkRecordSyntax :: (MonadP m, Outputable a) => LocatedA a -> m (LocatedA a)
checkRecordSyntax :: forall (m :: * -> *) a.
(MonadP m, Outputable a) =>
LocatedA a -> m (LocatedA a)
checkRecordSyntax lr :: LocatedA a
lr@(L SrcSpanAnnA
loc a
r)
= do Bool
allowed <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
TraditionalRecordSyntaxBit
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgEnvelope PsMessage -> m ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> m ()) -> MsgEnvelope PsMessage -> m ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(SDoc -> PsMessage
PsErrIllegalTraditionalRecordSyntax (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
r))
LocatedA a -> m (LocatedA a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA a
lr
checkEmptyGADTs :: Located ([AddEpAnn], [LConDecl GhcPs])
-> P (Located ([AddEpAnn], [LConDecl GhcPs]))
checkEmptyGADTs :: Located ([AddEpAnn], [LConDecl GhcPs])
-> P (Located ([AddEpAnn], [LConDecl GhcPs]))
checkEmptyGADTs gadts :: Located ([AddEpAnn], [LConDecl GhcPs])
gadts@(L SrcSpan
span ([AddEpAnn]
_, []))
= do Bool
gadtSyntax <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
GadtSyntaxBit
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
gadtSyntax (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
span (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrIllegalWhereInDataDecl
Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
-> P (Located
([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return Located ([AddEpAnn], [LConDecl GhcPs])
Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
gadts
checkEmptyGADTs Located ([AddEpAnn], [LConDecl GhcPs])
gadts = Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
-> P (Located
([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return Located ([AddEpAnn], [LConDecl GhcPs])
Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
gadts
checkTyClHdr :: Bool
-> LHsType GhcPs
-> P (LocatedN RdrName,
[LHsTypeArg GhcPs],
LexicalFixity,
[AddEpAnn],
EpAnnComments)
checkTyClHdr :: Bool
-> LHsType GhcPs
-> P (LocatedN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
[AddEpAnn], EpAnnComments)
checkTyClHdr Bool
is_cls LHsType GhcPs
ty
= EpAnnComments
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
goL EpAnnComments
emptyComments LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty [] [] [] LexicalFixity
Prefix
where
goL :: EpAnnComments
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
goL EpAnnComments
cs (L SrcSpanAnnA
l HsType GhcPs
ty) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = EpAnnComments
-> SrcSpanAnnA
-> HsType GhcPs
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
go EpAnnComments
cs SrcSpanAnnA
l HsType GhcPs
ty [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go :: EpAnnComments
-> SrcSpanAnnA
-> HsType GhcPs
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
go EpAnnComments
cs SrcSpanAnnA
ll (HsParTy XParTy GhcPs
an (L SrcSpanAnnA
l (HsStarTy XStarTy GhcPs
_ Bool
isUni))) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops' [AddEpAnn]
cps' LexicalFixity
fix
= do { SrcSpan -> PsMessage -> P ()
addPsMessage (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) PsMessage
PsWarnStarBinder
; let name :: OccName
name = NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
tcClsName (Bool -> FastString
starSym Bool
isUni)
; let a' :: SrcSpanAnnN
a' = SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
newAnns SrcSpanAnnA
ll SrcSpanAnnA
l XParTy GhcPs
AnnParen
an
; (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
a' (OccName -> RdrName
Unqual OccName
name), [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc, LexicalFixity
fix
, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops') [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps', EpAnnComments
cs) }
go EpAnnComments
cs SrcSpanAnnA
l (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ ltc :: XRec GhcPs (IdP GhcPs)
ltc@(L SrcSpanAnnN
_ RdrName
tc)) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
| RdrName -> Bool
isRdrTc RdrName
tc = (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcPs (IdP GhcPs)
LocatedN RdrName
ltc, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc, LexicalFixity
fix, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps, EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
l)
go EpAnnComments
cs SrcSpanAnnA
l (HsOpTy XOpTy GhcPs
_ PromotionFlag
_ LHsType GhcPs
t1 ltc :: XRec GhcPs (IdP GhcPs)
ltc@(L SrcSpanAnnN
_ RdrName
tc) LHsType GhcPs
t2) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
_fix
| RdrName -> Bool
isRdrTc RdrName
tc = (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcPs (IdP GhcPs)
LocatedN RdrName
ltc, HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
lhsHsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
rhsHsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc, LexicalFixity
Infix, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps, EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
l)
where lhs :: HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
lhs = XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1
rhs :: HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
rhs = XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2
go EpAnnComments
cs SrcSpanAnnA
l (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = EpAnnComments
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
goL (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
l) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps) LexicalFixity
fix
where
(AddEpAnn
o,AddEpAnn
c) = RealSrcSpan -> (AddEpAnn, AddEpAnn)
mkParensEpAnn (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l))
go EpAnnComments
cs SrcSpanAnnA
l (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
t1 LHsType GhcPs
t2) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = EpAnnComments
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
goL (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
l) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1 (XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc) [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go EpAnnComments
cs SrcSpanAnnA
l (HsAppKindTy XAppKindTy GhcPs
at LHsType GhcPs
ty LHsType GhcPs
ki) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = EpAnnComments
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
goL (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
l) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (XTypeArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XTypeArg p -> ty -> HsArg p tm ty
HsTypeArg XAppKindTy GhcPs
XTypeArg GhcPs
at LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
kiHsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc) [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go EpAnnComments
cs SrcSpanAnnA
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts) [] [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
= (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) (Name -> RdrName
nameRdrName Name
tup_name)
, (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts, LexicalFixity
fix, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops)[AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++[AddEpAnn]
cps, EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
l)
where
arity :: Int
arity = [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts
tup_name :: Name
tup_name | Bool
is_cls = Int -> Name
cTupleTyConName Int
arity
| Bool
otherwise = TyCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
arity)
go EpAnnComments
_ SrcSpanAnnA
l HsType GhcPs
_ [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
_ [AddEpAnn]
_ [AddEpAnn]
_ LexicalFixity
_
= MsgEnvelope PsMessage
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments))
-> MsgEnvelope PsMessage
-> P (LocatedN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn], EpAnnComments)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LHsType GhcPs -> PsMessage
PsErrMalformedTyOrClDecl LHsType GhcPs
ty)
newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
newAnns l :: SrcSpanAnnA
l@(EpAnn EpaLocation
_ (AnnListItem [TrailingAnn]
_) EpAnnComments
csp0) l1 :: SrcSpanAnnA
l1@(EpAnn EpaLocation
ap (AnnListItem [TrailingAnn]
ta) EpAnnComments
csp) (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) =
let
lr :: SrcSpan
lr = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l1) (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
in
EpaLocation -> NameAnn -> EpAnnComments -> SrcSpanAnnN
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan SrcSpan
lr) (NameAdornment
-> EpaLocation
-> EpaLocation
-> EpaLocation
-> [TrailingAnn]
-> NameAnn
NameAnn NameAdornment
NameParens EpaLocation
o EpaLocation
ap EpaLocation
c [TrailingAnn]
ta) (EpAnnComments
csp0 EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
csp)
checkExpBlockArguments :: LHsExpr GhcPs -> PV ()
checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
(LHsExpr GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
checkExpBlockArguments, LHsCmd GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
checkCmdBlockArguments) = (LHsExpr GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
checkExpr, LHsCmd GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
checkCmd)
where
checkExpr :: LHsExpr GhcPs -> PV ()
checkExpr :: LHsExpr GhcPs -> PV ()
checkExpr LHsExpr GhcPs
expr = case GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr of
HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (Maybe ModuleName -> LHsExpr GhcPs -> PsMessage
PsErrDoInFunAppExpr Maybe ModuleName
m) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (Maybe ModuleName -> LHsExpr GhcPs -> PsMessage
PsErrMDoInFunAppExpr Maybe ModuleName
m) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsCase {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrCaseInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsLam XLam GhcPs
_ HsLamVariant
lam_variant MatchGroup GhcPs (LHsExpr GhcPs)
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (HsLamVariant -> LHsExpr GhcPs -> PsMessage
PsErrLambdaInFunAppExpr HsLamVariant
lam_variant) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsLet {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrLetInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsIf {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrIfInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsProc {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrProcInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsExpr GhcPs
_ -> () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkCmd :: LHsCmd GhcPs -> PV ()
checkCmd :: LHsCmd GhcPs -> PV ()
checkCmd LHsCmd GhcPs
cmd = case GenLocated SrcSpanAnnA (HsCmd GhcPs) -> HsCmd GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd of
HsCmdLam XCmdLamCase GhcPs
_ HsLamVariant
lam_variant MatchGroup GhcPs (LHsCmd GhcPs)
_ -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (HsLamVariant -> LHsCmd GhcPs -> PsMessage
PsErrLambdaCmdInFunAppCmd HsLamVariant
lam_variant) LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdCase {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrCaseCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdIf {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrIfCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdLet {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrLetCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdDo {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrDoCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmd GhcPs
_ -> () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
check :: (GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check GenLocated a e -> PsMessage
err GenLocated a e
a = do
Bool
blockArguments <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
BlockArgumentsBit
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
blockArguments (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgEnvelope PsMessage -> m ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> m ()) -> MsgEnvelope PsMessage -> m ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated a e -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated a e
a) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ (GenLocated a e -> PsMessage
err GenLocated a e
a)
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext orig_t :: LHsType GhcPs
orig_t@(L (EpAnn EpaLocation
l AnnListItem
_ EpAnnComments
cs) HsType GhcPs
_orig_t) =
([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([],[],EpAnnComments
cs) LHsType GhcPs
orig_t
where
check :: ([EpaLocation],[EpaLocation],EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check :: ([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([EpaLocation]
oparens,[EpaLocation]
cparens,EpAnnComments
cs) (L SrcSpanAnnA
_l (HsTupleTy XTupleTy GhcPs
ann' HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts))
= ([EpaLocation], [EpaLocation], EpAnnComments)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mkCTuple ([EpaLocation]
oparens [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ [AnnParen -> EpaLocation
ap_open XTupleTy GhcPs
AnnParen
ann'], AnnParen -> EpaLocation
ap_close XTupleTy GhcPs
AnnParen
ann' EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
: [EpaLocation]
cparens, EpAnnComments
cs) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts
check ([EpaLocation]
oparens,[EpaLocation]
cparens,EpAnnComments
cs) (L SrcSpanAnnA
_l (HsExplicitTupleTy XExplicitTupleTy GhcPs
anns [LHsType GhcPs]
ts))
= P Bool
punsAllowed P Bool
-> (Bool
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> P (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
unprocessed
Bool
False -> do
let
([AddEpAnn]
op, [AddEpAnn]
cp) = case XExplicitTupleTy GhcPs
anns of
[AddEpAnn
o, AddEpAnn
c] -> ([AddEpAnn
o], [AddEpAnn
c])
[AddEpAnn
q, AddEpAnn
_, AddEpAnn
c] -> ([AddEpAnn
q], [AddEpAnn
c])
XExplicitTupleTy GhcPs
_ -> ([], [])
([EpaLocation], [EpaLocation], EpAnnComments)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mkCTuple ([EpaLocation]
oparens [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ (AddEpAnn -> EpaLocation
addLoc (AddEpAnn -> EpaLocation) -> [AddEpAnn] -> [EpaLocation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddEpAnn]
op), (AddEpAnn -> EpaLocation
addLoc (AddEpAnn -> EpaLocation) -> [AddEpAnn] -> [EpaLocation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddEpAnn]
cp) [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ [EpaLocation]
cparens, EpAnnComments
cs) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts
check ([EpaLocation]
opi,[EpaLocation]
cpi,EpAnnComments
csi) (L SrcSpanAnnA
_lp1 (HsParTy XParTy GhcPs
ann' LHsType GhcPs
ty))
= ([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check (AnnParen -> EpaLocation
ap_open XParTy GhcPs
AnnParen
ann'EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
:[EpaLocation]
opi, AnnParen -> EpaLocation
ap_close XParTy GhcPs
AnnParen
ann'EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
:[EpaLocation]
cpi, EpAnnComments
csi) LHsType GhcPs
ty
check ([EpaLocation]
_opi,[EpaLocation]
_cpi,EpAnnComments
_csi) LHsType GhcPs
_t = P (LHsContext GhcPs)
P (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
unprocessed
unprocessed :: P (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
unprocessed =
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnContext -> EpAnnComments -> SrcSpanAnnC
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
l (Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing [] []) EpAnnComments
emptyComments) [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
orig_t])
addLoc :: AddEpAnn -> EpaLocation
addLoc (AddEpAnn AnnKeywordId
_ EpaLocation
l) = EpaLocation
l
mkCTuple :: ([EpaLocation], [EpaLocation], EpAnnComments)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mkCTuple ([EpaLocation]
oparens, [EpaLocation]
cparens, EpAnnComments
cs) [GenLocated SrcSpanAnnA (HsType GhcPs)]
ts =
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnContext -> EpAnnComments -> SrcSpanAnnC
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
l (Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing [EpaLocation]
oparens [EpaLocation]
cparens) EpAnnComments
cs) [GenLocated SrcSpanAnnA (HsType GhcPs)]
ts)
checkImportDecl :: Maybe EpaLocation
-> Maybe EpaLocation
-> P ()
checkImportDecl :: Maybe EpaLocation -> Maybe EpaLocation -> P ()
checkImportDecl Maybe EpaLocation
mPre Maybe EpaLocation
mPost = do
let whenJust :: Maybe a -> (a -> f ()) -> f ()
whenJust Maybe a
mg a -> f ()
f = f () -> (a -> f ()) -> Maybe a -> f ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> f ()
f Maybe a
mg
Bool
importQualifiedPostEnabled <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ImportQualifiedPostBit
Maybe EpaLocation -> (EpaLocation -> P ()) -> P ()
forall {f :: * -> *} {a}.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe EpaLocation
mPost ((EpaLocation -> P ()) -> P ()) -> (EpaLocation -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \EpaLocation
post ->
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
importQualifiedPostEnabled) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
SrcSpan -> P ()
failNotEnabledImportQualifiedPost (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
post) Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
Maybe EpaLocation -> (EpaLocation -> P ()) -> P ()
forall {f :: * -> *} {a}.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe EpaLocation
mPost ((EpaLocation -> P ()) -> P ()) -> (EpaLocation -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \EpaLocation
post ->
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe EpaLocation -> Bool
forall a. Maybe a -> Bool
isJust Maybe EpaLocation
mPre) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
SrcSpan -> P ()
failImportQualifiedTwice (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
post) Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
Maybe EpaLocation -> (EpaLocation -> P ()) -> P ()
forall {f :: * -> *} {a}.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe EpaLocation
mPre ((EpaLocation -> P ()) -> P ()) -> (EpaLocation -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \EpaLocation
pre ->
SrcSpan -> P ()
warnPrepositiveQualifiedModule (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
pre) Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
checkPattern :: LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern :: LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern = PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. PV a -> P a
runPV (PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> LocatedA (PatBuilder GhcPs)
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat
checkPattern_details :: ParseContext -> PV (LocatedA (PatBuilder GhcPs)) -> P (LPat GhcPs)
checkPattern_details :: ParseContext -> PV (LocatedA (PatBuilder GhcPs)) -> P (LPat GhcPs)
checkPattern_details ParseContext
extraDetails PV (LocatedA (PatBuilder GhcPs))
pp = ParseContext
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
extraDetails (PV (LocatedA (PatBuilder GhcPs))
pp PV (LocatedA (PatBuilder GhcPs))
-> (LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. PV a -> (a -> PV b) -> PV b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat)
checkLArgPat :: LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs)
checkLArgPat :: LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs)
checkLArgPat (L SrcSpanAnnA
l (ArgPatBuilderVisPat PatBuilder GhcPs
p)) = LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l PatBuilder GhcPs
p)
checkLArgPat (L SrcSpanAnnA
l (ArgPatBuilderArgPat Pat GhcPs
p)) = GenLocated SrcSpanAnnA (Pat GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Pat GhcPs
p)
checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat (L l :: SrcSpanAnnA
l@(EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
_) PatBuilder GhcPs
p) = do
(L SrcSpanAnnA
l' Pat GhcPs
p', EpAnnComments
cs) <- SrcSpanAnnA
-> EpAnnComments
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs, EpAnnComments)
checkPat (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
emptyComments) EpAnnComments
emptyComments (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l PatBuilder GhcPs
p) [] []
GenLocated SrcSpanAnnA (Pat GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn SrcSpanAnnA
l' EpAnnComments
cs) Pat GhcPs
p')
checkPat :: SrcSpanAnnA -> EpAnnComments -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]
-> PV (LPat GhcPs, EpAnnComments)
checkPat :: SrcSpanAnnA
-> EpAnnComments
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs, EpAnnComments)
checkPat SrcSpanAnnA
loc EpAnnComments
cs (L SrcSpanAnnA
l e :: PatBuilder GhcPs
e@(PatBuilderVar (L SrcSpanAnnN
ln RdrName
c))) [HsConPatTyArg GhcPs]
tyargs [LPat GhcPs]
args
| RdrName -> Bool
isRdrDataCon RdrName
c = (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = [AddEpAnn]
XConPat GhcPs
forall a. NoAnn a => a
noAnn
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
ln RdrName
c
, pat_args :: HsConPatDetails GhcPs
pat_args = [HsConPatTyArg GhcPs]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> HsConDetails
(HsConPatTyArg GhcPs)
(GenLocated SrcSpanAnnA (Pat GhcPs))
(HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [HsConPatTyArg GhcPs]
tyargs [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
args
}, SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
l EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs)
| (Bool -> Bool
not ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
args) Bool -> Bool -> Bool
&& RdrName -> Bool
patIsRec RdrName
c) = do
ParseContext
ctx <- PV ParseContext
askParseContext
SrcSpan
-> PsMessage
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
forall a. SrcSpan -> PsMessage -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments))
-> (PsErrInPatDetails -> PsMessage)
-> PsErrInPatDetails
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatBuilder GhcPs -> PsErrInPatDetails -> PsMessage
PsErrInPat PatBuilder GhcPs
e (PsErrInPatDetails
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments))
-> PsErrInPatDetails
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
forall a b. (a -> b) -> a -> b
$ [LPat GhcPs] -> PatIsRecursive -> ParseContext -> PsErrInPatDetails
PEIP_RecPattern [LPat GhcPs]
args PatIsRecursive
YesPatIsRecursive ParseContext
ctx
checkPat SrcSpanAnnA
loc EpAnnComments
cs (L SrcSpanAnnA
la (PatBuilderAppType LocatedA (PatBuilder GhcPs)
f EpToken "@"
at HsTyPat GhcPs
t)) [HsConPatTyArg GhcPs]
tyargs [LPat GhcPs]
args =
SrcSpanAnnA
-> EpAnnComments
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs, EpAnnComments)
checkPat SrcSpanAnnA
loc (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
la) LocatedA (PatBuilder GhcPs)
f (XConPatTyArg GhcPs -> HsTyPat GhcPs -> HsConPatTyArg GhcPs
forall p. XConPatTyArg p -> HsTyPat p -> HsConPatTyArg p
HsConPatTyArg EpToken "@"
XConPatTyArg GhcPs
at HsTyPat GhcPs
t HsConPatTyArg GhcPs
-> [HsConPatTyArg GhcPs] -> [HsConPatTyArg GhcPs]
forall a. a -> [a] -> [a]
: [HsConPatTyArg GhcPs]
tyargs) [LPat GhcPs]
args
checkPat SrcSpanAnnA
loc EpAnnComments
cs (L SrcSpanAnnA
la (PatBuilderApp LocatedA (PatBuilder GhcPs)
f LocatedA (PatBuilder GhcPs)
e)) [] [LPat GhcPs]
args = do
GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
SrcSpanAnnA
-> EpAnnComments
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs, EpAnnComments)
checkPat SrcSpanAnnA
loc (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
comments SrcSpanAnnA
la) LocatedA (PatBuilder GhcPs)
f [] (GenLocated SrcSpanAnnA (Pat GhcPs)
p GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. a -> [a] -> [a]
: [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
args)
checkPat SrcSpanAnnA
loc EpAnnComments
cs (L SrcSpanAnnA
l PatBuilder GhcPs
e) [] [] = do
Pat GhcPs
p <- SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat SrcSpanAnnA
loc PatBuilder GhcPs
e
(GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Pat GhcPs
p, EpAnnComments
cs)
checkPat SrcSpanAnnA
loc EpAnnComments
_ LocatedA (PatBuilder GhcPs)
e [HsConPatTyArg GhcPs]
_ [LPat GhcPs]
_ = do
PsErrInPatDetails
details <- ParseContext -> PsErrInPatDetails
fromParseContext (ParseContext -> PsErrInPatDetails)
-> PV ParseContext -> PV PsErrInPatDetails
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PV ParseContext
askParseContext
SrcSpan
-> PsMessage
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs), EpAnnComments)
forall a. SrcSpan -> PsMessage -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (PatBuilder GhcPs -> PsErrInPatDetails -> PsMessage
PsErrInPat (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (PatBuilder GhcPs)
e) PsErrInPatDetails
details)
checkAPat :: SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat :: SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat SrcSpanAnnA
loc PatBuilder GhcPs
e0 = do
Bool
nPlusKPatterns <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
NPlusKPatternsBit
case PatBuilder GhcPs
e0 of
PatBuilderPat Pat GhcPs
p -> Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return Pat GhcPs
p
PatBuilderVar LocatedN RdrName
x -> Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (XVarPat GhcPs -> XRec GhcPs (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
noExtField XRec GhcPs (IdP GhcPs)
LocatedN RdrName
x)
PatBuilderOverLit HsOverLit GhcPs
pos_lit -> Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn NoEpAnns (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs) -> [AddEpAnn] -> Pat GhcPs
mkNPat (EpAnnCO -> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) HsOverLit GhcPs
pos_lit) Maybe NoExtField
Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing [AddEpAnn]
forall a. NoAnn a => a
noAnn)
PatBuilderOpApp
(L SrcSpanAnnA
_ (PatBuilderVar (L SrcSpanAnnN
nloc RdrName
n)))
(L SrcSpanAnnN
l RdrName
plus)
(L SrcSpanAnnA
lloc (PatBuilderOverLit lit :: HsOverLit GhcPs
lit@(OverLit {ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = HsIntegral {}})))
[AddEpAnn]
_
| Bool
nPlusKPatterns Bool -> Bool -> Bool
&& (RdrName
plus RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
plus_RDR)
-> Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN RdrName
-> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpaLocation -> Pat GhcPs
mkNPlusKPat (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
nloc RdrName
n) (EpAnnCO -> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
lloc) HsOverLit GhcPs
lit)
(SrcSpanAnnN -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry SrcSpanAnnN
l))
PatBuilderOpApp LocatedA (PatBuilder GhcPs)
_ LocatedN RdrName
op LocatedA (PatBuilder GhcPs)
_ [AddEpAnn]
_ | RdrName -> Bool
opIsAt (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
op) -> do
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedN RdrName
op) PsMessage
PsErrAtInPatPos
Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcPs
NoExtField
noExtField)
PatBuilderOpApp LocatedA (PatBuilder GhcPs)
l (L SrcSpanAnnN
cl RdrName
c) LocatedA (PatBuilder GhcPs)
r [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon RdrName
c -> do
GenLocated SrcSpanAnnA (Pat GhcPs)
l <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
l
GenLocated SrcSpanAnnA (Pat GhcPs)
r <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
r
Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> PV (Pat GhcPs)) -> Pat GhcPs -> PV (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = [AddEpAnn]
XConPat GhcPs
anns
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
cl RdrName
c
, pat_args :: HsConPatDetails GhcPs
pat_args = GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> HsConDetails
(HsConPatTyArg GhcPs)
(GenLocated SrcSpanAnnA (Pat GhcPs))
(HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon GenLocated SrcSpanAnnA (Pat GhcPs)
l GenLocated SrcSpanAnnA (Pat GhcPs)
r
}
PatBuilderPar EpToken "("
lpar LocatedA (PatBuilder GhcPs)
e EpToken ")"
rpar -> do
GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XParPat p -> LPat p -> Pat p
ParPat (EpToken "("
lpar, EpToken ")"
rpar) LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p)
PatBuilder GhcPs
_ -> do
PsErrInPatDetails
details <- ParseContext -> PsErrInPatDetails
fromParseContext (ParseContext -> PsErrInPatDetails)
-> PV ParseContext -> PV PsErrInPatDetails
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PV ParseContext
askParseContext
SrcSpan -> PsMessage -> PV (Pat GhcPs)
forall a. SrcSpan -> PsMessage -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (PatBuilder GhcPs -> PsErrInPatDetails -> PsMessage
PsErrInPat PatBuilder GhcPs
e0 PsErrInPatDetails
details)
placeHolderPunRhs :: DisambECP b => PV (LocatedA b)
placeHolderPunRhs :: forall b. DisambECP b => PV (LocatedA b)
placeHolderPunRhs = LocatedN RdrName -> PV (LocatedA b)
forall b. DisambECP b => LocatedN RdrName -> PV (LocatedA b)
mkHsVarPV (RdrName -> LocatedN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA RdrName
pun_RDR)
plus_RDR, pun_RDR :: RdrName
plus_RDR :: RdrName
plus_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"+")
pun_RDR :: RdrName
pun_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"pun-right-hand-side")
checkPatField :: LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
checkPatField :: LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
checkPatField (L SrcSpanAnnA
l HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
fld) = do GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat (HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
fld)
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
fld { hfbRHS = p }))
patFail :: SrcSpan -> PsMessage -> PV a
patFail :: forall a. SrcSpan -> PsMessage -> PV a
patFail SrcSpan
loc PsMessage
msg = MsgEnvelope PsMessage -> PV a
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV a) -> MsgEnvelope PsMessage -> PV a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
msg
patIsRec :: RdrName -> Bool
patIsRec :: RdrName -> Bool
patIsRec RdrName
e = RdrName
e RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"rec")
checkValDef :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> (HsMultAnn GhcPs, Maybe (AddEpAnn, LHsType GhcPs))
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
checkValDef :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> (HsMultAnn GhcPs, Maybe (AddEpAnn, LHsType GhcPs))
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (HsMultAnn GhcPs
mult, Just (AddEpAnn
sigAnn, LHsType GhcPs
sig)) Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
= do GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' <- PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. PV a -> P a
runPV (PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
forall b.
DisambECP b =>
SrcSpanAnnA
-> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
mkHsTySigPV (LocatedA (PatBuilder GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA LocatedA (PatBuilder GhcPs)
lhs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig) LocatedA (PatBuilder GhcPs)
lhs LHsType GhcPs
sig [AddEpAnn
sigAnn]
PV (LocatedA (PatBuilder GhcPs))
-> (LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. PV a -> (a -> PV b) -> PV b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat
SrcSpan
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss HsMultAnn GhcPs
mult
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (HsMultAnn GhcPs
mult_ann, Maybe (AddEpAnn, LHsType GhcPs)
Nothing) Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
| HsNoMultAnn{} <- HsMultAnn GhcPs
mult_ann
= do { Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
mb_fun <- LocatedA (PatBuilder GhcPs)
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
lhs
; case Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
mb_fun of
Just (LocatedN RdrName
fun, LexicalFixity
is_infix, [LocatedA (ArgPatBuilder GhcPs)]
pats, [AddEpAnn]
ann) ->
SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> LocatedN RdrName
-> LexicalFixity
-> [LocatedA (ArgPatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkFunBind SrcStrictness
NoSrcStrict SrcSpan
loc [AddEpAnn]
ann
LocatedN RdrName
fun LexicalFixity
is_infix [LocatedA (ArgPatBuilder GhcPs)]
pats Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
Nothing -> do
GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' <- LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern LocatedA (PatBuilder GhcPs)
lhs
SrcSpan
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss HsMultAnn GhcPs
mult_ann }
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (HsMultAnn GhcPs
mult_ann, Maybe (AddEpAnn, LHsType GhcPs)
Nothing) Located (GRHSs GhcPs (LHsExpr GhcPs))
ghrss
= do GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' <- LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern LocatedA (PatBuilder GhcPs)
lhs
SrcSpan
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' Located (GRHSs GhcPs (LHsExpr GhcPs))
ghrss HsMultAnn GhcPs
mult_ann
checkFunBind :: SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> LocatedN RdrName
-> LexicalFixity
-> [LocatedA (ArgPatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
checkFunBind :: SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> LocatedN RdrName
-> LexicalFixity
-> [LocatedA (ArgPatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkFunBind SrcStrictness
strictness SrcSpan
locF [AddEpAnn]
ann (L SrcSpanAnnN
lf RdrName
fun) LexicalFixity
is_infix [LocatedA (ArgPatBuilder GhcPs)]
pats (L SrcSpan
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss)
= do [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps <- ParseContext
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> P [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
extraDetails ((LocatedA (ArgPatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [LocatedA (ArgPatBuilder GhcPs)]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (ArgPatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLArgPat [LocatedA (ArgPatBuilder GhcPs)]
pats)
let match_span :: SrcSpanAnnA
match_span = SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan
locF
HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
lf) RdrName
fun) (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnL
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnL) -> SrcSpan -> SrcSpanAnnL
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
match_span)
[SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
match_span (Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = [AddEpAnn]
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ann
, m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt = FunRhs
{ mc_fun :: LocatedN RdrName
mc_fun = SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lf RdrName
fun
, mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
is_infix
, mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
strictness }
, m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps
, m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss })]))
where
extraDetails :: ParseContext
extraDetails
| LexicalFixity
Infix <- LexicalFixity
is_infix = Maybe RdrName -> PatIncompleteDoBlock -> ParseContext
ParseContext (RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just RdrName
fun) PatIncompleteDoBlock
NoIncompleteDoBlock
| Bool
otherwise = ParseContext
noParseContext
makeFunBind :: LocatedN RdrName -> LocatedL [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
makeFunBind :: LocatedN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind LocatedN RdrName
fn LocatedL [LMatch GhcPs (LHsExpr GhcPs)]
ms
= FunBind { fun_ext :: XFunBind GhcPs GhcPs
fun_ext = XFunBind GhcPs GhcPs
NoExtField
noExtField,
fun_id :: XRec GhcPs (IdP GhcPs)
fun_id = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
fn,
fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches = Origin
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
FromSource LocatedL [LMatch GhcPs (LHsExpr GhcPs)]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms }
checkPatBind :: SrcSpan
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBind GhcPs)
checkPatBind :: SrcSpan
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc (L SrcSpanAnnA
_ (BangPat XBangPat GhcPs
ans (L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ XRec GhcPs (IdP GhcPs)
v))))
(L SrcSpan
_match_span GRHSs GhcPs (LHsExpr GhcPs)
grhss) (HsNoMultAnn XNoMultAnn GhcPs
_)
= HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnL
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc)
[SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) ([AddEpAnn]
-> LocatedN RdrName
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m [AddEpAnn]
XBangPat GhcPs
ans XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v)]))
where
m :: [AddEpAnn]
-> LocatedN RdrName
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m [AddEpAnn]
a LocatedN RdrName
v = Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = [AddEpAnn]
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a
, m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt = FunRhs { mc_fun :: LocatedN RdrName
mc_fun = LocatedN RdrName
v
, mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Prefix
, mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
SrcStrict }
, m_pats :: [LPat GhcPs]
m_pats = []
, m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss }
checkPatBind SrcSpan
_loc LPat GhcPs
lhs (L SrcSpan
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss) HsMultAnn GhcPs
mult = do
HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPatBind GhcPs GhcPs
-> LPat GhcPs
-> HsMultAnn GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL
-> HsMultAnn idL
-> GRHSs idR (LHsExpr idR)
-> HsBindLR idL idR
PatBind XPatBind GhcPs GhcPs
NoExtField
noExtField LPat GhcPs
lhs HsMultAnn GhcPs
mult GRHSs GhcPs (LHsExpr GhcPs)
grhss)
checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
checkValSigLhs lhs :: LHsExpr GhcPs
lhs@(L SrcSpanAnnA
l HsExpr GhcPs
lhs_expr) =
case HsExpr GhcPs
lhs_expr of
HsVar XVar GhcPs
_ lrdr :: XRec GhcPs (IdP GhcPs)
lrdr@(L SrcSpanAnnN
_ RdrName
v) -> RdrName -> LocatedN RdrName -> P (LocatedN RdrName)
check_var RdrName
v XRec GhcPs (IdP GhcPs)
LocatedN RdrName
lrdr
HsExpr GhcPs
_ -> PsInvalidTypeSignature -> P (LocatedN RdrName)
make_err PsInvalidTypeSignature
PsErrInvalidTypeSig_Other
where
check_var :: RdrName -> LocatedN RdrName -> P (LocatedN RdrName)
check_var RdrName
v LocatedN RdrName
lrdr
| Bool -> Bool
not (RdrName -> Bool
isUnqual RdrName
v) = PsInvalidTypeSignature -> P (LocatedN RdrName)
make_err PsInvalidTypeSignature
PsErrInvalidTypeSig_Qualified
| OccName -> Bool
isDataOcc OccName
occ_n = PsInvalidTypeSignature -> P (LocatedN RdrName)
make_err PsInvalidTypeSignature
PsErrInvalidTypeSig_DataCon
| Bool
otherwise = LocatedN RdrName -> P (LocatedN RdrName)
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedN RdrName
lrdr
where occ_n :: OccName
occ_n = RdrName -> OccName
rdrNameOcc RdrName
v
make_err :: PsInvalidTypeSignature -> P (LocatedN RdrName)
make_err PsInvalidTypeSignature
reason = MsgEnvelope PsMessage -> P (LocatedN RdrName)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (LocatedN RdrName))
-> MsgEnvelope PsMessage -> P (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$
SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsInvalidTypeSignature -> LHsExpr GhcPs -> PsMessage
PsErrInvalidTypeSignature PsInvalidTypeSignature
reason LHsExpr GhcPs
lhs)
checkDoAndIfThenElse
:: (Outputable a, Outputable b, Outputable c)
=> (a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse :: forall a b c.
(Outputable a, Outputable b, Outputable c) =>
(a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse a -> Bool -> b -> Bool -> c -> PsMessage
err GenLocated SrcSpanAnnA a
guardExpr Bool
semiThen LocatedA b
thenExpr Bool
semiElse GenLocated SrcSpanAnnA c
elseExpr
| Bool
semiThen Bool -> Bool -> Bool
|| Bool
semiElse = do
Bool
doAndIfThenElse <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
DoAndIfThenElseBit
let e :: PsMessage
e = a -> Bool -> b -> Bool -> c -> PsMessage
err (GenLocated SrcSpanAnnA a -> a
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA a
guardExpr)
Bool
semiThen (LocatedA b -> b
forall l e. GenLocated l e -> e
unLoc LocatedA b
thenExpr)
Bool
semiElse (GenLocated SrcSpanAnnA c -> c
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA c
elseExpr)
loc :: SrcSpan
loc = Located a -> Located c -> SrcSpan
forall a b. Located a -> Located b -> SrcSpan
combineLocs (GenLocated SrcSpanAnnA a -> Located a
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpanAnnA a
guardExpr) (GenLocated SrcSpanAnnA c -> Located c
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpanAnnA c
elseExpr)
Bool -> PV () -> PV ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doAndIfThenElse (PV () -> PV ()) -> PV () -> PV ()
forall a b. (a -> b) -> a -> b
$ MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc PsMessage
e)
| Bool
otherwise = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isFunLhs :: LocatedA (PatBuilder GhcPs)
-> P (Maybe (LocatedN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)],[AddEpAnn]))
isFunLhs :: LocatedA (PatBuilder GhcPs)
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
e = LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
e [] [] []
where
mk :: GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk = (PatBuilder p -> ArgPatBuilder p)
-> GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PatBuilder p -> ArgPatBuilder p
forall p. PatBuilder p -> ArgPatBuilder p
ArgPatBuilderVisPat
go :: LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
go (L SrcSpanAnnA
l (PatBuilderVar (L SrcSpanAnnN
loc RdrName
f))) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
| Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
f) = do
let (SrcSpanAnnA
_l, SrcSpanAnnN
loc') = SrcSpanAnnA -> SrcSpanAnnN -> (SrcSpanAnnA, SrcSpanAnnN)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
l SrcSpanAnnN
loc
Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
forall a. a -> Maybe a
Just (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
f, LexicalFixity
Prefix, [LocatedA (ArgPatBuilder GhcPs)]
es, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps))
go (L SrcSpanAnnA
l (PatBuilderApp (L SrcSpanAnnA
lf PatBuilder GhcPs
f) LocatedA (PatBuilder GhcPs)
e)) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps = do
let (SrcSpanAnnA
_l, SrcSpanAnnA
lf') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
l SrcSpanAnnA
lf
LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
go (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lf' PatBuilder GhcPs
f) (LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk LocatedA (PatBuilder GhcPs)
eLocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
:[LocatedA (ArgPatBuilder GhcPs)]
es) [AddEpAnn]
ops [AddEpAnn]
cps
go (L SrcSpanAnnA
l (PatBuilderPar EpToken "("
_ (L SrcSpanAnnA
le PatBuilder GhcPs
e) EpToken ")"
_)) es :: [LocatedA (ArgPatBuilder GhcPs)]
es@(LocatedA (ArgPatBuilder GhcPs)
_:[LocatedA (ArgPatBuilder GhcPs)]
_) [AddEpAnn]
ops [AddEpAnn]
cps = LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
go (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
le' PatBuilder GhcPs
e) [LocatedA (ArgPatBuilder GhcPs)]
es (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps)
where
(SrcSpanAnnA
_l, SrcSpanAnnA
le') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
l SrcSpanAnnA
le
(AddEpAnn
o,AddEpAnn
c) = RealSrcSpan -> (AddEpAnn, AddEpAnn)
mkParensEpAnn (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
go (L SrcSpanAnnA
loc (PatBuilderOpApp (L SrcSpanAnnA
ll PatBuilder GhcPs
l) (L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder GhcPs)
r [AddEpAnn]
anns)) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
| Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
op)
= do { let (SrcSpanAnnA
_l, SrcSpanAnnA
ll') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
loc SrcSpanAnnA
ll
; Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
forall a. a -> Maybe a
Just (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
op, LexicalFixity
Infix, (LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ll' PatBuilder GhcPs
l)LocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
:LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk LocatedA (PatBuilder GhcPs)
rLocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
:[LocatedA (ArgPatBuilder GhcPs)]
es), ([AddEpAnn]
anns [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps))) }
| Bool
otherwise
= do { let (SrcSpanAnnA
_l, SrcSpanAnnA
ll') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
loc SrcSpanAnnA
ll
; Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
mb_l <- LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
go (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ll' PatBuilder GhcPs
l) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
; Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
reassociate ((LocatedN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
mb_l) }
where
reassociate :: (LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
reassociate (LocatedN RdrName
op', LexicalFixity
Infix, LocatedA (ArgPatBuilder GhcPs)
j : L SrcSpanAnnA
k_loc (ArgPatBuilderVisPat PatBuilder GhcPs
k) : [LocatedA (ArgPatBuilder GhcPs)]
es', [AddEpAnn]
anns')
= (LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
forall a. a -> Maybe a
Just (LocatedN RdrName
op', LexicalFixity
Infix, LocatedA (ArgPatBuilder GhcPs)
j LocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
: LocatedA (ArgPatBuilder GhcPs)
op_app LocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
: [LocatedA (ArgPatBuilder GhcPs)]
es', [AddEpAnn]
anns')
where
op_app :: LocatedA (ArgPatBuilder GhcPs)
op_app = LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk (LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LocatedA (PatBuilder GhcPs)
-> LocatedN RdrName
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p)
-> LocatedN RdrName
-> LocatedA (PatBuilder p)
-> [AddEpAnn]
-> PatBuilder p
PatBuilderOpApp (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
k_loc PatBuilder GhcPs
k)
(SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder GhcPs)
r ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps))
reassociate (LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
_other = Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
forall a. Maybe a
Nothing
go (L SrcSpanAnnA
l (PatBuilderAppType (L SrcSpanAnnA
lp PatBuilder GhcPs
pat) EpToken "@"
tok ty_pat :: HsTyPat GhcPs
ty_pat@(HsTP XHsTP GhcPs
_ (L (EpAnn EpaLocation
anc AnnListItem
ann EpAnnComments
cs) HsType GhcPs
_)))) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
= LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
go (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lp' PatBuilder GhcPs
pat) (SrcSpanAnnA
-> ArgPatBuilder GhcPs -> LocatedA (ArgPatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc' AnnListItem
ann EpAnnComments
cs) (Pat GhcPs -> ArgPatBuilder GhcPs
forall p. Pat p -> ArgPatBuilder p
ArgPatBuilderArgPat Pat GhcPs
invis_pat) LocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
: [LocatedA (ArgPatBuilder GhcPs)]
es) [AddEpAnn]
ops [AddEpAnn]
cps
where invis_pat :: Pat GhcPs
invis_pat = XInvisPat GhcPs -> HsTyPat (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XInvisPat p -> HsTyPat (NoGhcTc p) -> Pat p
InvisPat XInvisPat GhcPs
EpToken "@"
tok HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
ty_pat
anc' :: EpaLocation
anc' = case EpToken "@"
tok of
EpToken "@"
NoEpTok -> EpaLocation
anc
EpTok EpaLocation
l -> EpaLocation -> [AddEpAnn] -> EpaLocation
widenAnchor EpaLocation
anc [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnAnyclass EpaLocation
l]
(SrcSpanAnnA
_l, SrcSpanAnnA
lp') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
forall a b. EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA SrcSpanAnnA
l SrcSpanAnnA
lp
go LocatedA (PatBuilder GhcPs)
_ [LocatedA (ArgPatBuilder GhcPs)]
_ [AddEpAnn]
_ [AddEpAnn]
_ = Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
-> P (Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
(LocatedN RdrName, LexicalFixity, [LocatedA (ArgPatBuilder GhcPs)],
[AddEpAnn])
forall a. Maybe a
Nothing
data ArgPatBuilder p
= ArgPatBuilderVisPat (PatBuilder p)
| ArgPatBuilderArgPat (Pat p)
instance Outputable (ArgPatBuilder GhcPs) where
ppr :: ArgPatBuilder GhcPs -> SDoc
ppr (ArgPatBuilderVisPat PatBuilder GhcPs
p) = PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
p
ppr (ArgPatBuilderArgPat Pat GhcPs
p) = Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcPs
p
mkBangTy :: [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy :: [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy [AddEpAnn]
anns SrcStrictness
strictness =
XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy [AddEpAnn]
XBangTy GhcPs
anns (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
strictness)
data UnpackednessPragma =
UnpackednessPragma [AddEpAnn] SourceText SrcUnpackedness
addUnpackednessP :: MonadP m => Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP :: forall (m :: * -> *).
MonadP m =>
Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP (L SrcSpan
lprag (UnpackednessPragma [AddEpAnn]
anns SourceText
prag SrcUnpackedness
unpk)) LHsType GhcPs
ty = do
let l' :: SrcSpan
l' = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
lprag (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
let t' :: HsType GhcPs
t' = [AddEpAnn] -> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness [AddEpAnn]
anns LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
GenLocated SrcSpanAnnA (HsType GhcPs)
-> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l') HsType GhcPs
t')
where
addUnpackedness :: [AddEpAnn] -> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness [AddEpAnn]
an (L SrcSpanAnnA
_ (HsBangTy XBangTy GhcPs
x HsSrcBang
bang LHsType GhcPs
t))
| HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
strictness <- HsSrcBang
bang
= XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy ([AddEpAnn]
an [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
XBangTy GhcPs
x) (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
prag SrcUnpackedness
unpk SrcStrictness
strictness) LHsType GhcPs
t
addUnpackedness [AddEpAnn]
an GenLocated SrcSpanAnnA (HsType GhcPs)
t
= XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy [AddEpAnn]
XBangTy GhcPs
an (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
prag SrcUnpackedness
unpk SrcStrictness
NoSrcStrict) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
checkMonadComp :: PV HsDoFlavour
checkMonadComp :: PV HsDoFlavour
checkMonadComp = do
Bool
monadComprehensions <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
MonadComprehensionsBit
HsDoFlavour -> PV HsDoFlavour
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsDoFlavour -> PV HsDoFlavour) -> HsDoFlavour -> PV HsDoFlavour
forall a b. (a -> b) -> a -> b
$ if Bool
monadComprehensions
then HsDoFlavour
MonadComp
else HsDoFlavour
ListComp
newtype ECP =
ECP { ECP -> forall b. DisambECP b => PV (LocatedA b)
unECP :: forall b. DisambECP b => PV (LocatedA b) }
ecpFromExp :: LHsExpr GhcPs -> ECP
ecpFromExp :: LHsExpr GhcPs -> ECP
ecpFromExp LHsExpr GhcPs
a = (forall b. DisambECP b => PV (LocatedA b)) -> ECP
ECP (LHsExpr GhcPs -> PV (LocatedA b)
forall b. DisambECP b => LHsExpr GhcPs -> PV (LocatedA b)
ecpFromExp' LHsExpr GhcPs
a)
ecpFromCmd :: LHsCmd GhcPs -> ECP
ecpFromCmd :: LHsCmd GhcPs -> ECP
ecpFromCmd LHsCmd GhcPs
a = (forall b. DisambECP b => PV (LocatedA b)) -> ECP
ECP (LHsCmd GhcPs -> PV (LocatedA b)
forall b. DisambECP b => LHsCmd GhcPs -> PV (LocatedA b)
ecpFromCmd' LHsCmd GhcPs
a)
type Fbind b = Either (LHsRecField GhcPs (LocatedA b)) (LHsRecProj GhcPs (LocatedA b))
class DisambInfixOp b where
mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN b)
mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN b)
mkHsInfixHolePV :: LocatedN (HsExpr GhcPs) -> PV (LocatedN b)
instance DisambInfixOp (HsExpr GhcPs) where
mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN (HsExpr GhcPs))
mkHsVarOpPV LocatedN RdrName
v = LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs)))
-> LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> HsExpr GhcPs -> LocatedN (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (LocatedN RdrName -> SrcSpanAnnN
forall l e. GenLocated l e -> l
getLoc LocatedN RdrName
v) (XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v)
mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN (HsExpr GhcPs))
mkHsConOpPV LocatedN RdrName
v = LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs)))
-> LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> HsExpr GhcPs -> LocatedN (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (LocatedN RdrName -> SrcSpanAnnN
forall l e. GenLocated l e -> l
getLoc LocatedN RdrName
v) (XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v)
mkHsInfixHolePV :: LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
mkHsInfixHolePV LocatedN (HsExpr GhcPs)
h = LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedN (HsExpr GhcPs)
h
instance DisambInfixOp RdrName where
mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN RdrName)
mkHsConOpPV (L SrcSpanAnnN
l RdrName
v) = LocatedN RdrName -> PV (LocatedN RdrName)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN RdrName -> PV (LocatedN RdrName))
-> LocatedN RdrName -> PV (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
v
mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN RdrName)
mkHsVarOpPV (L SrcSpanAnnN
l RdrName
v) = LocatedN RdrName -> PV (LocatedN RdrName)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN RdrName -> PV (LocatedN RdrName))
-> LocatedN RdrName -> PV (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
v
mkHsInfixHolePV :: LocatedN (HsExpr GhcPs) -> PV (LocatedN RdrName)
mkHsInfixHolePV (L SrcSpanAnnN
l HsExpr GhcPs
_) = MsgEnvelope PsMessage -> PV (LocatedN RdrName)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedN RdrName))
-> MsgEnvelope PsMessage -> PV (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc SrcSpanAnnN
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrInvalidInfixHole
type AnnoBody b
= ( Anno (GRHS GhcPs (LocatedA (Body b GhcPs))) ~ EpAnnCO
, Anno [LocatedA (Match GhcPs (LocatedA (Body b GhcPs)))] ~ SrcSpanAnnL
, Anno (Match GhcPs (LocatedA (Body b GhcPs))) ~ SrcSpanAnnA
, Anno (StmtLR GhcPs GhcPs (LocatedA (Body (Body b GhcPs) GhcPs))) ~ SrcSpanAnnA
, Anno [LocatedA (StmtLR GhcPs GhcPs
(LocatedA (Body (Body (Body b GhcPs) GhcPs) GhcPs)))] ~ SrcSpanAnnL
)
class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
type Body b :: Type -> Type
ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA b)
ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b)
mkHsProjUpdatePV :: SrcSpan -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b))
mkHsLetPV
:: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> LocatedA b
-> PV (LocatedA b)
type InfixOp b
superInfixOp
:: (DisambInfixOp (InfixOp b) => PV (LocatedA b )) -> PV (LocatedA b)
mkHsOpAppPV :: SrcSpan -> LocatedA b -> LocatedN (InfixOp b) -> LocatedA b
-> PV (LocatedA b)
mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> (LocatedL [LMatch GhcPs (LocatedA b)])
-> EpAnnHsCase -> PV (LocatedA b)
mkHsLamPV :: SrcSpan -> HsLamVariant
-> (LocatedL [LMatch GhcPs (LocatedA b)]) -> [AddEpAnn]
-> PV (LocatedA b)
type FunArg b
superFunArg :: (DisambECP (FunArg b) => PV (LocatedA b)) -> PV (LocatedA b)
mkHsAppPV :: SrcSpanAnnA -> LocatedA b -> LocatedA (FunArg b) -> PV (LocatedA b)
mkHsAppTypePV :: SrcSpanAnnA -> LocatedA b -> EpToken "@" -> LHsType GhcPs -> PV (LocatedA b)
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> LocatedA b
-> Bool
-> LocatedA b
-> AnnsIf
-> PV (LocatedA b)
mkHsDoPV ::
SrcSpan ->
Maybe ModuleName ->
LocatedL [LStmt GhcPs (LocatedA b)] ->
AnnList ->
PV (LocatedA b)
mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b)
mkHsVarPV :: LocatedN RdrName -> PV (LocatedA b)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (LocatedA b)
mkHsOverLitPV :: LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a b)
mkHsWildCardPV :: (NoAnn a) => SrcSpan -> PV (LocatedAn a b)
mkHsTySigPV
:: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA b)
mkHsRecordPV ::
Bool ->
SrcSpan ->
SrcSpan ->
LocatedA b ->
([Fbind b], Maybe SrcSpan) ->
[AddEpAnn] ->
PV (LocatedA b)
mkHsNegAppPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkHsSectionR_PV
:: SrcSpan -> LocatedA (InfixOp b) -> LocatedA b -> PV (LocatedA b)
mkHsViewPatPV
:: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkHsAsPatPV
:: SrcSpan -> LocatedN RdrName -> EpToken "@" -> LocatedA b -> PV (LocatedA b)
mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkHsBangPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkSumOrTuplePV
:: SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddEpAnn] -> PV (LocatedA b)
mkHsEmbTyPV :: SrcSpan -> EpToken "type" -> LHsType GhcPs -> PV (LocatedA b)
rejectPragmaPV :: LocatedA b -> PV ()
instance DisambECP (HsCmd GhcPs) where
type Body (HsCmd GhcPs) = HsCmd
ecpFromCmd' :: LHsCmd GhcPs -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
ecpFromCmd' = LHsCmd GhcPs -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return
ecpFromExp' :: LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
ecpFromExp' (L SrcSpanAnnA
l HsExpr GhcPs
e) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e)
mkHsProjUpdatePV :: SrcSpan
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
_ Bool
_ [AddEpAnn]
_ = MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))))
-> MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrOverloadedRecordDotInvalid
mkHsLamPV :: SrcSpan
-> HsLamVariant
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLamPV SrcSpan
l HsLamVariant
lam_variant (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
m) [AddEpAnn]
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg = Origin
-> HsLamVariant
-> LocatedL
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> HsLamVariant
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup Origin
FromSource HsLamVariant
lam_variant (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> LocatedL
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
m)
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XCmdLamCase GhcPs
-> HsLamVariant -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id.
XCmdLamCase id
-> HsLamVariant -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam [AddEpAnn]
XCmdLamCase GhcPs
anns HsLamVariant
lam_variant MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg)
mkHsLetPV :: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLetPV SrcSpan
l EpToken "let"
tkLet HsLocalBinds GhcPs
bs EpToken "in"
tkIn GenLocated SrcSpanAnnA (HsCmd GhcPs)
e = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XCmdLet GhcPs -> HsLocalBinds GhcPs -> LHsCmd GhcPs -> HsCmd GhcPs
forall id. XCmdLet id -> HsLocalBinds id -> LHsCmd id -> HsCmd id
HsCmdLet (EpToken "let"
tkLet, EpToken "in"
tkIn) HsLocalBinds GhcPs
bs LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
e)
type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
superInfixOp :: (DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
superInfixOp DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m
mkHsOpAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LocatedN (InfixOp (HsCmd GhcPs))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsOpAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c1 LocatedN (InfixOp (HsCmd GhcPs))
op GenLocated SrcSpanAnnA (HsCmd GhcPs)
c2 = do
let cmdArg :: GenLocated a (HsCmd p) -> GenLocated l (HsCmdTop p)
cmdArg GenLocated a (HsCmd p)
c = l -> HsCmdTop p -> GenLocated l (HsCmdTop p)
forall l e. l -> e -> GenLocated l e
L (a -> l
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l (a -> l) -> a -> l
forall a b. (a -> b) -> a -> b
$ GenLocated a (HsCmd p) -> a
forall l e. GenLocated l e -> l
getLoc GenLocated a (HsCmd p)
c) (HsCmdTop p -> GenLocated l (HsCmdTop p))
-> HsCmdTop p -> GenLocated l (HsCmdTop p)
forall a b. (a -> b) -> a -> b
$ XCmdTop p -> XRec p (HsCmd p) -> HsCmdTop p
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop XCmdTop p
NoExtField
noExtField XRec p (HsCmd p)
GenLocated a (HsCmd p)
c
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall a b. (a -> b) -> a -> b
$ XCmdArrForm GhcPs
-> LHsExpr GhcPs
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcPs]
-> HsCmd GhcPs
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm (Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe EpaLocation
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [] []) (LocatedN (HsExpr GhcPs) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc LocatedN (HsExpr GhcPs)
LocatedN (InfixOp (HsCmd GhcPs))
op) LexicalFixity
Infix Maybe Fixity
forall a. Maybe a
Nothing [GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> GenLocated EpAnnCO (HsCmdTop GhcPs)
forall {p} {a} {l}.
(XCmdTop p ~ NoExtField, XRec p (HsCmd p) ~ GenLocated a (HsCmd p),
HasLoc a, HasAnnotation l) =>
GenLocated a (HsCmd p) -> GenLocated l (HsCmdTop p)
cmdArg GenLocated SrcSpanAnnA (HsCmd GhcPs)
c1, GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> GenLocated EpAnnCO (HsCmdTop GhcPs)
forall {p} {a} {l}.
(XCmdTop p ~ NoExtField, XRec p (HsCmd p) ~ GenLocated a (HsCmd p),
HasLoc a, HasAnnotation l) =>
GenLocated a (HsCmd p) -> GenLocated l (HsCmdTop p)
cmdArg GenLocated SrcSpanAnnA (HsCmd GhcPs)
c2]
mkHsCasePV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> EpAnnHsCase
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsCasePV SrcSpan
l LHsExpr GhcPs
c (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
m) EpAnnHsCase
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg = Origin
-> LocatedL
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
FromSource (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> LocatedL
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
m)
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XCmdCase GhcPs
-> LHsExpr GhcPs -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase XCmdCase GhcPs
EpAnnHsCase
anns LHsExpr GhcPs
c MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg)
type FunArg (HsCmd GhcPs) = HsExpr GhcPs
superFunArg :: (DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
superFunArg DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m
mkHsAppPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LocatedA (FunArg (HsCmd GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAppPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LocatedA (FunArg (HsCmd GhcPs))
e = do
LHsCmd GhcPs -> PV ()
checkCmdBlockArguments LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
LocatedA (FunArg (HsCmd GhcPs))
e
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XCmdApp GhcPs -> LHsCmd GhcPs -> LHsExpr GhcPs -> HsCmd GhcPs
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp XCmdApp GhcPs
NoExtField
noExtField LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LHsExpr GhcPs
LocatedA (FunArg (HsCmd GhcPs))
e)
mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c EpToken "@"
_ LHsType GhcPs
t = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t)
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> AnnsIf
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsIfPV SrcSpan
l LHsExpr GhcPs
c Bool
semi1 GenLocated SrcSpanAnnA (HsCmd GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsCmd GhcPs)
b AnnsIf
anns = do
(HsExpr GhcPs
-> Bool -> HsCmd GhcPs -> Bool -> HsCmd GhcPs -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV ()
forall a b c.
(Outputable a, Outputable b, Outputable c) =>
(a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse HsExpr GhcPs
-> Bool -> HsCmd GhcPs -> Bool -> HsCmd GhcPs -> PsMessage
PsErrSemiColonsInCondCmd LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
c Bool
semi1 GenLocated SrcSpanAnnA (HsCmd GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsCmd GhcPs)
b
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (LHsExpr GhcPs
-> LHsCmd GhcPs -> LHsCmd GhcPs -> AnnsIf -> HsCmd GhcPs
mkHsCmdIf LHsExpr GhcPs
c LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
a LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
b AnnsIf
anns)
mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
Nothing LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
stmts AnnList
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XCmdDo GhcPs -> XRec GhcPs [CmdLStmt GhcPs] -> HsCmd GhcPs
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo XCmdDo GhcPs
AnnList
anns XRec GhcPs [CmdLStmt GhcPs]
LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
stmts)
mkHsDoPV SrcSpan
l (Just ModuleName
m) LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
_ AnnList
_ = MsgEnvelope PsMessage -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ ModuleName -> PsMessage
PsErrQualifiedDoInCmd ModuleName
m
mkHsParPV :: SrcSpan
-> EpToken "("
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> EpToken ")"
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsParPV SrcSpan
l EpToken "("
lpar GenLocated SrcSpanAnnA (HsCmd GhcPs)
c EpToken ")"
rpar = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XCmdPar GhcPs -> LHsCmd GhcPs -> HsCmd GhcPs
forall id. XCmdPar id -> LHsCmd id -> HsCmd id
HsCmdPar (EpToken "("
lpar, EpToken ")"
rpar) LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c)
mkHsVarPV :: LocatedN RdrName -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsVarPV (L SrcSpanAnnN
l RdrName
v) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
l) (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLitPV (L SrcSpan
l HsLit GhcPs
a) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (HsLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit GhcPs
a)
mkHsOverLitPV :: forall a.
LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a (HsCmd GhcPs))
mkHsOverLitPV (L EpAnn a
l HsOverLit GhcPs
a) = SrcSpan -> SDoc -> PV (LocatedAn a (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (EpAnn a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpAnn a
l) (HsOverLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcPs
a)
mkHsWildCardPV :: forall a. NoAnn a => SrcSpan -> PV (LocatedAn a (HsCmd GhcPs))
mkHsWildCardPV SrcSpan
l = SrcSpan -> SDoc -> PV (LocatedAn a (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_")
mkHsTySigPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsTySigPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
a LHsType GhcPs
sig [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"::" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig)
mkHsExplicitListPV :: SrcSpan
-> [GenLocated SrcSpanAnnA (HsCmd GhcPs)]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsExplicitListPV SrcSpan
l [GenLocated SrcSpanAnnA (HsCmd GhcPs)]
xs AnnList
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ((GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsCmd GhcPs)] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (HsCmd GhcPs)]
xs)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
sp) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (Bool -> Maybe Name -> HsUntypedSplice GhcPs -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True Maybe Name
forall a. Maybe a
Nothing HsUntypedSplice GhcPs
sp)
mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> ([Fbind (HsCmd GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsRecordPV Bool
_ SrcSpan
l SrcSpan
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
a ([Fbind (HsCmd GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
_ = do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsCmd GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
fbinds
if Bool -> Bool
not ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
ps)
then MsgEnvelope PsMessage -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrOverloadedRecordDotInvalid
else SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([LocatedA
(HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Maybe SrcSpan
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (p :: Pass) arg.
[LocatedA (HsRecField (GhcPass p) arg)]
-> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields [LocatedA
(HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
fs Maybe SrcSpan
ddLoc)
mkHsNegAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsNegAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
a [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a)
mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (HsCmd GhcPs))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (HsCmd GhcPs))
op GenLocated SrcSpanAnnA (HsCmd GhcPs)
c = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
let pp_op :: SDoc
pp_op = SDoc -> Maybe SDoc -> SDoc
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc
forall a. HasCallStack => String -> a
panic String
"cannot print infix operator")
(HsExpr GhcPs -> Maybe SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsExpr (GhcPass p) -> Maybe SDoc
ppr_infix_expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
LocatedA (InfixOp (HsCmd GhcPs))
op))
in SDoc
pp_op SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a GenLocated SrcSpanAnnA (HsCmd GhcPs)
b [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"->" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
b
mkHsAsPatPV :: SrcSpan
-> LocatedN RdrName
-> EpToken "@"
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAsPatPV SrcSpan
l LocatedN RdrName
v EpToken "@"
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
c = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
v) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
mkHsLazyPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLazyPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
mkHsBangPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsBangPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"!" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkSumOrTuplePV SrcSpanAnnA
l Boxity
boxity SumOrTuple (HsCmd GhcPs)
a [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (Boxity -> SumOrTuple (HsCmd GhcPs) -> SDoc
forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple Boxity
boxity SumOrTuple (HsCmd GhcPs)
a)
mkHsEmbTyPV :: SrcSpan
-> EpToken "type"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsEmbTyPV SrcSpan
l EpToken "type"
_ LHsType GhcPs
ty = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
rejectPragmaPV :: GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
rejectPragmaPV GenLocated SrcSpanAnnA (HsCmd GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cmdFail :: SrcSpan -> SDoc -> PV a
cmdFail :: forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
loc SDoc
e = MsgEnvelope PsMessage -> PV a
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV a) -> MsgEnvelope PsMessage -> PV a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SDoc -> PsMessage
PsErrParseErrorInCmd SDoc
e
checkLamMatchGroup :: SrcSpan -> HsLamVariant -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup :: SrcSpan
-> HsLamVariant -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup SrcSpan
l HsLamVariant
LamSingle (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
matches:[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_))}) = do
Bool -> PV () -> PV ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LPat GhcPs]
forall (id :: Pass) body.
LMatch (GhcPass id) body -> [LPat (GhcPass id)]
hsLMatchPats LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
matches)) (PV () -> PV ()) -> PV () -> PV ()
forall a b. (a -> b) -> a -> b
$ MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrEmptyLambda
checkLamMatchGroup SrcSpan
_ HsLamVariant
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance DisambECP (HsExpr GhcPs) where
type Body (HsExpr GhcPs) = HsExpr
ecpFromCmd' :: LHsCmd GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ecpFromCmd' (L SrcSpanAnnA
l HsCmd GhcPs
c) = do
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ HsCmd GhcPs -> PsMessage
PsErrArrowCmdInExpr HsCmd GhcPs
c
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
ecpFromExp' :: LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ecpFromExp' = LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return
mkHsProjUpdatePV :: SrcSpan
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
fields GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
isPun [AddEpAnn]
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LHsRecProj GhcPs (LHsExpr GhcPs)
-> PV (LHsRecProj GhcPs (LHsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsRecProj GhcPs (LHsExpr GhcPs)
-> PV (LHsRecProj GhcPs (LHsExpr GhcPs)))
-> LHsRecProj GhcPs (LHsExpr GhcPs)
-> PV (LHsRecProj GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
fields LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
isPun [AddEpAnn]
anns
mkHsLetPV :: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLetPV SrcSpan
l EpToken "let"
tkLet HsLocalBinds GhcPs
bs EpToken "in"
tkIn GenLocated SrcSpanAnnA (HsExpr GhcPs)
c = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XLet GhcPs -> HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet (EpToken "let"
tkLet, EpToken "in"
tkIn) HsLocalBinds GhcPs
bs LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
c)
type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
superInfixOp :: (DisambInfixOp (InfixOp (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
superInfixOp DisambInfixOp (InfixOp (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
DisambInfixOp (InfixOp (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m
mkHsOpAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LocatedN (InfixOp (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsOpAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LocatedN (InfixOp (HsExpr GhcPs))
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2 = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp [] LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 (LocatedN (HsExpr GhcPs) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc LocatedN (HsExpr GhcPs)
LocatedN (InfixOp (HsExpr GhcPs))
op) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2
mkHsCasePV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> EpAnnHsCase
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsCasePV SrcSpan
l LHsExpr GhcPs
e (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
m) EpAnnHsCase
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg = Origin
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
FromSource (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
m)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XCase GhcPs
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcPs
EpAnnHsCase
anns LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg)
mkHsLamPV :: SrcSpan
-> HsLamVariant
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLamPV SrcSpan
l HsLamVariant
lam_variant (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
m) [AddEpAnn]
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg = Origin
-> HsLamVariant
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> HsLamVariant
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup Origin
FromSource HsLamVariant
lam_variant (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
m)
SrcSpan
-> HsLamVariant -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup SrcSpan
l HsLamVariant
lam_variant MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XLam GhcPs
-> HsLamVariant -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p.
XLam p -> HsLamVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam [AddEpAnn]
XLam GhcPs
anns HsLamVariant
lam_variant MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg)
type FunArg (HsExpr GhcPs) = HsExpr GhcPs
superFunArg :: (DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
superFunArg DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m
mkHsAppPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LocatedA (FunArg (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAppPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LocatedA (FunArg (HsExpr GhcPs))
e2 = do
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
LocatedA (FunArg (HsExpr GhcPs))
e2
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
NoExtField
noExtField LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LHsExpr GhcPs
LocatedA (FunArg (HsExpr GhcPs))
e2)
mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e EpToken "@"
at LHsType GhcPs
t = do
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XAppTypeE GhcPs
-> LHsExpr GhcPs -> LHsWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcPs
EpToken "@"
at LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> AnnsIf
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsIfPV SrcSpan
l LHsExpr GhcPs
c Bool
semi1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
b AnnsIf
anns = do
(HsExpr GhcPs
-> Bool -> HsExpr GhcPs -> Bool -> HsExpr GhcPs -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV ()
forall a b c.
(Outputable a, Outputable b, Outputable c) =>
(a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse HsExpr GhcPs
-> Bool -> HsExpr GhcPs -> Bool -> HsExpr GhcPs -> PsMessage
PsErrSemiColonsInCondExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
c Bool
semi1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
b
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> AnnsIf -> HsExpr GhcPs
mkHsIf LHsExpr GhcPs
c LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b AnnsIf
anns)
mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
mod LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts AnnList
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XDo GhcPs
-> HsDoFlavour -> XRec GhcPs [ExprLStmt GhcPs] -> HsExpr GhcPs
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
AnnList
anns (Maybe ModuleName -> HsDoFlavour
DoExpr Maybe ModuleName
mod) XRec GhcPs [ExprLStmt GhcPs]
LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts)
mkHsParPV :: SrcSpan
-> EpToken "("
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EpToken ")"
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsParPV SrcSpan
l EpToken "("
lpar GenLocated SrcSpanAnnA (HsExpr GhcPs)
e EpToken ")"
rpar = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar (EpToken "("
lpar, EpToken ")"
rpar) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
mkHsVarPV :: LocatedN RdrName -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsVarPV v :: LocatedN RdrName
v@(L l :: SrcSpanAnnN
l@(EpAnn EpaLocation
anc NameAnn
_ EpAnnComments
_) RdrName
_) = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc SrcSpanAnnN
l)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLitPV (L SrcSpan
l HsLit GhcPs
a) = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
NoExtField
noExtField HsLit GhcPs
a)
mkHsOverLitPV :: forall a.
LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
mkHsOverLitPV (L (EpAnn EpaLocation
l a
an EpAnnComments
csIn) HsOverLit GhcPs
a) = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (EpaLocation -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpaLocation
l)
LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs)))
-> LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn a -> HsExpr GhcPs -> LocatedAn a (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> a -> EpAnnComments -> EpAnn a
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
l a
an (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
csIn)) (XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcPs
NoExtField
NoExtField HsOverLit GhcPs
a)
mkHsWildCardPV :: forall a. NoAnn a => SrcSpan -> PV (LocatedAn a (HsExpr GhcPs))
mkHsWildCardPV SrcSpan
l = LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs)))
-> LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn a -> HsExpr GhcPs -> LocatedAn a (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnn a
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn)
mkHsTySigPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsTySigPV l :: SrcSpanAnnA
l@(EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
csIn) GenLocated SrcSpanAnnA (HsExpr GhcPs)
a LHsType GhcPs
sig [AddEpAnn]
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc AnnListItem
an (EpAnnComments
csIn EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs)) (XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig [AddEpAnn]
XExprWithTySig GhcPs
anns LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a (LHsType GhcPs -> LHsSigWcType GhcPs
hsTypeToHsSigWcType LHsType GhcPs
sig))
mkHsExplicitListPV :: SrcSpan
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsExplicitListPV SrcSpan
l [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs AnnList
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XExplicitList GhcPs -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
AnnList
anns [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
a) = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ (HsUntypedSplice GhcPs -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XUntypedSplice GhcPs -> HsUntypedSplice GhcPs -> HsExpr GhcPs
forall p. XUntypedSplice p -> HsUntypedSplice p -> HsExpr p
HsUntypedSplice XUntypedSplice GhcPs
NoExtField
NoExtField) (SrcSpanAnnA
-> HsUntypedSplice GhcPs
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) HsUntypedSplice GhcPs
a)
mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsRecordPV Bool
opts SrcSpan
l SrcSpan
lrec GenLocated SrcSpanAnnA (HsExpr GhcPs)
a ([Fbind (HsExpr GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
HsExpr GhcPs
r <- Bool
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate Bool
opts LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a SrcSpan
lrec ([Fbind (HsExpr GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
anns
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a.
(MonadP m, Outputable a) =>
LocatedA a -> m (LocatedA a)
checkRecordSyntax (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) HsExpr GhcPs
r)
mkHsNegAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsNegAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
a [AddEpAnn]
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XNegApp GhcPs -> LHsExpr GhcPs -> SyntaxExpr GhcPs -> HsExpr GhcPs
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp [AddEpAnn]
XNegApp GhcPs
anns LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr)
mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (HsExpr GhcPs))
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
e = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (XSectionR GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR GhcPs
NoExtField
noExtField LHsExpr GhcPs
LocatedA (InfixOp (HsExpr GhcPs))
op LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a GenLocated SrcSpanAnnA (HsExpr GhcPs)
b [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> PsMessage
PsErrViewPatInExpr LHsExpr GhcPs
a LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b)
PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkHsAsPatPV :: SrcSpan
-> LocatedN RdrName
-> EpToken "@"
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAsPatPV SrcSpan
l LocatedN RdrName
v EpToken "@"
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ RdrName -> LHsExpr GhcPs -> PsMessage
PsErrTypeAppWithoutSpace (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
v) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkHsLazyPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLazyPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> PsMessage
PsErrLazyPatWithoutSpace LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkHsBangPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsBangPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> PsMessage
PsErrBangPatWithoutSpace LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkSumOrTuplePV = SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkSumOrTupleExpr
mkHsEmbTyPV :: SrcSpan
-> EpToken "type"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsEmbTyPV SrcSpan
l EpToken "type"
toktype LHsType GhcPs
ty =
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
XEmbTy GhcPs -> LHsWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p. XEmbTy p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsEmbTy XEmbTy GhcPs
EpToken "type"
toktype (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
rejectPragmaPV :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
rejectPragmaPV (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
e)) =
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall b. DisambECP b => LocatedA b -> PV ()
rejectPragmaPV LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
rejectPragmaPV (L SrcSpanAnnA
l (HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag LHsExpr GhcPs
_)) = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsPragE GhcPs -> PsMessage
PsErrUnallowedPragma HsPragE GhcPs
prag)
rejectPragmaPV GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hsHoleExpr :: Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr :: Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
anns = XUnboundVar GhcPs -> RdrName -> HsExpr GhcPs
forall p. XUnboundVar p -> RdrName -> HsExpr p
HsUnboundVar Maybe EpAnnUnboundVar
XUnboundVar GhcPs
anns (OccName -> RdrName
mkRdrUnqual (FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"_")))
instance DisambECP (PatBuilder GhcPs) where
type Body (PatBuilder GhcPs) = PatBuilder
ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA (PatBuilder GhcPs))
ecpFromCmd' (L SrcSpanAnnA
l HsCmd GhcPs
c) = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ HsCmd GhcPs -> PsMessage
PsErrArrowCmdInPat HsCmd GhcPs
c
ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA (PatBuilder GhcPs))
ecpFromExp' (L SrcSpanAnnA
l HsExpr GhcPs
e) = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> PsMessage
PsErrArrowExprInPat HsExpr GhcPs
e
mkHsLetPV :: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLetPV SrcSpan
l EpToken "let"
_ HsLocalBinds GhcPs
_ EpToken "in"
_ LocatedA (PatBuilder GhcPs)
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrLetInPat
mkHsProjUpdatePV :: SrcSpan
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LocatedA (PatBuilder GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
_ LocatedA (PatBuilder GhcPs)
_ Bool
_ [AddEpAnn]
_ = MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs))))
-> MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrOverloadedRecordDotInvalid
type InfixOp (PatBuilder GhcPs) = RdrName
superInfixOp :: (DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs)))
-> PV (LocatedA (PatBuilder GhcPs))
superInfixOp DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m = PV (LocatedA (PatBuilder GhcPs))
DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m
mkHsOpAppPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> LocatedN (InfixOp (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsOpAppPV SrcSpan
l LocatedA (PatBuilder GhcPs)
p1 LocatedN (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p2 = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs))
-> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ LocatedA (PatBuilder GhcPs)
-> LocatedN RdrName
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p)
-> LocatedN RdrName
-> LocatedA (PatBuilder p)
-> [AddEpAnn]
-> PatBuilder p
PatBuilderOpApp LocatedA (PatBuilder GhcPs)
p1 LocatedN RdrName
LocatedN (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p2 []
mkHsLamPV :: SrcSpan
-> HsLamVariant
-> LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLamPV SrcSpan
l HsLamVariant
lam_variant LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
_ [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (HsLamVariant -> PsMessage
PsErrLambdaInPat HsLamVariant
lam_variant)
mkHsCasePV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
-> EpAnnHsCase
-> PV (LocatedA (PatBuilder GhcPs))
mkHsCasePV SrcSpan
l LHsExpr GhcPs
_ LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
_ EpAnnHsCase
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrCaseInPat
type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
superFunArg :: (DisambECP (FunArg (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs)))
-> PV (LocatedA (PatBuilder GhcPs))
superFunArg DisambECP (FunArg (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m = PV (LocatedA (PatBuilder GhcPs))
DisambECP (FunArg (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m
mkHsAppPV :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LocatedA (FunArg (PatBuilder GhcPs))
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAppPV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
p1 LocatedA (FunArg (PatBuilder GhcPs))
p2 = LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (LocatedA (PatBuilder GhcPs)
-> LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p) -> LocatedA (PatBuilder p) -> PatBuilder p
PatBuilderApp LocatedA (PatBuilder GhcPs)
p1 LocatedA (PatBuilder GhcPs)
LocatedA (FunArg (PatBuilder GhcPs))
p2)
mkHsAppTypePV :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAppTypePV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
p EpToken "@"
at LHsType GhcPs
t = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn SrcSpanAnnA
l EpAnnComments
cs) (LocatedA (PatBuilder GhcPs)
-> EpToken "@" -> HsTyPat GhcPs -> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p)
-> EpToken "@" -> HsTyPat GhcPs -> PatBuilder p
PatBuilderAppType LocatedA (PatBuilder GhcPs)
p EpToken "@"
at (LHsType GhcPs -> HsTyPat GhcPs
mkHsTyPat LHsType GhcPs
t))
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> LocatedA (PatBuilder GhcPs)
-> Bool
-> LocatedA (PatBuilder GhcPs)
-> AnnsIf
-> PV (LocatedA (PatBuilder GhcPs))
mkHsIfPV SrcSpan
l LHsExpr GhcPs
_ Bool
_ LocatedA (PatBuilder GhcPs)
_ Bool
_ LocatedA (PatBuilder GhcPs)
_ AnnsIf
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrIfThenElseInPat
mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (LocatedA (PatBuilder GhcPs))]
-> AnnList
-> PV (LocatedA (PatBuilder GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
_ LocatedL [LStmt GhcPs (LocatedA (PatBuilder GhcPs))]
_ AnnList
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrDoNotationInPat
mkHsParPV :: SrcSpan
-> EpToken "("
-> LocatedA (PatBuilder GhcPs)
-> EpToken ")"
-> PV (LocatedA (PatBuilder GhcPs))
mkHsParPV SrcSpan
l EpToken "("
lpar LocatedA (PatBuilder GhcPs)
p EpToken ")"
rpar = LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (EpToken "("
-> LocatedA (PatBuilder GhcPs) -> EpToken ")" -> PatBuilder GhcPs
forall p.
EpToken "("
-> LocatedA (PatBuilder p) -> EpToken ")" -> PatBuilder p
PatBuilderPar EpToken "("
lpar LocatedA (PatBuilder GhcPs)
p EpToken ")"
rpar)
mkHsVarPV :: LocatedN RdrName -> PV (LocatedA (PatBuilder GhcPs))
mkHsVarPV v :: LocatedN RdrName
v@(LocatedN RdrName -> SrcSpanAnnN
forall l e. GenLocated l e -> l
getLoc -> SrcSpanAnnN
l) = LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
l) (LocatedN RdrName -> PatBuilder GhcPs
forall p. LocatedN RdrName -> PatBuilder p
PatBuilderVar LocatedN RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
mkHsLitPV lit :: Located (HsLit GhcPs)
lit@(L SrcSpan
l HsLit GhcPs
a) = do
Located (HsLit GhcPs) -> PV ()
checkUnboxedLitPat Located (HsLit GhcPs)
lit
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XLitPat GhcPs -> HsLit GhcPs -> Pat GhcPs
forall p. XLitPat p -> HsLit p -> Pat p
LitPat XLitPat GhcPs
NoExtField
noExtField HsLit GhcPs
a))
mkHsOverLitPV :: forall a.
LocatedAn a (HsOverLit GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
mkHsOverLitPV (L EpAnn a
l HsOverLit GhcPs
a) = LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs)))
-> LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn a -> PatBuilder GhcPs -> LocatedAn a (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L EpAnn a
l (HsOverLit GhcPs -> PatBuilder GhcPs
forall p. HsOverLit GhcPs -> PatBuilder p
PatBuilderOverLit HsOverLit GhcPs
a)
mkHsWildCardPV :: forall a. NoAnn a => SrcSpan -> PV (LocatedAn a (PatBuilder GhcPs))
mkHsWildCardPV SrcSpan
l = LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs)))
-> LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn a -> PatBuilder GhcPs -> LocatedAn a (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnn a
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcPs
NoExtField
noExtField))
mkHsTySigPV :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsTySigPV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
b LHsType GhcPs
sig [AddEpAnn]
anns = do
GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
b
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XSigPat GhcPs
-> LPat GhcPs -> HsPatSigType (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat [AddEpAnn]
XSigPat GhcPs
anns LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p (EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnnCO
forall a. NoAnn a => a
noAnn LHsType GhcPs
sig)))
mkHsExplicitListPV :: SrcSpan
-> [LocatedA (PatBuilder GhcPs)]
-> AnnList
-> PV (LocatedA (PatBuilder GhcPs))
mkHsExplicitListPV SrcSpan
l [LocatedA (PatBuilder GhcPs)]
xs AnnList
anns = do
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps <- (LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [LocatedA (PatBuilder GhcPs)]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat [LocatedA (PatBuilder GhcPs)]
xs
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XListPat GhcPs -> [LPat GhcPs] -> Pat GhcPs
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat GhcPs
AnnList
anns [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps)))
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
sp) = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XSplicePat GhcPs -> HsUntypedSplice GhcPs -> Pat GhcPs
forall p. XSplicePat p -> HsUntypedSplice p -> Pat p
SplicePat XSplicePat GhcPs
NoExtField
noExtField HsUntypedSplice GhcPs
sp))
mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> ([Fbind (PatBuilder GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsRecordPV Bool
_ SrcSpan
l SrcSpan
_ LocatedA (PatBuilder GhcPs)
a ([Fbind (PatBuilder GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
anns = do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (PatBuilder GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs))))]
fbinds
if Bool -> Bool
not ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
ps)
then MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrOverloadedRecordDotInvalid
else do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
PatBuilder GhcPs
r <- LocatedA (PatBuilder GhcPs)
-> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
-> [AddEpAnn]
-> PV (PatBuilder GhcPs)
mkPatRec LocatedA (PatBuilder GhcPs)
a ([LocatedA (HsRecField GhcPs (LocatedA (PatBuilder GhcPs)))]
-> Maybe SrcSpan -> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
forall (p :: Pass) arg.
[LocatedA (HsRecField (GhcPass p) arg)]
-> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields [LocatedA (HsRecField GhcPs (LocatedA (PatBuilder GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
fs Maybe SrcSpan
ddLoc) [AddEpAnn]
anns
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a.
(MonadP m, Outputable a) =>
LocatedA a -> m (LocatedA a)
checkRecordSyntax (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) PatBuilder GhcPs
r)
mkHsNegAppPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsNegAppPV SrcSpan
l (L SrcSpanAnnA
lp PatBuilder GhcPs
p) [AddEpAnn]
anns = do
LocatedAn NoEpAnns (HsOverLit GhcPs)
lit <- case PatBuilder GhcPs
p of
PatBuilderOverLit HsOverLit GhcPs
pos_lit -> LocatedAn NoEpAnns (HsOverLit GhcPs)
-> PV (LocatedAn NoEpAnns (HsOverLit GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnnCO -> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
lp) HsOverLit GhcPs
pos_lit)
PatBuilder GhcPs
_ -> SrcSpan -> PsMessage -> PV (LocatedAn NoEpAnns (HsOverLit GhcPs))
forall a. SrcSpan -> PsMessage -> PV a
patFail SrcSpan
l (PsMessage -> PV (LocatedAn NoEpAnns (HsOverLit GhcPs)))
-> PsMessage -> PV (LocatedAn NoEpAnns (HsOverLit GhcPs))
forall a b. (a -> b) -> a -> b
$ PatBuilder GhcPs -> PsErrInPatDetails -> PsMessage
PsErrInPat PatBuilder GhcPs
p PsErrInPatDetails
PEIP_NegApp
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (LocatedAn NoEpAnns (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs) -> [AddEpAnn] -> Pat GhcPs
mkNPat LocatedAn NoEpAnns (HsOverLit GhcPs)
lit (NoExtField -> Maybe NoExtField
forall a. a -> Maybe a
Just NoExtField
SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr) [AddEpAnn]
anns))
mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p = SrcSpan -> PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. SrcSpan -> PsMessage -> PV a
patFail SrcSpan
l (RdrName -> PatBuilder GhcPs -> PsMessage
PsErrParseRightOpSectionInPat (GenLocated SrcSpanAnnA RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA RdrName
LocatedA (InfixOp (PatBuilder GhcPs))
op) (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (PatBuilder GhcPs)
p))
mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a LocatedA (PatBuilder GhcPs)
b [AddEpAnn]
anns = do
GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
b
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XViewPat GhcPs -> LHsExpr GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat [AddEpAnn]
XViewPat GhcPs
anns LHsExpr GhcPs
a LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p))
mkHsAsPatPV :: SrcSpan
-> LocatedN RdrName
-> EpToken "@"
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAsPatPV SrcSpan
l LocatedN RdrName
v EpToken "@"
at LocatedA (PatBuilder GhcPs)
e = do
GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XAsPat GhcPs -> XRec GhcPs (IdP GhcPs) -> LPat GhcPs -> Pat GhcPs
forall p. XAsPat p -> LIdP p -> LPat p -> Pat p
AsPat XAsPat GhcPs
EpToken "@"
at XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p))
mkHsLazyPatPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLazyPatPV SrcSpan
l LocatedA (PatBuilder GhcPs)
e [AddEpAnn]
a = do
GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XLazyPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XLazyPat p -> LPat p -> Pat p
LazyPat [AddEpAnn]
XLazyPat GhcPs
a LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p))
mkHsBangPatPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsBangPatPV SrcSpan
l LocatedA (PatBuilder GhcPs)
e [AddEpAnn]
an = do
GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let pb :: Pat GhcPs
pb = XBangPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XBangPat p -> LPat p -> Pat p
BangPat [AddEpAnn]
XBangPat GhcPs
an LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p
SrcSpan -> Pat GhcPs -> PV ()
hintBangPat SrcSpan
l Pat GhcPs
pb
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat Pat GhcPs
pb)
mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePV = SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat
mkHsEmbTyPV :: SrcSpan
-> EpToken "type"
-> LHsType GhcPs
-> PV (LocatedA (PatBuilder GhcPs))
mkHsEmbTyPV SrcSpan
l EpToken "type"
toktype LHsType GhcPs
ty =
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs))
-> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$
Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XEmbTyPat GhcPs -> HsTyPat (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XEmbTyPat p -> HsTyPat (NoGhcTc p) -> Pat p
EmbTyPat XEmbTyPat GhcPs
EpToken "type"
toktype (LHsType GhcPs -> HsTyPat GhcPs
mkHsTyPat LHsType GhcPs
ty))
rejectPragmaPV :: LocatedA (PatBuilder GhcPs) -> PV ()
rejectPragmaPV LocatedA (PatBuilder GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkUnboxedLitPat :: Located (HsLit GhcPs) -> PV ()
checkUnboxedLitPat :: Located (HsLit GhcPs) -> PV ()
checkUnboxedLitPat (L SrcSpan
loc HsLit GhcPs
lit) =
case HsLit GhcPs
lit of
HsStringPrim {}
-> MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsLit GhcPs -> PsMessage
PsErrIllegalUnboxedStringInPat HsLit GhcPs
lit)
HsLit GhcPs
_ | HsLit GhcPs -> Bool
is_floating_lit HsLit GhcPs
lit
-> MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsLit GhcPs -> PsMessage
PsErrIllegalUnboxedFloatingLitInPat HsLit GhcPs
lit)
| Bool
otherwise
-> () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
is_floating_lit :: HsLit GhcPs -> Bool
is_floating_lit :: HsLit GhcPs -> Bool
is_floating_lit (HsFloatPrim {}) = Bool
True
is_floating_lit (HsDoublePrim {}) = Bool
True
is_floating_lit HsLit GhcPs
_ = Bool
False
mkPatRec ::
LocatedA (PatBuilder GhcPs) ->
HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) ->
[AddEpAnn] ->
PV (PatBuilder GhcPs)
mkPatRec :: LocatedA (PatBuilder GhcPs)
-> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
-> [AddEpAnn]
-> PV (PatBuilder GhcPs)
mkPatRec (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc -> PatBuilderVar LocatedN RdrName
c) (HsRecFields [LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
fs Maybe (XRec GhcPs RecFieldsDotDot)
dd) [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
c)
= do [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fs <- (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
-> PV
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
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 LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
checkPatField [LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
fs
PatBuilder GhcPs -> PV (PatBuilder GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatBuilder GhcPs -> PV (PatBuilder GhcPs))
-> PatBuilder GhcPs -> PV (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (Pat GhcPs -> PatBuilder GhcPs) -> Pat GhcPs -> PatBuilder GhcPs
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = [AddEpAnn]
XConPat GhcPs
anns
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
c
, pat_args :: HsConPatDetails GhcPs
pat_args = HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> HsConDetails
(HsConPatTyArg GhcPs)
(GenLocated SrcSpanAnnA (Pat GhcPs))
(HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon ([LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> Maybe (XRec GhcPs RecFieldsDotDot)
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
forall p arg.
[LHsRecField p arg]
-> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
HsRecFields [LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fs Maybe (XRec GhcPs RecFieldsDotDot)
dd)
}
mkPatRec LocatedA (PatBuilder GhcPs)
p HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
_ [AddEpAnn]
_ =
MsgEnvelope PsMessage -> PV (PatBuilder GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (PatBuilder GhcPs))
-> MsgEnvelope PsMessage -> PV (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (LocatedA (PatBuilder GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedA (PatBuilder GhcPs)
p) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(PatBuilder GhcPs -> PsMessage
PsErrInvalidRecordCon (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (PatBuilder GhcPs)
p))
class DisambTD b where
mkHsAppTyHeadPV :: LHsType GhcPs -> PV (LocatedA b)
mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b)
mkHsAppKindTyPV :: LocatedA b -> EpToken "@" -> LHsType GhcPs -> PV (LocatedA b)
mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
mkUnpackednessPV :: Located UnpackednessPragma -> LocatedA b -> PV (LocatedA b)
instance DisambTD (HsType GhcPs) where
mkHsAppTyHeadPV :: LHsType GhcPs -> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppTyHeadPV = LHsType GhcPs -> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return
mkHsAppTyPV :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> LHsType GhcPs -> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppTyPV GenLocated SrcSpanAnnA (HsType GhcPs)
t1 LHsType GhcPs
t2 = GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1 LHsType GhcPs
t2)
mkHsAppKindTyPV :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppKindTyPV GenLocated SrcSpanAnnA (HsType GhcPs)
t EpToken "@"
at LHsType GhcPs
ki = GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppKindTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
XAppKindTy (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
mkHsAppKindTy XAppKindTy GhcPs
EpToken "@"
at LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t LHsType GhcPs
ki)
mkHsOpTyPV :: PromotionFlag
-> LHsType GhcPs
-> LocatedN RdrName
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsOpTyPV PromotionFlag
prom LHsType GhcPs
t1 LocatedN RdrName
op LHsType GhcPs
t2 = do
let (L SrcSpanAnnA
l HsType GhcPs
ty) = PromotionFlag
-> LHsType GhcPs
-> LocatedN RdrName
-> LHsType GhcPs
-> LHsType GhcPs
mkLHsOpTy PromotionFlag
prom LHsType GhcPs
t1 LocatedN RdrName
op LHsType GhcPs
t2
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn SrcSpanAnnA
l EpAnnComments
cs) HsType GhcPs
ty)
mkUnpackednessPV :: Located UnpackednessPragma
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkUnpackednessPV = Located UnpackednessPragma -> LHsType GhcPs -> PV (LHsType GhcPs)
Located UnpackednessPragma
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *).
MonadP m =>
Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP
dataConBuilderCon :: LocatedA DataConBuilder -> LocatedN RdrName
dataConBuilderCon :: LocatedA DataConBuilder -> LocatedN RdrName
dataConBuilderCon (L SrcSpanAnnA
_ (PrefixDataConBuilder OrdList (LHsType GhcPs)
_ LocatedN RdrName
dc)) = LocatedN RdrName
dc
dataConBuilderCon (L SrcSpanAnnA
_ (InfixDataConBuilder LHsType GhcPs
_ LocatedN RdrName
dc LHsType GhcPs
_)) = LocatedN RdrName
dc
dataConBuilderDetails :: LocatedA DataConBuilder -> HsConDeclH98Details GhcPs
dataConBuilderDetails :: LocatedA DataConBuilder -> HsConDeclH98Details GhcPs
dataConBuilderDetails (L SrcSpanAnnA
_ (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds LocatedN RdrName
_))
| [L (EpAnn EpaLocation
anc AnnListItem
_ EpAnnComments
cs) (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
fields)] <- OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. OrdList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrdList (LHsType GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
flds
= GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon (SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc XRecTy GhcPs
AnnList
an EpAnnComments
cs) [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields)
dataConBuilderDetails (L SrcSpanAnnA
_ (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds LocatedN RdrName
_))
= [Void]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs ((GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear (OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. OrdList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrdList (LHsType GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
flds))
dataConBuilderDetails (L (EpAnn EpaLocation
_ AnnListItem
_ EpAnnComments
csl) (InfixDataConBuilder (L (EpAnn EpaLocation
anc AnnListItem
ann EpAnnComments
csll) HsType GhcPs
lhs) LocatedN RdrName
_ LHsType GhcPs
rhs))
= HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc AnnListItem
ann (EpAnnComments
csl EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
csll)) HsType GhcPs
lhs)) (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs)
instance DisambTD DataConBuilder where
mkHsAppTyHeadPV :: LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppTyHeadPV = LHsType GhcPs -> PV (LocatedA DataConBuilder)
tyToDataConBuilder
mkHsAppTyPV :: LocatedA DataConBuilder
-> LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppTyPV (L SrcSpanAnnA
l (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds LocatedN RdrName
fn)) LHsType GhcPs
t =
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$
SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
(OrdList (LHsType GhcPs) -> LocatedN RdrName -> DataConBuilder
PrefixDataConBuilder (OrdList (LHsType GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
flds OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. OrdList a -> a -> OrdList a
`snocOL` LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t) LocatedN RdrName
fn)
mkHsAppTyPV (L SrcSpanAnnA
_ InfixDataConBuilder{}) LHsType GhcPs
_ =
String -> PV (LocatedA DataConBuilder)
forall a. HasCallStack => String -> a
panic String
"mkHsAppTyPV: InfixDataConBuilder"
mkHsAppKindTyPV :: LocatedA DataConBuilder
-> EpToken "@" -> LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppKindTyPV LocatedA DataConBuilder
lhs EpToken "@"
at LHsType GhcPs
ki =
MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder))
-> MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (EpToken "@" -> SrcSpan
forall (tok :: Symbol). EpToken tok -> SrcSpan
getEpTokenSrcSpan EpToken "@"
at) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(DataConBuilder -> HsType GhcPs -> PsMessage
PsErrUnexpectedKindAppInDataCon (LocatedA DataConBuilder -> DataConBuilder
forall l e. GenLocated l e -> e
unLoc LocatedA DataConBuilder
lhs) (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki))
mkHsOpTyPV :: PromotionFlag
-> LHsType GhcPs
-> LocatedN RdrName
-> LHsType GhcPs
-> PV (LocatedA DataConBuilder)
mkHsOpTyPV PromotionFlag
prom LHsType GhcPs
lhs LocatedN RdrName
tc LHsType GhcPs
rhs = do
HsType GhcPs -> PV ()
check_no_ops (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs)
LocatedN RdrName
data_con <- Either (MsgEnvelope PsMessage) (LocatedN RdrName)
-> PV (LocatedN RdrName)
forall (m :: * -> *) a.
MonadP m =>
Either (MsgEnvelope PsMessage) a -> m a
eitherToP (Either (MsgEnvelope PsMessage) (LocatedN RdrName)
-> PV (LocatedN RdrName))
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
-> PV (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
tyConToDataCon LocatedN RdrName
tc
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
PromotionFlag -> LocatedN RdrName -> PV ()
checkNotPromotedDataCon PromotionFlag
prom LocatedN RdrName
data_con
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn SrcSpanAnnA
l EpAnnComments
cs) (LHsType GhcPs
-> LocatedN RdrName -> LHsType GhcPs -> DataConBuilder
InfixDataConBuilder LHsType GhcPs
lhs LocatedN RdrName
data_con LHsType GhcPs
rhs)
where
l :: SrcSpanAnnA
l = GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs
check_no_ops :: HsType GhcPs -> PV ()
check_no_ops (HsBangTy XBangTy GhcPs
_ HsSrcBang
_ LHsType GhcPs
t) = HsType GhcPs -> PV ()
check_no_ops (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t)
check_no_ops (HsOpTy{}) =
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsType GhcPs -> RdrName -> HsType GhcPs -> PsMessage
PsErrInvalidInfixDataCon (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs) (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
tc) (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs))
check_no_ops HsType GhcPs
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mkUnpackednessPV :: Located UnpackednessPragma
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
mkUnpackednessPV Located UnpackednessPragma
unpk LocatedA DataConBuilder
constr_stuff
| L SrcSpanAnnA
_ (InfixDataConBuilder LHsType GhcPs
lhs LocatedN RdrName
data_con LHsType GhcPs
rhs) <- LocatedA DataConBuilder
constr_stuff
=
do GenLocated SrcSpanAnnA (HsType GhcPs)
lhs' <- Located UnpackednessPragma -> LHsType GhcPs -> PV (LHsType GhcPs)
forall (m :: * -> *).
MonadP m =>
Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP Located UnpackednessPragma
unpk LHsType GhcPs
lhs
let l :: SrcSpanAnnA
l = GenLocated SrcSpanAnnA UnpackednessPragma
-> LocatedA DataConBuilder -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA (Located UnpackednessPragma
-> GenLocated SrcSpanAnnA UnpackednessPragma
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc Located UnpackednessPragma
unpk) LocatedA DataConBuilder
constr_stuff
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (LHsType GhcPs
-> LocatedN RdrName -> LHsType GhcPs -> DataConBuilder
InfixDataConBuilder LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs' LocatedN RdrName
data_con LHsType GhcPs
rhs)
| Bool
otherwise =
do MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (Located UnpackednessPragma -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located UnpackednessPragma
unpk) PsMessage
PsErrUnpackDataCon
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA DataConBuilder
constr_stuff
tyToDataConBuilder :: LHsType GhcPs -> PV (LocatedA DataConBuilder)
tyToDataConBuilder :: LHsType GhcPs -> PV (LocatedA DataConBuilder)
tyToDataConBuilder (L SrcSpanAnnA
l (HsTyVar XTyVar GhcPs
_ PromotionFlag
prom XRec GhcPs (IdP GhcPs)
v)) = do
LocatedN RdrName
data_con <- Either (MsgEnvelope PsMessage) (LocatedN RdrName)
-> PV (LocatedN RdrName)
forall (m :: * -> *) a.
MonadP m =>
Either (MsgEnvelope PsMessage) a -> m a
eitherToP (Either (MsgEnvelope PsMessage) (LocatedN RdrName)
-> PV (LocatedN RdrName))
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
-> PV (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName
-> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
tyConToDataCon XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v
PromotionFlag -> LocatedN RdrName -> PV ()
checkNotPromotedDataCon PromotionFlag
prom LocatedN RdrName
data_con
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (OrdList (LHsType GhcPs) -> LocatedN RdrName -> DataConBuilder
PrefixDataConBuilder OrdList (LHsType GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. OrdList a
nilOL LocatedN RdrName
data_con)
tyToDataConBuilder (L SrcSpanAnnA
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts)) = do
let data_con :: LocatedN RdrName
data_con = SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> DataCon
tupleDataCon Boxity
Boxed ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts)))
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (OrdList (LHsType GhcPs) -> LocatedN RdrName -> DataConBuilder
PrefixDataConBuilder ([GenLocated SrcSpanAnnA (HsType GhcPs)]
-> OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. [a] -> OrdList a
toOL [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts) LocatedN RdrName
data_con)
tyToDataConBuilder (L SrcSpanAnnA
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsUnboxedTuple [LHsType GhcPs]
ts)) = do
let data_con :: LocatedN RdrName
data_con = SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> DataCon
tupleDataCon Boxity
Unboxed ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts)))
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (OrdList (LHsType GhcPs) -> LocatedN RdrName -> DataConBuilder
PrefixDataConBuilder ([GenLocated SrcSpanAnnA (HsType GhcPs)]
-> OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. [a] -> OrdList a
toOL [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts) LocatedN RdrName
data_con)
tyToDataConBuilder LHsType GhcPs
t =
MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder))
-> MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsType GhcPs -> PsMessage
PsErrInvalidDataCon (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
checkNotPromotedDataCon :: PromotionFlag -> LocatedN RdrName -> PV ()
checkNotPromotedDataCon :: PromotionFlag -> LocatedN RdrName -> PV ()
checkNotPromotedDataCon PromotionFlag
NotPromoted LocatedN RdrName
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkNotPromotedDataCon PromotionFlag
IsPromoted (L SrcSpanAnnN
l RdrName
name) =
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
RdrName -> PsMessage
PsErrIllegalPromotionQuoteDataCon RdrName
name
mkUnboxedSumCon :: LHsType GhcPs -> ConTag -> Arity -> (LocatedN RdrName, HsConDeclH98Details GhcPs)
mkUnboxedSumCon :: LHsType GhcPs
-> Int -> Int -> (LocatedN RdrName, HsConDeclH98Details GhcPs)
mkUnboxedSumCon LHsType GhcPs
t Int
tag Int
arity =
(RdrName -> LocatedN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Int -> Int -> DataCon
sumDataCon Int
tag Int
arity)), [Void]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs [GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t])
checkPrecP
:: Located (SourceText,Int)
-> Located (OrdList (LocatedN RdrName))
-> P ()
checkPrecP :: Located (SourceText, Int)
-> Located (OrdList (LocatedN RdrName)) -> P ()
checkPrecP (L SrcSpan
l (SourceText
_,Int
i)) (L SrcSpan
_ OrdList (LocatedN RdrName)
ol)
| Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxPrecedence = () -> P ()
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| (LocatedN RdrName -> Bool) -> OrdList (LocatedN RdrName) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LocatedN RdrName -> Bool
forall {l}. GenLocated l RdrName -> Bool
specialOp OrdList (LocatedN RdrName)
ol = () -> P ()
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = MsgEnvelope PsMessage -> P ()
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (Int -> PsMessage
PsErrPrecedenceOutOfRange Int
i)
where
specialOp :: GenLocated l RdrName -> Bool
specialOp GenLocated l RdrName
op = GenLocated l RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated l RdrName
op RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
unrestrictedFunTyCon
mkRecConstrOrUpdate
:: Bool
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate :: Bool
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate Bool
_ (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
l RdrName
c))) SrcSpan
_lrec ([Fbind (HsExpr GhcPs)]
fbinds,Maybe SrcSpan
dd) [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon RdrName
c
= do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsExpr GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
fbinds
case [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps of
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p:[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrOverloadedRecordDotInvalid
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN RdrName
-> HsRecordBinds GhcPs -> [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
c) ([LocatedA
(HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Maybe SrcSpan
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) arg.
[LocatedA (HsRecField (GhcPass p) arg)]
-> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields [LocatedA
(HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs Maybe SrcSpan
dd) [AddEpAnn]
anns)
mkRecConstrOrUpdate Bool
overloaded_update LHsExpr GhcPs
exp SrcSpan
_ ([Fbind (HsExpr GhcPs)]
fs,Maybe SrcSpan
dd) [AddEpAnn]
anns
| Just SrcSpan
dd_loc <- Maybe SrcSpan
dd = MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
dd_loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrDotsInRecordUpdate
| Bool
otherwise = Bool
-> LHsExpr GhcPs
-> [Fbind (HsExpr GhcPs)]
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_update LHsExpr GhcPs
exp [Fbind (HsExpr GhcPs)]
fs [AddEpAnn]
anns
mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> [AddEpAnn] -> PV (HsExpr GhcPs)
mkRdrRecordUpd :: Bool
-> LHsExpr GhcPs
-> [Fbind (HsExpr GhcPs)]
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_on exp :: LHsExpr GhcPs
exp@(L SrcSpanAnnA
loc HsExpr GhcPs
_) [Fbind (HsExpr GhcPs)]
fbinds [AddEpAnn]
anns = do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsExpr GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
fbinds
fs' :: [LHsRecUpdField GhcPs GhcPs]
fs' :: [LHsRecUpdField GhcPs GhcPs]
fs' = (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map ((HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
mk_rec_upd_field) [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs
case Bool
overloaded_on of
Bool
False | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps ->
MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) PsMessage
PsErrOverloadedRecordUpdateNotEnabled
Bool
False ->
HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return RecordUpd {
rupd_ext :: XRecordUpd GhcPs
rupd_ext = [AddEpAnn]
XRecordUpd GhcPs
anns
, rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
, rupd_flds :: LHsRecUpdFields GhcPs
rupd_flds =
RegularRecUpdFields
{ xRecUpdFields :: XLHsRecUpdLabels GhcPs
xRecUpdFields = XLHsRecUpdLabels GhcPs
NoExtField
noExtField
, recUpdFields :: [LHsRecUpdField GhcPs GhcPs]
recUpdFields = [LHsRecUpdField GhcPs GhcPs]
fs' } }
Bool
True -> do
let qualifiedFields :: [GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
qualifiedFields =
[ SrcSpanAnnA
-> AmbiguousFieldOcc GhcPs
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l AmbiguousFieldOcc GhcPs
lbl | L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
_ (L SrcSpanAnnA
l AmbiguousFieldOcc GhcPs
lbl) GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ Bool
_) <- [LHsRecUpdField GhcPs GhcPs]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs'
, RdrName -> Bool
isQual (RdrName -> Bool)
-> (AmbiguousFieldOcc GhcPs -> RdrName)
-> AmbiguousFieldOcc GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousFieldOcc GhcPs -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName (AmbiguousFieldOcc GhcPs -> Bool)
-> AmbiguousFieldOcc GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc GhcPs
lbl
]
case [GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
qualifiedFields of
GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
qf:[GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
_ -> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
qf) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields
[GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
_ -> HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> PV (HsExpr GhcPs))
-> HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
RecordUpd
{ rupd_ext :: XRecordUpd GhcPs
rupd_ext = [AddEpAnn]
XRecordUpd GhcPs
anns
, rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
, rupd_flds :: LHsRecUpdFields GhcPs
rupd_flds =
OverloadedRecUpdFields
{ xOLRecUpdFields :: XLHsOLRecUpdLabels GhcPs
xOLRecUpdFields = XLHsOLRecUpdLabels GhcPs
NoExtField
noExtField
, olRecUpdFields :: [LHsRecProj GhcPs (LHsExpr GhcPs)]
olRecUpdFields = [Fbind (HsExpr GhcPs)] -> [LHsRecProj GhcPs (LHsExpr GhcPs)]
toProjUpdates [Fbind (HsExpr GhcPs)]
fbinds } }
where
toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdProj GhcPs]
toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecProj GhcPs (LHsExpr GhcPs)]
toProjUpdates = (Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (\case { Right GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p -> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p; Left GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
f -> LHsRecField GhcPs (LHsExpr GhcPs)
-> LHsRecProj GhcPs (LHsExpr GhcPs)
recFieldToProjUpdate LHsRecField GhcPs (LHsExpr GhcPs)
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
f })
recFieldToProjUpdate :: LHsRecField GhcPs (LHsExpr GhcPs) -> LHsRecUpdProj GhcPs
recFieldToProjUpdate :: LHsRecField GhcPs (LHsExpr GhcPs)
-> LHsRecProj GhcPs (LHsExpr GhcPs)
recFieldToProjUpdate (L SrcSpanAnnA
l (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
anns (L SrcSpanAnnA
_ (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpanAnnN
loc RdrName
rdr))) GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
pun)) =
let f :: FastString
f = OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> FastString) -> RdrName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName
rdr
fl :: DotFieldOcc GhcPs
fl = XCDotFieldOcc GhcPs
-> XRec GhcPs FieldLabelString -> DotFieldOcc GhcPs
forall p.
XCDotFieldOcc p -> XRec p FieldLabelString -> DotFieldOcc p
DotFieldOcc XCDotFieldOcc GhcPs
AnnFieldLabel
forall a. NoAnn a => a
noAnn (SrcSpanAnnN
-> FieldLabelString -> GenLocated SrcSpanAnnN FieldLabelString
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc (FastString -> FieldLabelString
FieldLabelString FastString
f))
lf :: SrcSpan
lf = SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc
in SrcSpanAnnA
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate SrcSpanAnnA
l (SrcSpan
-> [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
lf [EpAnnCO
-> DotFieldOcc GhcPs -> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
loc) DotFieldOcc GhcPs
fl]) (FastString -> LHsExpr GhcPs
punnedVar FastString
f) Bool
pun [AddEpAnn]
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
anns
where
punnedVar :: FastString -> LHsExpr GhcPs
punnedVar :: FastString -> LHsExpr GhcPs
punnedVar FastString
f = if Bool -> Bool
not Bool
pun then LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg else HsExpr GhcPs -> LHsExpr GhcPs
HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (HsExpr GhcPs -> LHsExpr GhcPs)
-> (FastString -> HsExpr GhcPs) -> FastString -> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField (LocatedN RdrName -> HsExpr GhcPs)
-> (FastString -> LocatedN RdrName) -> FastString -> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> LocatedN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (RdrName -> LocatedN RdrName)
-> (FastString -> RdrName) -> FastString -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName)
-> (FastString -> OccName) -> FastString -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> OccName
mkVarOccFS (FastString -> LHsExpr GhcPs) -> FastString -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ FastString
f
mkRdrRecordCon
:: LocatedN RdrName -> HsRecordBinds GhcPs -> [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon :: LocatedN RdrName
-> HsRecordBinds GhcPs -> [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon LocatedN RdrName
con HsRecordBinds GhcPs
flds [AddEpAnn]
anns
= RecordCon { rcon_ext :: XRecordCon GhcPs
rcon_ext = [AddEpAnn]
XRecordCon GhcPs
anns, rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_con = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con, rcon_flds :: HsRecordBinds GhcPs
rcon_flds = HsRecordBinds GhcPs
flds }
mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields :: forall (p :: Pass) arg.
[LocatedA (HsRecField (GhcPass p) arg)]
-> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields [LocatedA (HsRecField (GhcPass p) arg)]
fs Maybe SrcSpan
Nothing = HsRecFields { rec_flds :: [LHsRecField (GhcPass p) arg]
rec_flds = [LHsRecField (GhcPass p) arg]
[LocatedA (HsRecField (GhcPass p) arg)]
fs, rec_dotdot :: Maybe (XRec (GhcPass p) RecFieldsDotDot)
rec_dotdot = Maybe (XRec (GhcPass p) RecFieldsDotDot)
Maybe (LocatedE RecFieldsDotDot)
forall a. Maybe a
Nothing }
mk_rec_fields [LocatedA (HsRecField (GhcPass p) arg)]
fs (Just SrcSpan
s) = HsRecFields { rec_flds :: [LHsRecField (GhcPass p) arg]
rec_flds = [LHsRecField (GhcPass p) arg]
[LocatedA (HsRecField (GhcPass p) arg)]
fs
, rec_dotdot :: Maybe (XRec (GhcPass p) RecFieldsDotDot)
rec_dotdot = LocatedE RecFieldsDotDot -> Maybe (LocatedE RecFieldsDotDot)
forall a. a -> Maybe a
Just (EpaLocation -> RecFieldsDotDot -> LocatedE RecFieldsDotDot
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
s) (Int -> RecFieldsDotDot
RecFieldsDotDot (Int -> RecFieldsDotDot) -> Int -> RecFieldsDotDot
forall a b. (a -> b) -> a -> b
$ [LocatedA
(HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) arg)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocatedA (HsRecField (GhcPass p) arg)]
[LocatedA
(HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) arg)]
fs)) }
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
mk_rec_upd_field (HsFieldBind XHsFieldBind (LFieldOcc GhcPs)
noAnn (L SrcSpanAnnA
loc (FieldOcc XCFieldOcc GhcPs
_ XRec GhcPs RdrName
rdr)) LHsExpr GhcPs
arg Bool
pun)
= XHsFieldBind (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall lhs rhs.
XHsFieldBind lhs -> lhs -> rhs -> Bool -> HsFieldBind lhs rhs
HsFieldBind XHsFieldBind (LFieldOcc GhcPs)
XHsFieldBind (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
noAnn (SrcSpanAnnA
-> AmbiguousFieldOcc GhcPs
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XUnambiguous GhcPs -> XRec GhcPs RdrName -> AmbiguousFieldOcc GhcPs
forall pass.
XUnambiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
Unambiguous XUnambiguous GhcPs
NoExtField
noExtField XRec GhcPs RdrName
rdr)) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
pun
mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
-> InlinePragma
mkInlinePragma :: SourceText
-> (InlineSpec, RuleMatchInfo) -> Maybe Activation -> InlinePragma
mkInlinePragma SourceText
src (InlineSpec
inl, RuleMatchInfo
match_info) Maybe Activation
mb_act
= InlinePragma { inl_src :: SourceText
inl_src = SourceText
src
, inl_inline :: InlineSpec
inl_inline = InlineSpec
inl
, inl_sat :: Maybe Int
inl_sat = Maybe Int
forall a. Maybe a
Nothing
, inl_act :: Activation
inl_act = Activation
act
, inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
match_info }
where
act :: Activation
act = case Maybe Activation
mb_act of
Just Activation
act -> Activation
act
Maybe Activation
Nothing ->
case InlineSpec
inl of
NoInline SourceText
_ -> Activation
NeverActive
Opaque SourceText
_ -> Activation
NeverActive
InlineSpec
_other -> Activation
AlwaysActive
mkOpaquePragma :: SourceText -> InlinePragma
mkOpaquePragma :: SourceText -> InlinePragma
mkOpaquePragma SourceText
src
= InlinePragma { inl_src :: SourceText
inl_src = SourceText
src
, inl_inline :: InlineSpec
inl_inline = SourceText -> InlineSpec
Opaque SourceText
src
, inl_sat :: Maybe Int
inl_sat = Maybe Int
forall a. Maybe a
Nothing
, inl_act :: Activation
inl_act = Activation
NeverActive
, inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
FunLike
}
checkNewOrData :: SrcSpan -> RdrName -> Bool -> NewOrData -> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData :: SrcSpan
-> RdrName
-> Bool
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData SrcSpan
span RdrName
name Bool
is_type_data = ((NewOrData, [LConDecl GhcPs])
-> P (DataDefnCons (LConDecl GhcPs)))
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((NewOrData, [LConDecl GhcPs])
-> P (DataDefnCons (LConDecl GhcPs)))
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs)))
-> ((NewOrData, [LConDecl GhcPs])
-> P (DataDefnCons (LConDecl GhcPs)))
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ \ case
(NewOrData
NewType, [LConDecl GhcPs
a]) -> DataDefnCons (LConDecl GhcPs) -> P (DataDefnCons (LConDecl GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. a -> DataDefnCons a
NewTypeCon LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
a
(NewOrData
DataType, [LConDecl GhcPs]
as) -> DataDefnCons (LConDecl GhcPs) -> P (DataDefnCons (LConDecl GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Bool
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. Bool -> [a] -> DataDefnCons a
DataTypeCons Bool
is_type_data ([GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
handle_type_data [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
as)
(NewOrData
NewType, [LConDecl GhcPs]
as) -> MsgEnvelope PsMessage -> P (DataDefnCons (LConDecl GhcPs))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (DataDefnCons (LConDecl GhcPs)))
-> MsgEnvelope PsMessage -> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
span (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ RdrName -> Int -> PsMessage
PsErrMultipleConForNewtype RdrName
name ([GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
as)
where
handle_type_data :: [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
handle_type_data
| Bool
is_type_data = (GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((ConDecl GhcPs -> ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConDecl GhcPs -> ConDecl GhcPs
forall {pass} {f :: * -> *}.
(XRec pass (IdP pass) ~ f RdrName, Functor f) =>
ConDecl pass -> ConDecl pass
promote_constructor)
| Bool
otherwise = [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall a. a -> a
id
promote_constructor :: ConDecl pass -> ConDecl pass
promote_constructor (dc :: ConDecl pass
dc@ConDeclGADT { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (XRec pass (IdP pass))
cons })
= ConDecl pass
dc { con_names = fmap (fmap promote_name) cons }
promote_constructor (dc :: ConDecl pass
dc@ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = XRec pass (IdP pass)
con })
= ConDecl pass
dc { con_name = fmap promote_name con }
promote_constructor ConDecl pass
dc = ConDecl pass
dc
promote_name :: RdrName -> RdrName
promote_name RdrName
name = RdrName -> Maybe RdrName -> RdrName
forall a. a -> Maybe a -> a
fromMaybe RdrName
name (RdrName -> Maybe RdrName
promoteRdrName RdrName
name)
mkImport :: Located CCallConv
-> Located Safety
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkImport :: GenLocated SrcSpan CCallConv
-> GenLocated SrcSpan Safety
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkImport GenLocated SrcSpan CCallConv
cconv GenLocated SrcSpan Safety
safety (L SrcSpan
loc (StringLiteral SourceText
esrc FastString
entity Maybe NoCommentsLocation
_), LocatedN RdrName
v, LHsSigType GhcPs
ty) =
case GenLocated SrcSpan CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan CCallConv
cconv of
CCallConv
CCallConv -> ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec (ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs))
-> P (ForeignImport GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< P (ForeignImport GhcPs)
mkCImport
CCallConv
CApiConv -> do
ForeignImport GhcPs
imp <- P (ForeignImport GhcPs)
mkCImport
if ForeignImport GhcPs -> Bool
forall {pass}. ForeignImport pass -> Bool
isCWrapperImport ForeignImport GhcPs
imp
then MsgEnvelope PsMessage -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ([AddEpAnn] -> HsDecl GhcPs))
-> MsgEnvelope PsMessage -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc PsMessage
PsErrInvalidCApiImport
else ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
imp
CCallConv
StdCallConv -> ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec (ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs))
-> P (ForeignImport GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< P (ForeignImport GhcPs)
mkCImport
CCallConv
PrimCallConv -> P ([AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
CCallConv
JavaScriptCallConv -> P ([AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
where
mkCImport :: P (ForeignImport GhcPs)
mkCImport = do
let e :: String
e = FastString -> String
unpackFS FastString
entity
case LocatedE CCallConv
-> LocatedE Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport GhcPs)
forall (p :: Pass).
LocatedE CCallConv
-> LocatedE Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport (GenLocated SrcSpan CCallConv -> LocatedE CCallConv
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan CCallConv
cconv) (GenLocated SrcSpan Safety -> LocatedE Safety
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan Safety
safety) (RdrName -> FastString
mkExtName (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
v)) String
e (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc SourceText
esrc) of
Maybe (ForeignImport GhcPs)
Nothing -> MsgEnvelope PsMessage -> P (ForeignImport GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (ForeignImport GhcPs))
-> MsgEnvelope PsMessage -> P (ForeignImport GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrMalformedEntityString
Just ForeignImport GhcPs
importSpec -> ForeignImport GhcPs -> P (ForeignImport GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignImport GhcPs
importSpec
isCWrapperImport :: ForeignImport pass -> Bool
isCWrapperImport (CImport XCImport pass
_ XRec pass CCallConv
_ XRec pass Safety
_ Maybe Header
_ CImportSpec
CWrapper) = Bool
True
isCWrapperImport ForeignImport pass
_ = Bool
False
mkOtherImport :: P ([AddEpAnn] -> HsDecl GhcPs)
mkOtherImport = ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
importSpec
where
entity' :: FastString
entity' = if FastString -> Bool
nullFS FastString
entity
then RdrName -> FastString
mkExtName (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
v)
else FastString
entity
funcTarget :: CImportSpec
funcTarget = CCallTarget -> CImportSpec
CFunction (SourceText -> FastString -> Maybe Unit -> Bool -> CCallTarget
StaticTarget SourceText
esrc FastString
entity' Maybe Unit
forall a. Maybe a
Nothing Bool
True)
importSpec :: ForeignImport GhcPs
importSpec = XCImport GhcPs
-> XRec GhcPs CCallConv
-> XRec GhcPs Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport GhcPs
forall pass.
XCImport pass
-> XRec pass CCallConv
-> XRec pass Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport pass
CImport (EpaLocation -> SourceText -> GenLocated EpaLocation SourceText
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
loc) SourceText
esrc) (GenLocated SrcSpan CCallConv -> LocatedE CCallConv
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan CCallConv
cconv) (GenLocated SrcSpan Safety -> LocatedE Safety
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan Safety
safety) Maybe Header
forall a. Maybe a
Nothing CImportSpec
funcTarget
returnSpec :: ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
spec = ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs))
-> ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \[AddEpAnn]
ann -> XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD XForD GhcPs
NoExtField
noExtField (ForeignDecl GhcPs -> HsDecl GhcPs)
-> ForeignDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ForeignImport
{ fd_i_ext :: XForeignImport GhcPs
fd_i_ext = [AddEpAnn]
XForeignImport GhcPs
ann
, fd_name :: XRec GhcPs (IdP GhcPs)
fd_name = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v
, fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = LHsSigType GhcPs
ty
, fd_fi :: ForeignImport GhcPs
fd_fi = ForeignImport GhcPs
spec
}
parseCImport :: LocatedE CCallConv -> LocatedE Safety -> FastString -> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport :: forall (p :: Pass).
LocatedE CCallConv
-> LocatedE Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport LocatedE CCallConv
cconv LocatedE Safety
safety FastString
nm String
str Located SourceText
sourceText =
[ForeignImport (GhcPass p)] -> Maybe (ForeignImport (GhcPass p))
forall a. [a] -> Maybe a
listToMaybe ([ForeignImport (GhcPass p)] -> Maybe (ForeignImport (GhcPass p)))
-> [ForeignImport (GhcPass p)] -> Maybe (ForeignImport (GhcPass p))
forall a b. (a -> b) -> a -> b
$ ((ForeignImport (GhcPass p), String) -> ForeignImport (GhcPass p))
-> [(ForeignImport (GhcPass p), String)]
-> [ForeignImport (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map (ForeignImport (GhcPass p), String) -> ForeignImport (GhcPass p)
forall a b. (a, b) -> a
fst ([(ForeignImport (GhcPass p), String)]
-> [ForeignImport (GhcPass p)])
-> [(ForeignImport (GhcPass p), String)]
-> [ForeignImport (GhcPass p)]
forall a b. (a -> b) -> a -> b
$ ((ForeignImport (GhcPass p), String) -> Bool)
-> [(ForeignImport (GhcPass p), String)]
-> [(ForeignImport (GhcPass p), String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null(String -> Bool)
-> ((ForeignImport (GhcPass p), String) -> String)
-> (ForeignImport (GhcPass p), String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ForeignImport (GhcPass p), String) -> String
forall a b. (a, b) -> b
snd) ([(ForeignImport (GhcPass p), String)]
-> [(ForeignImport (GhcPass p), String)])
-> [(ForeignImport (GhcPass p), String)]
-> [(ForeignImport (GhcPass p), String)]
forall a b. (a -> b) -> a -> b
$
ReadP (ForeignImport (GhcPass p))
-> ReadS (ForeignImport (GhcPass p))
forall a. ReadP a -> ReadS a
readP_to_S ReadP (ForeignImport (GhcPass p))
parse String
str
where
parse :: ReadP (ForeignImport (GhcPass p))
parse = do
ReadP ()
skipSpaces
ForeignImport (GhcPass p)
r <- [ReadP (ForeignImport (GhcPass p))]
-> ReadP (ForeignImport (GhcPass p))
forall a. [ReadP a] -> ReadP a
choice [
String -> ReadP String
string String
"dynamic" ReadP String
-> ReadP (ForeignImport (GhcPass p))
-> ReadP (ForeignImport (GhcPass p))
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignImport (GhcPass p) -> ReadP (ForeignImport (GhcPass p))
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Header -> CImportSpec -> ForeignImport (GhcPass p)
mk Maybe Header
forall a. Maybe a
Nothing (CCallTarget -> CImportSpec
CFunction CCallTarget
DynamicTarget)),
String -> ReadP String
string String
"wrapper" ReadP String
-> ReadP (ForeignImport (GhcPass p))
-> ReadP (ForeignImport (GhcPass p))
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignImport (GhcPass p) -> ReadP (ForeignImport (GhcPass p))
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Header -> CImportSpec -> ForeignImport (GhcPass p)
mk Maybe Header
forall a. Maybe a
Nothing CImportSpec
CWrapper),
do ReadP () -> ReadP ()
forall a. ReadP a -> ReadP ()
optional (String -> ReadP ()
token String
"static" ReadP () -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
skipSpaces)
((Maybe Header -> CImportSpec -> ForeignImport (GhcPass p)
mk Maybe Header
forall a. Maybe a
Nothing (CImportSpec -> ForeignImport (GhcPass p))
-> ReadP CImportSpec -> ReadP (ForeignImport (GhcPass p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> ReadP CImportSpec
cimp FastString
nm) ReadP (ForeignImport (GhcPass p))
-> ReadP (ForeignImport (GhcPass p))
-> ReadP (ForeignImport (GhcPass p))
forall a. ReadP a -> ReadP a -> ReadP a
+++
(do String
h <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
hdr_char
ReadP ()
skipSpaces
let src :: FastString
src = String -> FastString
mkFastString String
h
Maybe Header -> CImportSpec -> ForeignImport (GhcPass p)
mk (Header -> Maybe Header
forall a. a -> Maybe a
Just (SourceText -> FastString -> Header
Header (FastString -> SourceText
SourceText FastString
src) FastString
src))
(CImportSpec -> ForeignImport (GhcPass p))
-> ReadP CImportSpec -> ReadP (ForeignImport (GhcPass p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> ReadP CImportSpec
cimp FastString
nm))
]
ReadP ()
skipSpaces
ForeignImport (GhcPass p) -> ReadP (ForeignImport (GhcPass p))
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignImport (GhcPass p)
r
token :: String -> ReadP ()
token String
str = do String
_ <- String -> ReadP String
string String
str
String
toks <- ReadP String
look
case String
toks of
Char
c : String
_
| Char -> Bool
id_char Char
c -> ReadP ()
forall a. ReadP a
pfail
String
_ -> () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mk :: Maybe Header -> CImportSpec -> ForeignImport (GhcPass p)
mk Maybe Header
h CImportSpec
n = XCImport (GhcPass p)
-> XRec (GhcPass p) CCallConv
-> XRec (GhcPass p) Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport (GhcPass p)
forall pass.
XCImport pass
-> XRec pass CCallConv
-> XRec pass Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport pass
CImport (Located SourceText -> GenLocated EpaLocation SourceText
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc Located SourceText
sourceText) (LocatedE CCallConv -> LocatedE CCallConv
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc LocatedE CCallConv
cconv) (LocatedE Safety -> LocatedE Safety
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc LocatedE Safety
safety) Maybe Header
h CImportSpec
n
hdr_char :: Char -> Bool
hdr_char Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c)
id_first_char :: Char -> Bool
id_first_char Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
id_char :: Char -> Bool
id_char Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
cimp :: FastString -> ReadP CImportSpec
cimp FastString
nm = (Char -> ReadP Char
ReadP.char Char
'&' ReadP Char -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
skipSpaces ReadP () -> ReadP CImportSpec -> ReadP CImportSpec
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FastString -> CImportSpec
CLabel (FastString -> CImportSpec)
-> ReadP FastString -> ReadP CImportSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP FastString
cid)
ReadP CImportSpec -> ReadP CImportSpec -> ReadP CImportSpec
forall a. ReadP a -> ReadP a -> ReadP a
+++ (do Bool
isFun <- case LocatedE CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc LocatedE CCallConv
cconv of
CCallConv
CApiConv ->
Bool -> ReadP Bool -> ReadP Bool
forall a. a -> ReadP a -> ReadP a
option Bool
True
(do String -> ReadP ()
token String
"value"
ReadP ()
skipSpaces
Bool -> ReadP Bool
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
CCallConv
_ -> Bool -> ReadP Bool
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
FastString
cid' <- ReadP FastString
cid
CImportSpec -> ReadP CImportSpec
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (CCallTarget -> CImportSpec
CFunction (SourceText -> FastString -> Maybe Unit -> Bool -> CCallTarget
StaticTarget SourceText
NoSourceText FastString
cid'
Maybe Unit
forall a. Maybe a
Nothing Bool
isFun)))
where
cid :: ReadP FastString
cid = FastString -> ReadP FastString
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return FastString
nm ReadP FastString -> ReadP FastString -> ReadP FastString
forall a. ReadP a -> ReadP a -> ReadP a
+++
(do Char
c <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
id_first_char
String
cs <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
id_char)
FastString -> ReadP FastString
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FastString
mkFastString (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)))
mkExport :: Located CCallConv
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkExport :: GenLocated SrcSpan CCallConv
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkExport (L SrcSpan
lc CCallConv
cconv) (L SrcSpan
le (StringLiteral SourceText
esrc FastString
entity Maybe NoCommentsLocation
_), LocatedN RdrName
v, LHsSigType GhcPs
ty)
= ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs))
-> ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \[AddEpAnn]
ann -> XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD XForD GhcPs
NoExtField
noExtField (ForeignDecl GhcPs -> HsDecl GhcPs)
-> ForeignDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
ForeignExport { fd_e_ext :: XForeignExport GhcPs
fd_e_ext = [AddEpAnn]
XForeignExport GhcPs
ann, fd_name :: XRec GhcPs (IdP GhcPs)
fd_name = XRec GhcPs (IdP GhcPs)
LocatedN RdrName
v, fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = LHsSigType GhcPs
ty
, fd_fe :: ForeignExport GhcPs
fd_fe = XCExport GhcPs -> XRec GhcPs CExportSpec -> ForeignExport GhcPs
forall pass.
XCExport pass -> XRec pass CExportSpec -> ForeignExport pass
CExport (EpaLocation -> SourceText -> GenLocated EpaLocation SourceText
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
le) SourceText
esrc) (EpaLocation -> CExportSpec -> GenLocated EpaLocation CExportSpec
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
lc) (SourceText -> FastString -> CCallConv -> CExportSpec
CExportStatic SourceText
esrc FastString
entity' CCallConv
cconv)) }
where
entity' :: FastString
entity' | FastString -> Bool
nullFS FastString
entity = RdrName -> FastString
mkExtName (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
v)
| Bool
otherwise = FastString
entity
mkExtName :: RdrName -> CLabelString
mkExtName :: RdrName -> FastString
mkExtName RdrName
rdrNm = OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdrNm)
data ImpExpSubSpec = ImpExpAbs
| ImpExpAll
| ImpExpList [LocatedA ImpExpQcSpec]
| ImpExpAllWith [LocatedA ImpExpQcSpec]
data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
| ImpExpQcType EpaLocation (LocatedN RdrName)
| ImpExpQcWildcard
mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> [AddEpAnn] -> LocatedA ImpExpQcSpec
-> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp :: Maybe (LWarningTxt GhcPs)
-> [AddEpAnn]
-> LocatedA ImpExpQcSpec
-> ImpExpSubSpec
-> P (IE GhcPs)
mkModuleImpExp Maybe (LWarningTxt GhcPs)
warning [AddEpAnn]
anns (L SrcSpanAnnA
l ImpExpQcSpec
specname) ImpExpSubSpec
subs = do
case ImpExpSubSpec
subs of
ImpExpSubSpec
ImpExpAbs
| NameSpace -> Bool
isVarNameSpace (RdrName -> NameSpace
rdrNameSpace RdrName
name)
-> IE GhcPs -> P (IE GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (IE GhcPs -> P (IE GhcPs)) -> IE GhcPs -> P (IE GhcPs)
forall a b. (a -> b) -> a -> b
$ XIEVar GhcPs
-> LIEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs
forall pass.
XIEVar pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEVar Maybe (LWarningTxt GhcPs)
XIEVar GhcPs
warning
(SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec ImpExpQcSpec
specname)) Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing
| Bool
otherwise -> XIEThingAbs GhcPs
-> LIEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs
forall pass.
XIEThingAbs pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAbs (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> (IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> IEWrappedName GhcPs
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (Maybe (LHsDoc GhcPs)) -> P (IE GhcPs)
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LHsDoc GhcPs) -> P (Maybe (LHsDoc GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LHsDoc GhcPs)
noExportDoc
ImpExpSubSpec
ImpExpAll -> XIEThingAll GhcPs
-> LIEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs
forall pass.
XIEThingAll pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAll (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> (IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> IEWrappedName GhcPs
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (Maybe (LHsDoc GhcPs)) -> P (IE GhcPs)
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LHsDoc GhcPs) -> P (Maybe (LHsDoc GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LHsDoc GhcPs)
noExportDoc
ImpExpList [LocatedA ImpExpQcSpec]
xs ->
(\IEWrappedName GhcPs
newName -> XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName GhcPs
newName)
IEWildcard
NoIEWildcard ([LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
wrapped [LocatedA ImpExpQcSpec]
xs)) (IEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (Maybe (LHsDoc GhcPs)) -> P (IE GhcPs)
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LHsDoc GhcPs) -> P (Maybe (LHsDoc GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LHsDoc GhcPs)
noExportDoc
ImpExpAllWith [LocatedA ImpExpQcSpec]
xs ->
do Bool
allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
PatternSynonymsBit
if Bool
allowed
then
let withs :: [ImpExpQcSpec]
withs = (LocatedA ImpExpQcSpec -> ImpExpQcSpec)
-> [LocatedA ImpExpQcSpec] -> [ImpExpQcSpec]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA ImpExpQcSpec -> ImpExpQcSpec
forall l e. GenLocated l e -> e
unLoc [LocatedA ImpExpQcSpec]
xs
pos :: IEWildcard
pos = IEWildcard -> (Int -> IEWildcard) -> Maybe Int -> IEWildcard
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IEWildcard
NoIEWildcard Int -> IEWildcard
IEWildcard
((ImpExpQcSpec -> Bool) -> [ImpExpQcSpec] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ImpExpQcSpec -> Bool
isImpExpQcWildcard [ImpExpQcSpec]
withs)
ies :: [LocatedA (IEWrappedName GhcPs)]
ies :: [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ies = [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
wrapped ([LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)])
-> [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall a b. (a -> b) -> a -> b
$ (LocatedA ImpExpQcSpec -> Bool)
-> [LocatedA ImpExpQcSpec] -> [LocatedA ImpExpQcSpec]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (LocatedA ImpExpQcSpec -> Bool) -> LocatedA ImpExpQcSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImpExpQcSpec -> Bool
isImpExpQcWildcard (ImpExpQcSpec -> Bool)
-> (LocatedA ImpExpQcSpec -> ImpExpQcSpec)
-> LocatedA ImpExpQcSpec
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA ImpExpQcSpec -> ImpExpQcSpec
forall l e. GenLocated l e -> e
unLoc) [LocatedA ImpExpQcSpec]
xs
in (\IEWrappedName GhcPs
newName
-> XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName GhcPs
newName) IEWildcard
pos [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ies)
(IEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (Maybe (LHsDoc GhcPs)) -> P (IE GhcPs)
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LHsDoc GhcPs) -> P (Maybe (LHsDoc GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LHsDoc GhcPs)
noExportDoc
else MsgEnvelope PsMessage -> P (IE GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (IE GhcPs))
-> MsgEnvelope PsMessage -> P (IE GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrIllegalPatSynExport
where
noExportDoc :: Maybe (LHsDoc GhcPs)
noExportDoc :: Maybe (LHsDoc GhcPs)
noExportDoc = Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing
name :: RdrName
name = ImpExpQcSpec -> RdrName
ieNameVal ImpExpQcSpec
specname
nameT :: P (IEWrappedName GhcPs)
nameT =
if NameSpace -> Bool
isVarNameSpace (RdrName -> NameSpace
rdrNameSpace RdrName
name)
then MsgEnvelope PsMessage -> P (IEWrappedName GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (IEWrappedName GhcPs))
-> MsgEnvelope PsMessage -> P (IEWrappedName GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> PsMessage
PsErrVarForTyCon RdrName
name)
else IEWrappedName GhcPs -> P (IEWrappedName GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (IEWrappedName GhcPs -> P (IEWrappedName GhcPs))
-> IEWrappedName GhcPs -> P (IEWrappedName GhcPs)
forall a b. (a -> b) -> a -> b
$ ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec ImpExpQcSpec
specname
ieNameVal :: ImpExpQcSpec -> RdrName
ieNameVal (ImpExpQcName LocatedN RdrName
ln) = LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
ln
ieNameVal (ImpExpQcType EpaLocation
_ LocatedN RdrName
ln) = LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
ln
ieNameVal (ImpExpQcSpec
ImpExpQcWildcard) = String -> RdrName
forall a. HasCallStack => String -> a
panic String
"ieNameVal got wildcard"
ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec (ImpExpQcName (L SrcSpanAnnN
l RdrName
n)) = XIEName GhcPs -> XRec GhcPs (IdP GhcPs) -> IEWrappedName GhcPs
forall p. XIEName p -> LIdP p -> IEWrappedName p
IEName XIEName GhcPs
NoExtField
noExtField (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
n)
ieNameFromSpec (ImpExpQcType EpaLocation
r (L SrcSpanAnnN
l RdrName
n)) = XIEType GhcPs -> XRec GhcPs (IdP GhcPs) -> IEWrappedName GhcPs
forall p. XIEType p -> LIdP p -> IEWrappedName p
IEType XIEType GhcPs
EpaLocation
r (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
n)
ieNameFromSpec (ImpExpQcSpec
ImpExpQcWildcard) = String -> IEWrappedName GhcPs
forall a. HasCallStack => String -> a
panic String
"ieName got wildcard"
wrapped :: [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
wrapped = (LocatedA ImpExpQcSpec
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((ImpExpQcSpec -> IEWrappedName GhcPs)
-> LocatedA ImpExpQcSpec
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec)
mkTypeImpExp :: LocatedN RdrName
-> P (LocatedN RdrName)
mkTypeImpExp :: LocatedN RdrName -> P (LocatedN RdrName)
mkTypeImpExp LocatedN RdrName
name =
do SrcSpan -> P ()
forall (m :: * -> *). MonadP m => SrcSpan -> m ()
requireExplicitNamespaces (LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedN RdrName
name)
LocatedN RdrName -> P (LocatedN RdrName)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((RdrName -> RdrName) -> LocatedN RdrName -> LocatedN RdrName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RdrName -> NameSpace -> RdrName
`setRdrNameSpace` NameSpace
tcClsName) LocatedN RdrName
name)
checkImportSpec :: LocatedL [LIE GhcPs] -> P (LocatedL [LIE GhcPs])
checkImportSpec :: LocatedL [LIE GhcPs] -> P (LocatedL [LIE GhcPs])
checkImportSpec ie :: LocatedL [LIE GhcPs]
ie@(L SrcSpanAnnL
_ [LIE GhcPs]
specs) =
case [SrcSpanAnnA
l | (L SrcSpanAnnA
l (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
_ (IEWildcard Int
_) [LIEWrappedName GhcPs]
_ Maybe (LHsDoc GhcPs)
_)) <- [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
specs] of
[] -> LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> P (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedL [LIE GhcPs]
LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
ie
(SrcSpanAnnA
l:[SrcSpanAnnA]
_) -> SrcSpan -> P (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall {m :: * -> *} {a}. MonadP m => SrcSpan -> m a
importSpecError (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
where
importSpecError :: SrcSpan -> m a
importSpecError SrcSpan
l =
MsgEnvelope PsMessage -> m a
forall a. MsgEnvelope PsMessage -> m a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> m a) -> MsgEnvelope PsMessage -> m a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrIllegalImportBundleForm
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec [] = ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [LocatedA ImpExpQcSpec] -> ImpExpSubSpec
ImpExpList [])
mkImpExpSubSpec [L SrcSpanAnnA
la ImpExpQcSpec
ImpExpQcWildcard] =
([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnDotdot (SrcSpanAnnA -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry SrcSpanAnnA
la)], ImpExpSubSpec
ImpExpAll)
mkImpExpSubSpec [LocatedA ImpExpQcSpec]
xs =
if ((LocatedA ImpExpQcSpec -> Bool) -> [LocatedA ImpExpQcSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ImpExpQcSpec -> Bool
isImpExpQcWildcard (ImpExpQcSpec -> Bool)
-> (LocatedA ImpExpQcSpec -> ImpExpQcSpec)
-> LocatedA ImpExpQcSpec
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA ImpExpQcSpec -> ImpExpQcSpec
forall l e. GenLocated l e -> e
unLoc) [LocatedA ImpExpQcSpec]
xs)
then ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec))
-> ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a b. (a -> b) -> a -> b
$ ([], [LocatedA ImpExpQcSpec] -> ImpExpSubSpec
ImpExpAllWith [LocatedA ImpExpQcSpec]
xs)
else ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec))
-> ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a b. (a -> b) -> a -> b
$ ([], [LocatedA ImpExpQcSpec] -> ImpExpSubSpec
ImpExpList [LocatedA ImpExpQcSpec]
xs)
isImpExpQcWildcard :: ImpExpQcSpec -> Bool
isImpExpQcWildcard :: ImpExpQcSpec -> Bool
isImpExpQcWildcard ImpExpQcSpec
ImpExpQcWildcard = Bool
True
isImpExpQcWildcard ImpExpQcSpec
_ = Bool
False
warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule SrcSpan
span =
SrcSpan -> PsMessage -> P ()
addPsMessage SrcSpan
span PsMessage
PsWarnImportPreQualified
failNotEnabledImportQualifiedPost :: SrcSpan -> P ()
failNotEnabledImportQualifiedPost :: SrcSpan -> P ()
failNotEnabledImportQualifiedPost SrcSpan
loc =
MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrImportPostQualified
failImportQualifiedTwice :: SrcSpan -> P ()
failImportQualifiedTwice :: SrcSpan -> P ()
failImportQualifiedTwice SrcSpan
loc =
MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrImportQualifiedTwice
warnStarIsType :: SrcSpan -> P ()
warnStarIsType :: SrcSpan -> P ()
warnStarIsType SrcSpan
span = SrcSpan -> PsMessage -> P ()
addPsMessage SrcSpan
span PsMessage
PsWarnStarIsType
failOpFewArgs :: MonadP m => LocatedN RdrName -> m a
failOpFewArgs :: forall (m :: * -> *) a. MonadP m => LocatedN RdrName -> m a
failOpFewArgs (L SrcSpanAnnN
loc RdrName
op) =
do { Bool
star_is_type <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
StarIsTypeBit
; let is_star_type :: StarIsType
is_star_type = if Bool
star_is_type then StarIsType
StarIsType else StarIsType
StarIsNotType
; MsgEnvelope PsMessage -> m a
forall a. MsgEnvelope PsMessage -> m a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> m a) -> MsgEnvelope PsMessage -> m a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(StarIsType -> RdrName -> PsMessage
PsErrOpFewArgs StarIsType
is_star_type RdrName
op) }
requireExplicitNamespaces :: MonadP m => SrcSpan -> m ()
requireExplicitNamespaces :: forall (m :: * -> *). MonadP m => SrcSpan -> m ()
requireExplicitNamespaces SrcSpan
l = do
Bool
allowed <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ExplicitNamespacesBit
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgEnvelope PsMessage -> m ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> m ()) -> MsgEnvelope PsMessage -> m ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrIllegalExplicitNamespace
data PV_Context =
PV_Context
{ PV_Context -> ParserOpts
pv_options :: ParserOpts
, PV_Context -> ParseContext
pv_details :: ParseContext
}
data PV_Accum =
PV_Accum
{ PV_Accum -> Messages PsMessage
pv_warnings :: Messages PsMessage
, PV_Accum -> Messages PsMessage
pv_errors :: Messages PsMessage
, :: Strict.Maybe [LEpaComment]
, :: [LEpaComment]
}
data PV_Result a = PV_Ok PV_Accum a | PV_Failed PV_Accum
deriving ((forall m. Monoid m => PV_Result m -> m)
-> (forall m a. Monoid m => (a -> m) -> PV_Result a -> m)
-> (forall m a. Monoid m => (a -> m) -> PV_Result a -> m)
-> (forall a b. (a -> b -> b) -> b -> PV_Result a -> b)
-> (forall a b. (a -> b -> b) -> b -> PV_Result a -> b)
-> (forall b a. (b -> a -> b) -> b -> PV_Result a -> b)
-> (forall b a. (b -> a -> b) -> b -> PV_Result a -> b)
-> (forall a. (a -> a -> a) -> PV_Result a -> a)
-> (forall a. (a -> a -> a) -> PV_Result a -> a)
-> (forall a. PV_Result a -> [a])
-> (forall a. PV_Result a -> Bool)
-> (forall a. PV_Result a -> Int)
-> (forall a. Eq a => a -> PV_Result a -> Bool)
-> (forall a. Ord a => PV_Result a -> a)
-> (forall a. Ord a => PV_Result a -> a)
-> (forall a. Num a => PV_Result a -> a)
-> (forall a. Num a => PV_Result a -> a)
-> Foldable PV_Result
forall a. Eq a => a -> PV_Result a -> Bool
forall a. Num a => PV_Result a -> a
forall a. Ord a => PV_Result a -> a
forall m. Monoid m => PV_Result m -> m
forall a. PV_Result a -> Bool
forall a. PV_Result a -> Int
forall a. PV_Result a -> [a]
forall a. (a -> a -> a) -> PV_Result a -> a
forall m a. Monoid m => (a -> m) -> PV_Result a -> m
forall b a. (b -> a -> b) -> b -> PV_Result a -> b
forall a b. (a -> b -> b) -> b -> PV_Result a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => PV_Result m -> m
fold :: forall m. Monoid m => PV_Result m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> PV_Result a -> a
foldr1 :: forall a. (a -> a -> a) -> PV_Result a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PV_Result a -> a
foldl1 :: forall a. (a -> a -> a) -> PV_Result a -> a
$ctoList :: forall a. PV_Result a -> [a]
toList :: forall a. PV_Result a -> [a]
$cnull :: forall a. PV_Result a -> Bool
null :: forall a. PV_Result a -> Bool
$clength :: forall a. PV_Result a -> Int
length :: forall a. PV_Result a -> Int
$celem :: forall a. Eq a => a -> PV_Result a -> Bool
elem :: forall a. Eq a => a -> PV_Result a -> Bool
$cmaximum :: forall a. Ord a => PV_Result a -> a
maximum :: forall a. Ord a => PV_Result a -> a
$cminimum :: forall a. Ord a => PV_Result a -> a
minimum :: forall a. Ord a => PV_Result a -> a
$csum :: forall a. Num a => PV_Result a -> a
sum :: forall a. Num a => PV_Result a -> a
$cproduct :: forall a. Num a => PV_Result a -> a
product :: forall a. Num a => PV_Result a -> a
Foldable, (forall a b. (a -> b) -> PV_Result a -> PV_Result b)
-> (forall a b. a -> PV_Result b -> PV_Result a)
-> Functor PV_Result
forall a b. a -> PV_Result b -> PV_Result a
forall a b. (a -> b) -> PV_Result a -> PV_Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PV_Result a -> PV_Result b
fmap :: forall a b. (a -> b) -> PV_Result a -> PV_Result b
$c<$ :: forall a b. a -> PV_Result b -> PV_Result a
<$ :: forall a b. a -> PV_Result b -> PV_Result a
Functor, Functor PV_Result
Foldable PV_Result
(Functor PV_Result, Foldable PV_Result) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b))
-> (forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b))
-> (forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a))
-> Traversable PV_Result
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a)
forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a)
sequence :: forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a)
Traversable)
newtype PV a = PV { forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV :: PV_Context -> PV_Accum -> PV_Result a }
deriving ((forall a b. (a -> b) -> PV a -> PV b)
-> (forall a b. a -> PV b -> PV a) -> Functor PV
forall a b. a -> PV b -> PV a
forall a b. (a -> b) -> PV a -> PV b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PV a -> PV b
fmap :: forall a b. (a -> b) -> PV a -> PV b
$c<$ :: forall a b. a -> PV b -> PV a
<$ :: forall a b. a -> PV b -> PV a
Functor)
instance Applicative PV where
pure :: forall a. a -> PV a
pure a
a = a
a a -> PV a -> PV a
forall a b. a -> b -> b
`seq` (PV_Context -> PV_Accum -> PV_Result a) -> PV a
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV (\PV_Context
_ PV_Accum
acc -> PV_Accum -> a -> PV_Result a
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc a
a)
<*> :: forall a b. PV (a -> b) -> PV a -> PV b
(<*>) = PV (a -> b) -> PV a -> PV b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad PV where
PV a
m >>= :: forall a b. PV a -> (a -> PV b) -> PV b
>>= a -> PV b
f = (PV_Context -> PV_Accum -> PV_Result b) -> PV b
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result b) -> PV b)
-> (PV_Context -> PV_Accum -> PV_Result b) -> PV b
forall a b. (a -> b) -> a -> b
$ \PV_Context
ctx PV_Accum
acc ->
case PV a -> PV_Context -> PV_Accum -> PV_Result a
forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV PV a
m PV_Context
ctx PV_Accum
acc of
PV_Ok PV_Accum
acc' a
a -> PV b -> PV_Context -> PV_Accum -> PV_Result b
forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV (a -> PV b
f a
a) PV_Context
ctx PV_Accum
acc'
PV_Failed PV_Accum
acc' -> PV_Accum -> PV_Result b
forall a. PV_Accum -> PV_Result a
PV_Failed PV_Accum
acc'
runPV :: PV a -> P a
runPV :: forall a. PV a -> P a
runPV = ParseContext -> PV a -> P a
forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
noParseContext
askParseContext :: PV ParseContext
askParseContext :: PV ParseContext
askParseContext = (PV_Context -> PV_Accum -> PV_Result ParseContext)
-> PV ParseContext
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result ParseContext)
-> PV ParseContext)
-> (PV_Context -> PV_Accum -> PV_Result ParseContext)
-> PV ParseContext
forall a b. (a -> b) -> a -> b
$ \(PV_Context ParserOpts
_ ParseContext
details) PV_Accum
acc -> PV_Accum -> ParseContext -> PV_Result ParseContext
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc ParseContext
details
runPV_details :: ParseContext -> PV a -> P a
runPV_details :: forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
details PV a
m =
(PState -> ParseResult a) -> P a
forall a. (PState -> ParseResult a) -> P a
P ((PState -> ParseResult a) -> P a)
-> (PState -> ParseResult a) -> P a
forall a b. (a -> b) -> a -> b
$ \PState
s ->
let
pv_ctx :: PV_Context
pv_ctx = PV_Context
{ pv_options :: ParserOpts
pv_options = PState -> ParserOpts
options PState
s
, pv_details :: ParseContext
pv_details = ParseContext
details }
pv_acc :: PV_Accum
pv_acc = PV_Accum
{ pv_warnings :: Messages PsMessage
pv_warnings = PState -> Messages PsMessage
warnings PState
s
, pv_errors :: Messages PsMessage
pv_errors = PState -> Messages PsMessage
errors PState
s
, pv_header_comments :: Maybe [LEpaComment]
pv_header_comments = PState -> Maybe [LEpaComment]
header_comments PState
s
, pv_comment_q :: [LEpaComment]
pv_comment_q = PState -> [LEpaComment]
comment_q PState
s }
mkPState :: PV_Accum -> PState
mkPState PV_Accum
acc' =
PState
s { warnings = pv_warnings acc'
, errors = pv_errors acc'
, comment_q = pv_comment_q acc' }
in
case PV a -> PV_Context -> PV_Accum -> PV_Result a
forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV PV a
m PV_Context
pv_ctx PV_Accum
pv_acc of
PV_Ok PV_Accum
acc' a
a -> PState -> a -> ParseResult a
forall a. PState -> a -> ParseResult a
POk (PV_Accum -> PState
mkPState PV_Accum
acc') a
a
PV_Failed PV_Accum
acc' -> PState -> ParseResult a
forall a. PState -> ParseResult a
PFailed (PV_Accum -> PState
mkPState PV_Accum
acc')
instance MonadP PV where
addError :: MsgEnvelope PsMessage -> PV ()
addError MsgEnvelope PsMessage
err =
(PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result ()) -> PV ())
-> (PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ctx PV_Accum
acc -> PV_Accum -> () -> PV_Result ()
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc{pv_errors = err `addMessage` pv_errors acc} ()
addWarning :: MsgEnvelope PsMessage -> PV ()
addWarning MsgEnvelope PsMessage
w =
(PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result ()) -> PV ())
-> (PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ctx PV_Accum
acc ->
PV_Accum -> () -> PV_Result ()
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc{pv_warnings= w `addMessage` pv_warnings acc} ()
addFatalError :: forall a. MsgEnvelope PsMessage -> PV a
addFatalError MsgEnvelope PsMessage
err =
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError MsgEnvelope PsMessage
err PV () -> PV a -> PV a
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PV_Context -> PV_Accum -> PV_Result a) -> PV a
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Accum -> PV_Result a) -> PV_Context -> PV_Accum -> PV_Result a
forall a b. a -> b -> a
const PV_Accum -> PV_Result a
forall a. PV_Accum -> PV_Result a
PV_Failed)
getBit :: ExtBits -> PV Bool
getBit ExtBits
ext =
(PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool)
-> (PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool
forall a b. (a -> b) -> a -> b
$ \PV_Context
ctx PV_Accum
acc ->
let b :: Bool
b = ExtBits
ext ExtBits -> ExtsBitmap -> Bool
`xtest` ParserOpts -> ExtsBitmap
pExtsBitmap (PV_Context -> ParserOpts
pv_options PV_Context
ctx) in
PV_Accum -> Bool -> PV_Result Bool
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc (Bool -> PV_Result Bool) -> Bool -> PV_Result Bool
forall a b. (a -> b) -> a -> b
$! Bool
b
allocateCommentsP :: RealSrcSpan -> PV EpAnnComments
allocateCommentsP RealSrcSpan
ss = (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments)
-> (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ PV_Accum
s ->
if [LEpaComment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) then PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s EpAnnComments
emptyComments else
let ([LEpaComment]
comment_q', [LEpaComment]
newAnns) = RealSrcSpan -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
allocateComments RealSrcSpan
ss (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) in
PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s {
pv_comment_q = comment_q'
} ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
newAnns)
allocatePriorCommentsP :: RealSrcSpan -> PV EpAnnComments
allocatePriorCommentsP RealSrcSpan
ss = (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments)
-> (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ PV_Accum
s ->
let (Maybe [LEpaComment]
header_comments', [LEpaComment]
comment_q', [LEpaComment]
newAnns)
= RealSrcSpan
-> [LEpaComment]
-> Maybe [LEpaComment]
-> (Maybe [LEpaComment], [LEpaComment], [LEpaComment])
allocatePriorComments RealSrcSpan
ss (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) (PV_Accum -> Maybe [LEpaComment]
pv_header_comments PV_Accum
s) in
PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s {
pv_header_comments = header_comments',
pv_comment_q = comment_q'
} ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
newAnns)
allocateFinalCommentsP :: RealSrcSpan -> PV EpAnnComments
allocateFinalCommentsP RealSrcSpan
ss = (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments)
-> (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ PV_Accum
s ->
let (Maybe [LEpaComment]
header_comments', [LEpaComment]
comment_q', [LEpaComment]
newAnns)
= RealSrcSpan
-> [LEpaComment]
-> Maybe [LEpaComment]
-> (Maybe [LEpaComment], [LEpaComment], [LEpaComment])
allocateFinalComments RealSrcSpan
ss (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) (PV_Accum -> Maybe [LEpaComment]
pv_header_comments PV_Accum
s) in
PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s {
pv_header_comments = header_comments',
pv_comment_q = comment_q'
} ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced ([LEpaComment] -> Maybe [LEpaComment] -> [LEpaComment]
forall a. a -> Maybe a -> a
Strict.fromMaybe [] Maybe [LEpaComment]
header_comments') [LEpaComment]
newAnns)
hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat SrcSpan
span Pat GhcPs
e = do
Bool
bang_on <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
BangPatBit
Bool -> PV () -> PV ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
bang_on (PV () -> PV ()) -> PV () -> PV ()
forall a b. (a -> b) -> a -> b
$
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
span (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ Pat GhcPs -> PsMessage
PsErrIllegalBangPattern Pat GhcPs
e
mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
mkSumOrTupleExpr :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
mkSumOrTupleExpr l :: SrcSpanAnnA
l@(EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
csIn) Boxity
boxity (Tuple [Either (EpAnn Bool) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
es) [AddEpAnn]
anns = do
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc AnnListItem
an (EpAnnComments
csIn EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs)) (XExplicitTuple GhcPs -> [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple [AddEpAnn]
XExplicitTuple GhcPs
anns ((Either (EpAnn Bool) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsTupArg GhcPs)
-> [Either (EpAnn Bool) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [HsTupArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Either (EpAnn Bool) (LHsExpr GhcPs) -> HsTupArg GhcPs
Either (EpAnn Bool) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsTupArg GhcPs
toTupArg [Either (EpAnn Bool) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
es) Boxity
boxity)
where
toTupArg :: Either (EpAnn Bool) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg :: Either (EpAnn Bool) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg (Left EpAnn Bool
ann) = EpAnn Bool -> HsTupArg GhcPs
missingTupArg EpAnn Bool
ann
toTupArg (Right LHsExpr GhcPs
a) = XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
NoExtField
noExtField LHsExpr GhcPs
a
mkSumOrTupleExpr l :: SrcSpanAnnA
l@(EpAnn EpaLocation
anc AnnListItem
anIn EpAnnComments
csIn) Boxity
Unboxed (Sum Int
alt Int
arity GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [EpaLocation]
barsp [EpaLocation]
barsa) [AddEpAnn]
anns = do
let an :: AnnExplicitSum
an = case [AddEpAnn]
anns of
[AddEpAnn AnnKeywordId
AnnOpenPH EpaLocation
o, AddEpAnn AnnKeywordId
AnnClosePH EpaLocation
c] ->
EpaLocation
-> [EpaLocation] -> [EpaLocation] -> EpaLocation -> AnnExplicitSum
AnnExplicitSum EpaLocation
o [EpaLocation]
barsp [EpaLocation]
barsa EpaLocation
c
[AddEpAnn]
_ -> String -> AnnExplicitSum
forall a. HasCallStack => String -> a
panic String
"mkSumOrTupleExpr"
!EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc AnnListItem
anIn (EpAnnComments
csIn EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs)) (XExplicitSum GhcPs -> Int -> Int -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
ExplicitSum XExplicitSum GhcPs
AnnExplicitSum
an Int
alt Int
arity LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
mkSumOrTupleExpr SrcSpanAnnA
l Boxity
Boxed a :: SumOrTuple (HsExpr GhcPs)
a@Sum{} [AddEpAnn]
_ =
MsgEnvelope PsMessage -> PV (LHsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LHsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SumOrTuple (HsExpr GhcPs) -> PsMessage
PsErrUnsupportedBoxedSumExpr SumOrTuple (HsExpr GhcPs)
a
mkSumOrTuplePat
:: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat SrcSpanAnnA
l Boxity
boxity (Tuple [Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))]
ps) [AddEpAnn]
anns = do
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- (Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
toTupPat [Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))]
ps
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XTuplePat GhcPs -> [LPat GhcPs] -> Boxity -> Pat GhcPs
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat [AddEpAnn]
XTuplePat GhcPs
anns [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' Boxity
boxity))
where
toTupPat :: Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs)
toTupPat :: Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
toTupPat Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
p = case Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
p of
Left EpAnn Bool
_ -> MsgEnvelope PsMessage -> PV (LPat GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LPat GhcPs))
-> MsgEnvelope PsMessage -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$
SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) PsMessage
PsErrTupleSectionInPat
Right LocatedA (PatBuilder GhcPs)
p' -> LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
p'
mkSumOrTuplePat SrcSpanAnnA
l Boxity
Unboxed (Sum Int
alt Int
arity LocatedA (PatBuilder GhcPs)
p [EpaLocation]
barsb [EpaLocation]
barsa) [AddEpAnn]
anns = do
GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
p
let an :: EpAnnSumPat
an = [AddEpAnn] -> [EpaLocation] -> [EpaLocation] -> EpAnnSumPat
EpAnnSumPat [AddEpAnn]
anns [EpaLocation]
barsb [EpaLocation]
barsa
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XSumPat GhcPs -> LPat GhcPs -> Int -> Int -> Pat GhcPs
forall p. XSumPat p -> LPat p -> Int -> Int -> Pat p
SumPat XSumPat GhcPs
EpAnnSumPat
an LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p' Int
alt Int
arity))
mkSumOrTuplePat SrcSpanAnnA
l Boxity
Boxed a :: SumOrTuple (PatBuilder GhcPs)
a@Sum{} [AddEpAnn]
_ =
MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$
SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SumOrTuple (PatBuilder GhcPs) -> PsMessage
PsErrUnsupportedBoxedSumPat SumOrTuple (PatBuilder GhcPs)
a
mkLHsOpTy :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> LHsType GhcPs
mkLHsOpTy :: PromotionFlag
-> LHsType GhcPs
-> LocatedN RdrName
-> LHsType GhcPs
-> LHsType GhcPs
mkLHsOpTy PromotionFlag
prom LHsType GhcPs
x LocatedN RdrName
op LHsType GhcPs
y =
let loc :: SrcSpan
loc = GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x SrcSpan -> SrcSpan -> SrcSpan
`combineSrcSpans` LocatedN RdrName -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA LocatedN RdrName
op SrcSpan -> SrcSpan -> SrcSpan
`combineSrcSpans` GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
y
in SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) (PromotionFlag
-> LHsType GhcPs
-> LocatedN (IdP GhcPs)
-> LHsType GhcPs
-> HsType GhcPs
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
PromotionFlag
-> LHsType (GhcPass p)
-> LocatedN (IdP (GhcPass p))
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
mkHsOpTy PromotionFlag
prom LHsType GhcPs
x LocatedN (IdP GhcPs)
LocatedN RdrName
op LHsType GhcPs
y)
mkMultTy :: EpToken "%" -> LHsType GhcPs -> EpUniToken "->" "→" -> HsArrow GhcPs
mkMultTy :: EpToken "%"
-> LHsType GhcPs -> EpUniToken "->" "\8594" -> HsArrow GhcPs
mkMultTy EpToken "%"
pct t :: LHsType GhcPs
t@(L SrcSpanAnnA
_ (HsTyLit XTyLit GhcPs
_ (HsNumTy (SourceText (FastString -> String
unpackFS -> String
"1")) Integer
1))) EpUniToken "->" "\8594"
arr
= XLinearArrow GhcPs -> HsArrow GhcPs
forall pass. XLinearArrow pass -> HsArrow pass
HsLinearArrow (EpToken "%1" -> EpUniToken "->" "\8594" -> EpLinearArrow
EpPct1 EpToken "%1"
pct1 EpUniToken "->" "\8594"
arr)
where
pct1 :: EpToken "%1"
pct1 :: EpToken "%1"
pct1 = EpToken "%" -> SrcSpan -> EpToken "%1"
forall (tok :: Symbol) (tok' :: Symbol).
EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR EpToken "%"
pct (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
mkMultTy EpToken "%"
pct LHsType GhcPs
t EpUniToken "->" "\8594"
arr = XExplicitMult GhcPs -> LHsType GhcPs -> HsArrow GhcPs
forall pass. XExplicitMult pass -> LHsType pass -> HsArrow pass
HsExplicitMult (EpToken "%"
pct, EpUniToken "->" "\8594"
arr) LHsType GhcPs
t
mkMultAnn :: EpToken "%" -> LHsType GhcPs -> HsMultAnn GhcPs
mkMultAnn :: EpToken "%" -> LHsType GhcPs -> HsMultAnn GhcPs
mkMultAnn EpToken "%"
pct t :: LHsType GhcPs
t@(L SrcSpanAnnA
_ (HsTyLit XTyLit GhcPs
_ (HsNumTy (SourceText (FastString -> String
unpackFS -> String
"1")) Integer
1)))
= XPct1Ann GhcPs -> HsMultAnn GhcPs
forall pass. XPct1Ann pass -> HsMultAnn pass
HsPct1Ann EpToken "%1"
XPct1Ann GhcPs
pct1
where
pct1 :: EpToken "%1"
pct1 :: EpToken "%1"
pct1 = EpToken "%" -> SrcSpan -> EpToken "%1"
forall (tok :: Symbol) (tok' :: Symbol).
EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR EpToken "%"
pct (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
mkMultAnn EpToken "%"
pct LHsType GhcPs
t = XMultAnn GhcPs -> LHsType (NoGhcTc GhcPs) -> HsMultAnn GhcPs
forall pass.
XMultAnn pass -> LHsType (NoGhcTc pass) -> HsMultAnn pass
HsMultAnn EpToken "%"
XMultAnn GhcPs
pct LHsType (NoGhcTc GhcPs)
LHsType GhcPs
t
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation (UnhelpfulSpan UnhelpfulSpanReason
_) = TokenLocation
NoTokenLoc
mkTokenLocation (RealSrcSpan RealSrcSpan
r Maybe BufSpan
mb) = EpaLocation -> TokenLocation
TokenLoc (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
mb))
epTokenWidenR :: EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR :: forall (tok :: Symbol) (tok' :: Symbol).
EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR EpToken tok
NoEpTok SrcSpan
_ = EpToken tok'
forall (tok :: Symbol). EpToken tok
NoEpTok
epTokenWidenR (EpTok EpaLocation
l) (UnhelpfulSpan UnhelpfulSpanReason
_) = EpaLocation -> EpToken tok'
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok EpaLocation
l
epTokenWidenR (EpTok (EpaSpan SrcSpan
s1)) SrcSpan
s2 = EpaLocation -> EpToken tok'
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
s1 SrcSpan
s2))
epTokenWidenR (EpTok (EpaDelta DeltaPos
_ [LEpaComment]
_)) SrcSpan
_ =
String -> EpToken tok'
forall a. HasCallStack => String -> a
panic String
"epTokenWidenR: EpaDelta"
starSym :: Bool -> FastString
starSym :: Bool -> FastString
starSym Bool
True = String -> FastString
fsLit String
"★"
starSym Bool
False = String -> FastString
fsLit String
"*"
mkRdrGetField :: LHsExpr GhcPs -> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> HsExpr GhcPs
mkRdrGetField :: LHsExpr GhcPs
-> LocatedAn NoEpAnns (DotFieldOcc GhcPs) -> HsExpr GhcPs
mkRdrGetField LHsExpr GhcPs
arg LocatedAn NoEpAnns (DotFieldOcc GhcPs)
field =
HsGetField {
gf_ext :: XGetField GhcPs
gf_ext = XGetField GhcPs
NoExtField
NoExtField
, gf_expr :: LHsExpr GhcPs
gf_expr = LHsExpr GhcPs
arg
, gf_field :: XRec GhcPs (DotFieldOcc GhcPs)
gf_field = XRec GhcPs (DotFieldOcc GhcPs)
LocatedAn NoEpAnns (DotFieldOcc GhcPs)
field
}
mkRdrProjection :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)) -> AnnProjection -> HsExpr GhcPs
mkRdrProjection :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
-> AnnProjection -> HsExpr GhcPs
mkRdrProjection NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
flds AnnProjection
anns =
HsProjection {
proj_ext :: XProjection GhcPs
proj_ext = XProjection GhcPs
AnnProjection
anns
, proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_flds = NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
flds
}
mkRdrProjUpdate :: SrcSpanAnnA -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs -> Bool -> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate :: SrcSpanAnnA
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate SrcSpanAnnA
_ (L SrcSpan
_ []) LHsExpr GhcPs
_ Bool
_ [AddEpAnn]
_ = String
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => String -> a
panic String
"mkRdrProjUpdate: The impossible has happened!"
mkRdrProjUpdate SrcSpanAnnA
loc (L SrcSpan
l [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
flds) LHsExpr GhcPs
arg Bool
isPun [AddEpAnn]
anns =
SrcSpanAnnA
-> HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsFieldBind {
hfbAnn :: XHsFieldBind (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
hfbAnn = [AddEpAnn]
XHsFieldBind (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
anns
, hfbLHS :: GenLocated EpAnnCO (FieldLabelStrings GhcPs)
hfbLHS = EpAnnCO
-> FieldLabelStrings GhcPs
-> GenLocated EpAnnCO (FieldLabelStrings GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnnCO
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) ([XRec GhcPs (DotFieldOcc GhcPs)] -> FieldLabelStrings GhcPs
forall p. [XRec p (DotFieldOcc p)] -> FieldLabelStrings p
FieldLabelStrings [XRec GhcPs (DotFieldOcc GhcPs)]
[LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
flds)
, hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbRHS = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
, hfbPun :: Bool
hfbPun = Bool
isPun
}
punsAllowed :: P Bool
punsAllowed :: P Bool
punsAllowed = ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ListTuplePunsBit
punsIfElse :: a -> a -> P a
punsIfElse :: forall a. a -> a -> P a
punsIfElse a
enabled a
disabled = do
Bool
allowed <- P Bool
punsAllowed
a -> P a
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if Bool
allowed then a
enabled else a
disabled)
requireLTPuns :: PsErrPunDetails -> Located a -> Located b -> P ()
requireLTPuns :: forall a b. PsErrPunDetails -> Located a -> Located b -> P ()
requireLTPuns PsErrPunDetails
err Located a
start Located b
end =
P Bool -> P () -> P ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM P Bool
punsAllowed (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsErrPunDetails -> PsMessage
PsErrInvalidPun PsErrPunDetails
err))
where
loc :: SrcSpan
loc = (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located a -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located a
start) (Located b -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located b
end))
withCombinedComments ::
HasLoc l1 =>
HasLoc l2 =>
l1 ->
l2 ->
(SrcSpan -> P a) ->
P (LocatedA a)
l1
start l2
end SrcSpan -> P a
use = do
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
fullSpan
a
a <- SrcSpan -> P a
use SrcSpan
fullSpan
LocatedA a -> P (LocatedA a)
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpanAnnA -> a -> LocatedA a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
fullSpan) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
cs) a
a)
where
fullSpan :: SrcSpan
fullSpan = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (l1 -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc l1
start) (l2 -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc l2
end)
mkTupleSyntaxTy :: EpaLocation
-> [LocatedA (HsType GhcPs)]
-> EpaLocation
-> P (HsType GhcPs)
mkTupleSyntaxTy :: EpaLocation
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> EpaLocation
-> P (HsType GhcPs)
mkTupleSyntaxTy EpaLocation
parOpen [GenLocated SrcSpanAnnA (HsType GhcPs)]
args EpaLocation
parClose =
HsType GhcPs -> HsType GhcPs -> P (HsType GhcPs)
forall a. a -> a -> P a
punsIfElse HsType GhcPs
enabled HsType GhcPs
disabled
where
enabled :: HsType GhcPs
enabled =
XTupleTy GhcPs -> HsTupleSort -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy GhcPs
AnnParen
annParen HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
args
disabled :: HsType GhcPs
disabled =
XExplicitTupleTy GhcPs -> [LHsType GhcPs] -> HsType GhcPs
forall pass. XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
HsExplicitTupleTy [AddEpAnn]
XExplicitTupleTy GhcPs
annsKeyword [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
args
annParen :: AnnParen
annParen = ParenType -> EpaLocation -> EpaLocation -> AnnParen
AnnParen ParenType
AnnParens EpaLocation
parOpen EpaLocation
parClose
annsKeyword :: [AddEpAnn]
annsKeyword = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenP EpaLocation
parOpen, AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseP EpaLocation
parClose]
mkTupleSyntaxTycon :: Boxity -> Int -> P RdrName
mkTupleSyntaxTycon :: Boxity -> Int -> P RdrName
mkTupleSyntaxTycon Boxity
boxity Int
n =
RdrName -> RdrName -> P RdrName
forall a. a -> a -> P a
punsIfElse
(TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
n))
(DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
n))
mkListSyntaxTy0 :: EpaLocation
-> EpaLocation
-> SrcSpan
-> P (HsType GhcPs)
mkListSyntaxTy0 :: EpaLocation -> EpaLocation -> SrcSpan -> P (HsType GhcPs)
mkListSyntaxTy0 EpaLocation
brkOpen EpaLocation
brkClose SrcSpan
span =
HsType GhcPs -> HsType GhcPs -> P (HsType GhcPs)
forall a. a -> a -> P a
punsIfElse HsType GhcPs
enabled HsType GhcPs
disabled
where
enabled :: HsType GhcPs
enabled = XTyVar GhcPs
-> PromotionFlag -> XRec GhcPs (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar [AddEpAnn]
XTyVar GhcPs
forall a. NoAnn a => a
noAnn PromotionFlag
NotPromoted XRec GhcPs (IdP GhcPs)
LocatedN RdrName
rn
rn :: LocatedN RdrName
rn = SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> NameAnn -> EpAnnComments -> SrcSpanAnnN
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
fullLoc NameAnn
rdrNameAnn EpAnnComments
emptyComments) RdrName
listTyCon_RDR
disabled :: HsType GhcPs
disabled =
XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy [AddEpAnn]
XExplicitListTy GhcPs
annsKeyword PromotionFlag
NotPromoted []
rdrNameAnn :: NameAnn
rdrNameAnn = NameAdornment
-> EpaLocation -> EpaLocation -> [TrailingAnn] -> NameAnn
NameAnnOnly NameAdornment
NameSquare EpaLocation
brkOpen EpaLocation
brkClose []
annsKeyword :: [AddEpAnn]
annsKeyword = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenS EpaLocation
brkOpen, AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseS EpaLocation
brkClose]
fullLoc :: EpaLocation
fullLoc = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan SrcSpan
span
mkListSyntaxTy1 :: EpaLocation
-> LocatedA (HsType GhcPs)
-> EpaLocation
-> P (HsType GhcPs)
mkListSyntaxTy1 :: EpaLocation
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> EpaLocation
-> P (HsType GhcPs)
mkListSyntaxTy1 EpaLocation
brkOpen GenLocated SrcSpanAnnA (HsType GhcPs)
t EpaLocation
brkClose =
HsType GhcPs -> HsType GhcPs -> P (HsType GhcPs)
forall a. a -> a -> P a
punsIfElse HsType GhcPs
enabled HsType GhcPs
disabled
where
enabled :: HsType GhcPs
enabled = XListTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy GhcPs
AnnParen
annParen LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
disabled :: HsType GhcPs
disabled =
XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy [AddEpAnn]
XExplicitListTy GhcPs
annsKeyword PromotionFlag
NotPromoted [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t]
annsKeyword :: [AddEpAnn]
annsKeyword = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenS EpaLocation
brkOpen, AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseS EpaLocation
brkClose]
annParen :: AnnParen
annParen = ParenType -> EpaLocation -> EpaLocation -> AnnParen
AnnParen ParenType
AnnParensSquare EpaLocation
brkOpen EpaLocation
brkClose