{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# 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,
mkTokenLocation,
ImpExpSubSpec(..),
ImpExpQcSpec(..),
mkModuleImpExp,
mkTypeImpExp,
mkImpExpSubSpec,
checkImportSpec,
starSym,
warnStarIsType,
warnPrepositiveQualifiedModule,
failOpFewArgs,
failNotEnabledImportQualifiedPost,
failImportQualifiedTwice,
SumOrTuple (..),
PV,
runPV,
ECP(ECP, unECP),
DisambInfixOp(..),
DisambECP(..),
ecpFromExp,
ecpFromCmd,
PatBuilder,
DisambTD(..),
addUnpackednessP,
dataConBuilderCon,
dataConBuilderDetails,
) 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,
unrestrictedFunTyCon )
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 Data.Either
import Data.List ( findIndex )
import Data.Foldable
import qualified Data.Semigroup as Semi
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
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)
-> LayoutInfo GhcPs
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkClassDecl :: forall a.
SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a, [LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
-> LayoutInfo GhcPs
-> [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 LayoutInfo GhcPs
layoutInfo [AddEpAnn]
annsIn
= do { let loc :: SrcSpanAnnA
loc = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc'
; (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
; (GenLocated SrcSpanAnnN RdrName
cls, [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
True LHsType GhcPs
tycl_hdr
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"class") SDoc
whereDots GenLocated SrcSpanAnnN RdrName
cls [LHsTypeArg GhcPs]
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) [AddEpAnn]
ann 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 = (EpAnn [AddEpAnn]
anns', AnnSortKey
NoAnnSortKey)
, tcdLayout :: LayoutInfo GhcPs
tcdLayout = LayoutInfo GhcPs
layoutInfo
, tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt = Maybe (LHsContext GhcPs)
mcxt
, tcdLName :: XRec GhcPs (IdP GhcPs)
tcdLName = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN 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 { let loc :: SrcSpanAnnA
loc = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc'
; (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (NewOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr NewOrData
new_or_data) SDoc
equalsDots GenLocated SrcSpanAnnN RdrName
tc [LHsTypeArg GhcPs]
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) [AddEpAnn]
ann EpAnnComments
cs
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
data_cons <- SrcSpan
-> RdrName
-> Bool
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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
; 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 = XDataDecl GhcPs
EpAnn [AddEpAnn]
anns',
tcdLName :: XRec GhcPs (IdP GhcPs)
tcdLName = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN 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 { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
; EpAnnComments
cs1 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type") SDoc
equalsDots GenLocated SrcSpanAnnN RdrName
tc [LHsTypeArg GhcPs]
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; EpAnnComments
cs2 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) [AddEpAnn]
ann (EpAnnComments
cs1 EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
; 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (SynDecl
{ tcdSExt :: XSynDecl GhcPs
tcdSExt = XSynDecl GhcPs
EpAnn [AddEpAnn]
anns'
, tcdLName :: XRec GhcPs (IdP GhcPs)
tcdLName = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN 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 [GenLocated SrcSpanAnnN RdrName]
-> LHsSigType GhcPs
-> [AddEpAnn]
-> P (LStandaloneKindSig GhcPs)
mkStandaloneKindSig SrcSpan
loc Located [GenLocated SrcSpanAnnN RdrName]
lhs LHsSigType GhcPs
rhs [AddEpAnn]
anns =
do { [GenLocated SrcSpanAnnN RdrName]
vs <- (GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName))
-> [GenLocated SrcSpanAnnN RdrName]
-> P [GenLocated SrcSpanAnnN 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 GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall {m :: * -> *} {a}.
MonadP m =>
GenLocated (SrcSpanAnn' a) RdrName
-> m (GenLocated (SrcSpanAnn' a) RdrName)
check_lhs_name (Located [GenLocated SrcSpanAnnN RdrName]
-> [GenLocated SrcSpanAnnN RdrName]
forall l e. GenLocated l e -> e
unLoc Located [GenLocated SrcSpanAnnN RdrName]
lhs)
; GenLocated SrcSpanAnnN RdrName
v <- [GenLocated SrcSpanAnnN RdrName]
-> P (GenLocated SrcSpanAnnN RdrName)
check_singular_lhs ([GenLocated SrcSpanAnnN RdrName]
-> [GenLocated SrcSpanAnnN RdrName]
forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnN RdrName]
vs)
; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; 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 ann. SrcSpan -> SrcAnn ann
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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
anns EpAnnComments
cs) XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v LHsSigType GhcPs
rhs }
where
check_lhs_name :: GenLocated (SrcSpanAnn' a) RdrName
-> m (GenLocated (SrcSpanAnn' a) RdrName)
check_lhs_name v :: GenLocated (SrcSpanAnn' a) RdrName
v@(GenLocated (SrcSpanAnn' a) 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 (SrcSpanAnn' a) RdrName
-> m (GenLocated (SrcSpanAnn' a) RdrName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated (SrcSpanAnn' a) RdrName
v
else MsgEnvelope PsMessage -> m (GenLocated (SrcSpanAnn' a) RdrName)
forall a. MsgEnvelope PsMessage -> m a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> m (GenLocated (SrcSpanAnn' a) RdrName))
-> MsgEnvelope PsMessage -> m (GenLocated (SrcSpanAnn' a) RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated (SrcSpanAnn' a) RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated (SrcSpanAnn' a) RdrName
v) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> PsMessage
PsErrUnexpectedQualifiedConstructor (GenLocated (SrcSpanAnn' a) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcSpanAnn' a) RdrName
v))
check_singular_lhs :: [GenLocated SrcSpanAnnN RdrName]
-> P (GenLocated SrcSpanAnnN RdrName)
check_singular_lhs [GenLocated SrcSpanAnnN RdrName]
vs =
case [GenLocated SrcSpanAnnN RdrName]
vs of
[] -> String -> P (GenLocated SrcSpanAnnN RdrName)
forall a. HasCallStack => String -> a
panic String
"mkStandaloneKindSig: empty left-hand side"
[GenLocated SrcSpanAnnN RdrName
v] -> GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnN RdrName
v
[GenLocated SrcSpanAnnN RdrName]
_ -> MsgEnvelope PsMessage -> P (GenLocated SrcSpanAnnN RdrName)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (GenLocated SrcSpanAnnN RdrName))
-> MsgEnvelope PsMessage -> P (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (Located [GenLocated SrcSpanAnnN RdrName] -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located [GenLocated SrcSpanAnnN 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)]
[GenLocated SrcSpanAnnN 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 { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
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 = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) ([AddEpAnn]
anns [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Monoid a => a -> a -> a
`mappend` [AddEpAnn]
ann) EpAnnComments
cs
, feqn_tycon :: XRec GhcPs (IdP GhcPs)
feqn_tycon = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
tc
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
, feqn_pats :: [LHsTypeArg GhcPs]
feqn_pats = [LHsTypeArg GhcPs]
[HsArg
(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 { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; let fam_eqn_ans :: EpAnn [AddEpAnn]
fam_eqn_ans = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
ann EpAnnComments
cs) [AddEpAnn]
anns EpAnnComments
emptyComments
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
data_cons <- SrcSpan
-> RdrName
-> Bool
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData SrcSpan
loc (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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
; 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
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 = XCFamEqn GhcPs (HsDataDefn GhcPs)
EpAnn [AddEpAnn]
fam_eqn_ans
, feqn_tycon :: XRec GhcPs (IdP GhcPs)
feqn_tycon = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
tc
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
, feqn_pats :: [LHsTypeArg GhcPs]
feqn_pats = [LHsTypeArg GhcPs]
[HsArg
(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
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
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 ann. SrcSpan -> SrcAnn ann
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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
anns EpAnnComments
cs) 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 { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
; EpAnnComments
cs1 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; LHsQTyVars GhcPs
tyvars <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars (FamilyInfo GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr FamilyInfo GhcPs
info) SDoc
equals_or_where GenLocated SrcSpanAnnN RdrName
tc [LHsTypeArg GhcPs]
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams
; EpAnnComments
cs2 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) [AddEpAnn]
ann (EpAnnComments
cs1 EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
; 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
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 = XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
anns'
, fdTopLevel :: TopLevelFlag
fdTopLevel = TopLevelFlag
topLevel
, fdInfo :: FamilyInfo GhcPs
fdInfo = FamilyInfo GhcPs
info, fdLName :: XRec GhcPs (IdP GhcPs)
fdLName = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN 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 -> P (LHsDecl GhcPs)
mkSpliceDecl :: LHsExpr GhcPs -> P (LHsDecl GhcPs)
mkSpliceDecl lexpr :: LHsExpr GhcPs
lexpr@(L SrcSpanAnnA
loc HsExpr GhcPs
expr)
| HsUntypedSplice XUntypedSplice GhcPs
_ splice :: HsUntypedSplice GhcPs
splice@(HsUntypedSpliceExpr {}) <- HsExpr GhcPs
expr = do
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
loc EpAnnComments
cs) (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
loc HsUntypedSplice GhcPs
splice) SpliceDecoration
DollarSplice)
| HsUntypedSplice XUntypedSplice GhcPs
_ splice :: HsUntypedSplice GhcPs
splice@(HsQuasiQuote {}) <- HsExpr GhcPs
expr = do
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
loc EpAnnComments
cs) (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
loc HsUntypedSplice GhcPs
splice) SpliceDecoration
DollarSplice)
| Bool
otherwise = do
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
loc EpAnnComments
cs) (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
loc (XUntypedSpliceExpr GhcPs -> LHsExpr GhcPs -> HsUntypedSplice GhcPs
forall id.
XUntypedSpliceExpr id -> LHsExpr id -> HsUntypedSplice id
HsUntypedSpliceExpr XUntypedSpliceExpr GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
lexpr))
SpliceDecoration
BareSplice)
mkRoleAnnotDecl :: SrcSpan
-> LocatedN RdrName
-> [Located (Maybe FastString)]
-> [AddEpAnn]
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> [Located (Maybe FastString)]
-> [AddEpAnn]
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl SrcSpan
loc GenLocated SrcSpanAnnN RdrName
tycon [Located (Maybe FastString)]
roles [AddEpAnn]
anns
= do { [GenLocated (SrcAnn NoEpAnns) (Maybe Role)]
roles' <- (Located (Maybe FastString)
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role)))
-> [Located (Maybe FastString)]
-> P [GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc)
(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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
anns EpAnnComments
cs) XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
tycon [XRec GhcPs (Maybe Role)]
[GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (Maybe Role))
parse_role (L SrcSpan
loc_role Maybe FastString
Nothing) = GenLocated (SrcAnn NoEpAnns) (Maybe Role)
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated (SrcAnn NoEpAnns) (Maybe Role)
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role)))
-> GenLocated (SrcAnn NoEpAnns) (Maybe Role)
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role))
forall a b. (a -> b) -> a -> b
$ SrcAnn NoEpAnns
-> Maybe Role -> GenLocated (SrcAnn NoEpAnns) (Maybe Role)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NoEpAnns
forall ann. SrcSpan -> SrcAnn ann
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 (SrcAnn NoEpAnns) (Maybe Role)
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated (SrcAnn NoEpAnns) (Maybe Role)
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role)))
-> GenLocated (SrcAnn NoEpAnns) (Maybe Role)
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role))
forall a b. (a -> b) -> a -> b
$ SrcAnn NoEpAnns
-> Maybe Role -> GenLocated (SrcAnn NoEpAnns) (Maybe Role)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NoEpAnns
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc_role) (Maybe Role -> GenLocated (SrcAnn NoEpAnns) (Maybe Role))
-> Maybe Role -> GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (Maybe Role))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated (SrcAnn NoEpAnns) (Maybe Role)))
-> MsgEnvelope PsMessage
-> P (GenLocated (SrcAnn NoEpAnns) (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. SrcSpanAnn' 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 -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
add_where AddEpAnn
a XHsValBinds GhcPs GhcPs
EpAnn AnnList
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 -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
add_where AddEpAnn
a XHsIPBinds GhcPs GhcPs
EpAnn AnnList
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 -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
add_where an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
_ (EpaSpan RealSrcSpan
rs Maybe BufSpan
_)) (EpAnn Anchor
a (AnnList Maybe Anchor
anc Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs) EpAnnComments
cs2
| RealSrcSpan -> Bool
valid_anchor (Anchor -> RealSrcSpan
anchor Anchor
a)
= Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (Anchor -> [AddEpAnn] -> Anchor
widenAnchor Anchor
a [AddEpAnn
an]) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
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
= Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> Anchor -> Anchor
patch_anchor RealSrcSpan
rs Anchor
a)
(Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList ((Anchor -> Anchor) -> Maybe Anchor -> Maybe Anchor
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcSpan -> Anchor -> Anchor
patch_anchor RealSrcSpan
rs) Maybe Anchor
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 an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
_ (EpaSpan RealSrcSpan
rs Maybe BufSpan
_)) EpAnn AnnList
EpAnnNotUsed EpAnnComments
cs
= Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
rs AnchorOperation
UnchangedAnchor)
(Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (Anchor -> Maybe Anchor) -> Anchor -> Maybe Anchor
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
rs AnchorOperation
UnchangedAnchor) Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [AddEpAnn
an] []) EpAnnComments
cs
add_where (AddEpAnn AnnKeywordId
_ (EpaDelta DeltaPos
_ [LEpaComment]
_)) EpAnn AnnList
_ EpAnnComments
_ = String -> EpAnn AnnList
forall a. HasCallStack => String -> a
panic String
"add_where"
valid_anchor :: RealSrcSpan -> Bool
valid_anchor :: RealSrcSpan -> Bool
valid_anchor RealSrcSpan
r = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
patch_anchor :: RealSrcSpan -> Anchor -> Anchor
patch_anchor :: RealSrcSpan -> Anchor -> Anchor
patch_anchor RealSrcSpan
r1 (Anchor RealSrcSpan
r0 AnchorOperation
op) = RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
r AnchorOperation
op
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
fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn EpAnn AnnList
EpAnnNotUsed = EpAnn AnnList
forall a. EpAnn a
EpAnnNotUsed
fixValbindsAnn (EpAnn Anchor
anchor (AnnList Maybe Anchor
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
= (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (Anchor -> [AddEpAnn] -> Anchor
widenAnchor Anchor
anchor ((TrailingAnn -> AddEpAnn) -> [TrailingAnn] -> [AddEpAnn]
forall a b. (a -> b) -> [a] -> [b]
map TrailingAnn -> AddEpAnn
trailingAnnToAddEpAnn [TrailingAnn]
t)) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
stmtsAnchor :: Located (OrdList AddEpAnn,a) -> Anchor
stmtsAnchor :: forall a. Located (OrdList AddEpAnn, a) -> Anchor
stmtsAnchor (L SrcSpan
l ((ConsOL (AddEpAnn AnnKeywordId
_ (EpaSpan RealSrcSpan
r Maybe BufSpan
_)) OrdList AddEpAnn
_), a
_))
= Anchor -> RealSrcSpan -> Anchor
widenAnchorR (RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) AnchorOperation
UnchangedAnchor) RealSrcSpan
r
stmtsAnchor (L SrcSpan
l (OrdList AddEpAnn, a)
_) = RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) AnchorOperation
UnchangedAnchor
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
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 =>
[GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' 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 (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
drop_bad_decls [] = [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
drop_bad_decls (L SrcSpanAnn' a
l (SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
d) : [GenLocated (SrcSpanAnn' 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 (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SpliceDecl GhcPs -> PsMessage
PsErrDeclSpliceNotAtTopLevel SpliceDecl GhcPs
d
[GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
drop_bad_decls [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
ds
drop_bad_decls (GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)
d:[GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
ds) = (GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)
dGenLocated (SrcSpanAnn' a) (HsDecl GhcPs)
-> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:) ([GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)])
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
drop_bad_decls [GenLocated (SrcSpanAnn' 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 -> SrcSpanAnnA
forall ann. SrcAnn ann -> SrcAnn ann
removeCommentsA SrcSpanAnnA
loc1) Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs1] (SrcSpanAnnA -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> SrcAnn ann
commentsOnlyA 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 => SrcAnn a -> SrcAnn a -> SrcAnn 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 => SrcAnn a -> SrcAnn a -> SrcAnn 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
= ( SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (GenLocated SrcSpanAnnN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
fun_id1 ([GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a e2 an.
Semigroup a =>
[GenLocated (SrcAnn a) e2]
-> LocatedAn an [GenLocated (SrcAnn 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
$ [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mtchs))
, ([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 :: GenLocated SrcSpanAnnN RdrName
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
tyConToDataCon (L SrcSpanAnnN
loc RdrName
tc)
| String -> Bool
okConOcc (OccName -> String
occNameString OccName
occ)
= GenLocated SrcSpanAnnN RdrName
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
forall a. a -> Either (MsgEnvelope PsMessage) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN 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) (GenLocated SrcSpanAnnN RdrName)
forall a b. a -> Either a b
Left (MsgEnvelope PsMessage
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName))
-> MsgEnvelope PsMessage
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN 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. SrcSpanAnn' 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 :: GenLocated SrcSpanAnnN 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. SrcSpanAnn' 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))
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. SrcSpanAnn' 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 GhcPs
m_ctxt = HsMatchContext GhcPs
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 GhcPs
ctxt = FunRhs { mc_fun :: LIdP (NoGhcTc GhcPs)
mc_fun = LIdP (NoGhcTc GhcPs)
XRec GhcPs (ConLikeP GhcPs)
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 GhcPs
m_ctxt = HsMatchContext GhcPs
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 GhcPs
ctxt = FunRhs { mc_fun :: LIdP (NoGhcTc GhcPs)
mc_fun = LIdP (NoGhcTc GhcPs)
XRec GhcPs (ConLikeP GhcPs)
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. SrcSpanAnn' 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. SrcSpanAnn' 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 :: EpAnn [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 :: EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs)
-> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
name Maybe [LHsTyVarBndr Specificity GhcPs]
mb_forall Maybe (LHsContext GhcPs)
mb_cxt HsConDeclH98Details GhcPs
args
= ConDeclH98 { con_ext :: XConDeclH98 GhcPs
con_ext = XConDeclH98 GhcPs
EpAnn [AddEpAnn]
ann
, con_name :: XRec GhcPs (IdP GhcPs)
con_name = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN 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)
-> LHsUniToken "::" "∷" GhcPs
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl :: SrcSpan
-> NonEmpty (GenLocated SrcSpanAnnN RdrName)
-> LHsUniToken "::" "\8759" GhcPs
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl SrcSpan
loc NonEmpty (GenLocated SrcSpanAnnN RdrName)
names LHsUniToken "::" "\8759" GhcPs
dcol LHsSigType GhcPs
ty = do
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
let l :: SrcSpanAnnA
l = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc
(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
af HsArrow GhcPs
hsArr (L SrcSpanAnnA
loc' (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
rf)) LHsType GhcPs
res_ty) -> do
let an' :: EpAnn AnnList
an' = SrcSpan -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
forall a.
Monoid a =>
SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
addCommentsToEpAnn (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc') XRecTy GhcPs
EpAnn AnnList
an (EpAnn NoEpAnns -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments XFunTy GhcPs
EpAnn NoEpAnns
af)
GenLocated TokenLocation (HsUniToken "->" "\8594")
arr <- case HsArrow GhcPs
hsArr of
HsUnrestrictedArrow LHsUniToken "->" "\8594" GhcPs
arr -> GenLocated TokenLocation (HsUniToken "->" "\8594")
-> P (GenLocated TokenLocation (HsUniToken "->" "\8594"))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return LHsUniToken "->" "\8594" GhcPs
GenLocated TokenLocation (HsUniToken "->" "\8594")
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. GenLocated (SrcSpanAnn' 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)
GenLocated TokenLocation (HsUniToken "->" "\8594")
-> P (GenLocated TokenLocation (HsUniToken "->" "\8594"))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok
(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 ( XRec GhcPs [LConDeclField GhcPs]
-> LHsUniToken "->" "\8594" GhcPs -> HsConDeclGADTDetails GhcPs
forall pass.
XRec pass [LConDeclField pass]
-> LHsUniToken "->" "\8594" pass -> HsConDeclGADTDetails pass
RecConGADT (SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnList -> SrcSpan -> SrcSpanAnnL
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnList
an' (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc')) [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
rf) LHsUniToken "->" "\8594" GhcPs
GenLocated TokenLocation (HsUniToken "->" "\8594")
arr, LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
res_ty
, [], EpAnn AnnListItem -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
epAnnComments (SrcSpanAnnA -> EpAnn AnnListItem
forall a. SrcSpanAnn' a -> a
ann 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 ([HsScaled GhcPs (LHsType GhcPs)] -> HsConDeclGADTDetails GhcPs
forall pass.
[HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
arg_types, LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
res_type, [AddEpAnn]
anns, EpAnnComments
cs)
let an :: EpAnn [AddEpAnn]
an = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
annsa (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> 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 = XConDeclGADT GhcPs
EpAnn [AddEpAnn]
an
, con_names :: NonEmpty (XRec GhcPs (IdP GhcPs))
con_names = NonEmpty (XRec GhcPs (IdP GhcPs))
NonEmpty (GenLocated SrcSpanAnnN RdrName)
names
, con_dcolon :: LHsUniToken "::" "\8759" GhcPs
con_dcolon = LHsUniToken "::" "\8759" GhcPs
dcol
, con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs = SrcSpanAnnA
-> HsOuterSigTyVarBndrs GhcPs
-> GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty) 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
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs)
checkTyVars SDoc
pp_what SDoc
equals_or_where GenLocated SrcSpanAnnN RdrName
tc [LHsTypeArg GhcPs]
tparms
= do { [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
tvs <- (HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)))
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType 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 HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
check [LHsTypeArg GhcPs]
[HsArg
(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 () GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
tvs) }
where
check :: HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
check (HsTypeArg SrcSpan
_ ki :: GenLocated SrcSpanAnnA (HsType GhcPs)
ki@(L SrcSpanAnnA
loc HsType GhcPs
_)) = MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)))
-> MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () 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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LHsType GhcPs -> SDoc -> RdrName -> PsMessage
PsErrUnexpectedTypeAppInDecl LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki SDoc
pp_what (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tc))
check (HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
ty) = [AddEpAnn]
-> [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs)
chkParens [] [] EpAnnComments
emptyComments LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
check (HsArgPar SrcSpan
sp) = MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)))
-> MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
sp (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(SDoc -> RdrName -> PsMessage
PsErrMalformedDecl SDoc
pp_what (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tc))
chkParens :: [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs)
chkParens :: [AddEpAnn]
-> [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs)
chkParens [AddEpAnn]
ops [AddEpAnn]
cps EpAnnComments
cs (L SrcSpanAnnA
l (HsParTy XParTy GhcPs
an LHsType 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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
in
[AddEpAnn]
-> [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs)
chkParens (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnn AnnParen -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
epAnnComments XParTy GhcPs
EpAnn AnnParen
an) LHsType GhcPs
ty
chkParens [AddEpAnn]
ops [AddEpAnn]
cps EpAnnComments
cs LHsType GhcPs
ty = [AddEpAnn]
-> [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs)
chk [AddEpAnn]
ops [AddEpAnn]
cps EpAnnComments
cs LHsType GhcPs
ty
chk :: [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> LHsType GhcPs -> P (LHsTyVarBndr () GhcPs)
chk :: [AddEpAnn]
-> [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs)
chk [AddEpAnn]
ops [AddEpAnn]
cps EpAnnComments
cs (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 () 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 -> [AddEpAnn] -> SrcSpanAnnA
forall an. SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an
widenLocatedAn (SrcSpanAnnA
l SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA
annt) [AddEpAnn]
an)
(XKindedTyVar GhcPs
-> ()
-> XRec GhcPs (IdP GhcPs)
-> LHsType GhcPs
-> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar (EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (XKindSig GhcPs
EpAnn [AddEpAnn]
annk EpAnn [AddEpAnn] -> EpAnn [AddEpAnn] -> EpAnn [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> XTyVar GhcPs
EpAnn [AddEpAnn]
ann) [AddEpAnn]
an EpAnnComments
cs) () (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lv RdrName
tv) LHsType GhcPs
k))
chk [AddEpAnn]
ops [AddEpAnn]
cps EpAnnComments
cs (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 () 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 -> [AddEpAnn] -> SrcSpanAnnA
forall an. SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an
widenLocatedAn SrcSpanAnnA
l [AddEpAnn]
an)
(XUserTyVar GhcPs
-> () -> XRec GhcPs (IdP GhcPs) -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar (EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns XTyVar GhcPs
EpAnn [AddEpAnn]
ann [AddEpAnn]
an EpAnnComments
cs) () (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
ltv RdrName
tv)))
chk [AddEpAnn]
_ [AddEpAnn]
_ EpAnnComments
_ t :: LHsType GhcPs
t@(L SrcSpanAnnA
loc HsType GhcPs
_)
= MsgEnvelope PsMessage -> P (LHsTyVarBndr () GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (LHsTyVarBndr () GhcPs))
-> MsgEnvelope PsMessage -> P (LHsTyVarBndr () 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. SrcSpanAnn' 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 (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tc) [LHsTypeArg GhcPs]
tparms SDoc
equals_or_where)
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
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsContext GhcPs
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[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 (EpAnn [AddEpAnn]) (LocatedN RdrName) (Maybe (LHsType GhcPs))
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs = (LRuleTyTmVar -> GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs))
-> [LRuleTyTmVar]
-> [GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (RuleBndr GhcPs)
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleTyTmVar -> RuleBndr GhcPs
cvt_one)
where cvt_one :: RuleTyTmVar -> RuleBndr GhcPs
cvt_one (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v Maybe (LHsType GhcPs)
Nothing) = XCRuleBndr GhcPs -> XRec GhcPs (IdP GhcPs) -> RuleBndr GhcPs
forall pass. XCRuleBndr pass -> LIdP pass -> RuleBndr pass
RuleBndr XCRuleBndr GhcPs
EpAnn [AddEpAnn]
ann XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v
cvt_one (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN 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 XRuleBndrSig GhcPs
EpAnn [AddEpAnn]
ann XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v (EpAnn NoEpAnns -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnn NoEpAnns
forall a. EpAnn 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} {ann}.
GenLocated (SrcSpanAnn' a) RuleTyTmVar
-> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
cvt_one
where cvt_one :: GenLocated (SrcSpanAnn' a) RuleTyTmVar
-> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
cvt_one (L SrcSpanAnn' a
l (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v Maybe (LHsType GhcPs)
Nothing))
= SrcAnn ann
-> HsTyVarBndr () GhcPs
-> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnn' a -> SrcAnn ann
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnn' a
l) (XUserTyVar GhcPs
-> () -> XRec GhcPs (IdP GhcPs) -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar GhcPs
EpAnn [AddEpAnn]
ann () ((RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN 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 GenLocated SrcSpanAnnN RdrName
v))
cvt_one (L SrcSpanAnn' a
l (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v (Just LHsType GhcPs
sig)))
= SrcAnn ann
-> HsTyVarBndr () GhcPs
-> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnn' a -> SrcAnn ann
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnn' 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 XKindedTyVar GhcPs
EpAnn [AddEpAnn]
ann () ((RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN 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 GenLocated SrcSpanAnnN 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 =>
GenLocated (SrcSpanAnn' 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 (SrcSpanAnn' a) RdrName -> f ()
check (L SrcSpanAnn' 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
"forall",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 (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(OccName -> PsMessage
PsErrParseErrorOnInput OccName
occ))
check GenLocated (SrcSpanAnn' 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. SrcSpanAnn' 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])
checkTyClHdr :: Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
is_cls LHsType GhcPs
ty
= GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty [] [] [] LexicalFixity
Prefix
where
goL :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL (L SrcSpanAnnA
l HsType GhcPs
ty) [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = SrcSpan
-> HsType GhcPs
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
go (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) HsType GhcPs
ty [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go :: SrcSpan
-> HsType GhcPs
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
go SrcSpan
_ (HsParTy XParTy GhcPs
an (L SrcSpanAnnA
l (HsStarTy XStarTy GhcPs
_ Bool
isUni))) [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops' [AddEpAnn]
cps' LexicalFixity
fix
= do { SrcSpan -> PsMessage -> P ()
addPsMessage (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' 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 -> EpAnn AnnParen -> SrcSpanAnnN
newAnns SrcSpanAnnA
l XParTy GhcPs
EpAnn AnnParen
an
; (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
a' (OccName -> RdrName
Unqual OccName
name), [HsArg
(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') }
go SrcSpan
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ ltc :: XRec GhcPs (IdP GhcPs)
ltc@(L SrcSpanAnnN
_ RdrName
tc)) [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
| RdrName -> Bool
isRdrTc RdrName
tc = (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
ltc, [HsArg
(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)
go SrcSpan
_ (HsOpTy XOpTy GhcPs
_ PromotionFlag
_ LHsType GhcPs
t1 ltc :: XRec GhcPs (IdP GhcPs)
ltc@(L SrcSpanAnnN
_ RdrName
tc) LHsType GhcPs
t2) [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
_fix
| RdrName -> Bool
isRdrTc RdrName
tc = (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
ltc, GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall tm ty. tm -> HsArg tm ty
HsValArg LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall tm ty. tm -> HsArg tm ty
HsValArg LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
(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)
go SrcSpan
l (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty) [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty [HsArg
(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 SrcSpan
l)
go SrcSpan
_ (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
t1 LHsType GhcPs
t2) [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1 (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall tm ty. tm -> HsArg tm ty
HsValArg LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc) [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go SrcSpan
_ (HsAppKindTy XAppKindTy GhcPs
l LHsType GhcPs
ty LHsType GhcPs
ki) [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (SrcSpan
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall tm ty. SrcSpan -> ty -> HsArg tm ty
HsTypeArg XAppKindTy GhcPs
SrcSpan
l LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
kiHsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc) [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go SrcSpan
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts) [] [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
= (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Name -> RdrName
nameRdrName Name
tup_name)
, (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall tm ty. tm -> HsArg tm ty
HsValArg [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)
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 SrcSpan
l HsType GhcPs
_ [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
_ [AddEpAnn]
_ [AddEpAnn]
_ LexicalFixity
_
= MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn]))
-> MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
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
$
(LHsType GhcPs -> PsMessage
PsErrMalformedTyOrClDecl LHsType GhcPs
ty)
newAnns :: SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN
newAnns :: SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN
newAnns (SrcSpanAnn EpAnn AnnListItem
EpAnnNotUsed SrcSpan
l) (EpAnn Anchor
as (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) EpAnnComments
cs) =
let
lr :: RealSrcSpan
lr = RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (Anchor -> RealSrcSpan
anchor Anchor
as)
an :: EpAnn NameAnn
an = (Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
lr AnchorOperation
UnchangedAnchor) (NameAdornment
-> EpaLocation
-> EpaLocation
-> EpaLocation
-> [TrailingAnn]
-> NameAnn
NameAnn NameAdornment
NameParens EpaLocation
o (SrcSpan -> EpaLocation
srcSpan2e SrcSpan
l) EpaLocation
c []) EpAnnComments
cs)
in EpAnn NameAnn -> SrcSpan -> SrcSpanAnnN
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NameAnn
an (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
lr Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
newAnns SrcSpanAnnA
_ EpAnn AnnParen
EpAnnNotUsed = String -> SrcSpanAnnN
forall a. HasCallStack => String -> a
panic String
"missing AnnParen"
newAnns (SrcSpanAnn (EpAnn Anchor
ap (AnnListItem [TrailingAnn]
ta) EpAnnComments
csp) SrcSpan
l) (EpAnn Anchor
as (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) EpAnnComments
cs) =
let
lr :: RealSrcSpan
lr = RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans (Anchor -> RealSrcSpan
anchor Anchor
ap) (Anchor -> RealSrcSpan
anchor Anchor
as)
an :: EpAnn NameAnn
an = (Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
lr AnchorOperation
UnchangedAnchor) (NameAdornment
-> EpaLocation
-> EpaLocation
-> EpaLocation
-> [TrailingAnn]
-> NameAnn
NameAnn NameAdornment
NameParens EpaLocation
o (SrcSpan -> EpaLocation
srcSpan2e SrcSpan
l) EpaLocation
c [TrailingAnn]
ta) (EpAnnComments
csp EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs))
in EpAnn NameAnn -> SrcSpan -> SrcSpanAnnN
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NameAnn
an (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
lr Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
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 =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' 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 =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check (Maybe ModuleName -> LHsExpr GhcPs -> PsMessage
PsErrMDoInFunAppExpr Maybe ModuleName
m) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsLam {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrLambdaInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsCase {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrCaseInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsLamCase XLamCase GhcPs
_ LamCaseVariant
lc_variant MatchGroup GhcPs (LHsExpr GhcPs)
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check (LamCaseVariant -> LHsExpr GhcPs -> PsMessage
PsErrLambdaCaseInFunAppExpr LamCaseVariant
lc_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 =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' 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 =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' 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 =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' 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 {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrLambdaCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdCase {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrCaseCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdLamCase XCmdLamCase GhcPs
_ LamCaseVariant
lc_variant MatchGroup GhcPs (LHsCmd GhcPs)
_ -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check (LamCaseVariant -> LHsCmd GhcPs -> PsMessage
PsErrLambdaCaseCmdInFunAppCmd LamCaseVariant
lc_variant) LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdIf {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' 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 =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' 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 =>
(GenLocated (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' 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 (SrcSpanAnn' a) e -> PsMessage)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated (SrcSpanAnn' a) e -> PsMessage
err GenLocated (SrcSpanAnn' 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 (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated (SrcSpanAnn' a) e
a) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ (GenLocated (SrcSpanAnn' a) e -> PsMessage
err GenLocated (SrcSpanAnn' a) e
a)
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext orig_t :: LHsType GhcPs
orig_t@(L (SrcSpanAnn EpAnn AnnListItem
_ SrcSpan
l) HsType GhcPs
_orig_t) =
([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([],[],EpAnnComments
emptyComments) 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))
= do
let ([EpaLocation]
op,[EpaLocation]
cp,EpAnnComments
cs') = case XTupleTy GhcPs
ann' of
XTupleTy GhcPs
EpAnn AnnParen
EpAnnNotUsed -> ([],[],EpAnnComments
emptyComments)
EpAnn Anchor
_ (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) EpAnnComments
cs -> ([EpaLocation
o],[EpaLocation
c],EpAnnComments
cs)
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnn' (EpAnn AnnContext)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnContext -> SrcSpan -> SrcSpanAnn' (EpAnn AnnContext)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnContext -> EpAnnComments -> EpAnn AnnContext
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l)
(Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing ([EpaLocation]
oparens [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ [EpaLocation]
op) ([EpaLocation]
cp [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ [EpaLocation]
cparens)) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs')) SrcSpan
l) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts)
check ([EpaLocation]
opi,[EpaLocation]
cpi,EpAnnComments
csi) (L SrcSpanAnnA
_lp1 (HsParTy XParTy GhcPs
ann' LHsType GhcPs
ty))
= do
let ([EpaLocation]
op,[EpaLocation]
cp,EpAnnComments
cs') = case XParTy GhcPs
ann' of
XParTy GhcPs
EpAnn AnnParen
EpAnnNotUsed -> ([],[],EpAnnComments
emptyComments)
EpAnn Anchor
_ (AnnParen ParenType
_ EpaLocation
open EpaLocation
close ) EpAnnComments
cs -> ([EpaLocation
open],[EpaLocation
close],EpAnnComments
cs)
([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([EpaLocation]
op[EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++[EpaLocation]
opi,[EpaLocation]
cp[EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++[EpaLocation]
cpi,EpAnnComments
cs' EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
csi) LHsType GhcPs
ty
check ([EpaLocation]
_opi,[EpaLocation]
_cpi,EpAnnComments
_csi) LHsType GhcPs
_t =
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnn' (EpAnn AnnContext)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnContext -> SrcSpan -> SrcSpanAnn' (EpAnn AnnContext)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnContext -> EpAnnComments -> EpAnn AnnContext
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) (Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing [] []) EpAnnComments
emptyComments) SrcSpan
l) [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
orig_t])
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)
checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat e :: LocatedA (PatBuilder GhcPs)
e@(L SrcSpanAnnA
l PatBuilder GhcPs
_) = SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
e [] []
checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
loc (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) -> PV (LPat GhcPs)
GenLocated SrcSpanAnnA (Pat GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (Pat GhcPs) -> PV (LPat GhcPs))
-> (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs
-> PV (LPat GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (Pat GhcPs -> PV (LPat GhcPs)) -> Pat GhcPs -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN 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
}
| Bool -> Bool
not ([HsConPatTyArg GhcPs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsConPatTyArg GhcPs]
tyargs) =
SrcSpan -> PsMessage -> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. SrcSpan -> PsMessage -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> PV (LPat GhcPs))
-> (PsErrInPatDetails -> PsMessage)
-> PsErrInPatDetails
-> PV (LPat GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatBuilder GhcPs -> PsErrInPatDetails -> PsMessage
PsErrInPat PatBuilder GhcPs
e (PsErrInPatDetails -> PV (LPat GhcPs))
-> PsErrInPatDetails -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$ [HsConPatTyArg GhcPs] -> PsErrInPatDetails
PEIP_TypeArgs [HsConPatTyArg GhcPs]
tyargs
| (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))
forall a. SrcSpan -> PsMessage -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (PsErrInPatDetails -> PsMessage)
-> PsErrInPatDetails
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatBuilder GhcPs -> PsErrInPatDetails -> PsMessage
PsErrInPat PatBuilder GhcPs
e (PsErrInPatDetails -> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PsErrInPatDetails -> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ [LPat GhcPs] -> PatIsRecursive -> ParseContext -> PsErrInPatDetails
PEIP_RecPattern [LPat GhcPs]
args PatIsRecursive
YesPatIsRecursive ParseContext
ctx
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
_ (PatBuilderAppType LocatedA (PatBuilder GhcPs)
f LHsToken "@" GhcPs
at HsPatSigType GhcPs
t)) [HsConPatTyArg GhcPs]
tyargs [LPat GhcPs]
args =
SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
loc LocatedA (PatBuilder GhcPs)
f (LHsToken "@" GhcPs -> HsPatSigType GhcPs -> HsConPatTyArg GhcPs
forall p. LHsToken "@" p -> HsPatSigType p -> HsConPatTyArg p
HsConPatTyArg LHsToken "@" GhcPs
at HsPatSigType GhcPs
t HsConPatTyArg GhcPs
-> [HsConPatTyArg GhcPs] -> [HsConPatTyArg GhcPs]
forall a. a -> [a] -> [a]
: [HsConPatTyArg GhcPs]
tyargs) [LPat GhcPs]
args
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
_ (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
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
loc 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 (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)
-> 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)
checkPat SrcSpanAnnA
loc 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))
forall a. SrcSpan -> PsMessage -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' 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 GenLocated SrcSpanAnnN 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)
GenLocated SrcSpanAnnN 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) -> EpAnn [AddEpAnn] -> Pat GhcPs
mkNPat (SrcAnn NoEpAnns
-> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
loc) HsOverLit GhcPs
pos_lit) Maybe NoExtField
Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing EpAnn [AddEpAnn]
forall a. EpAnn 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 {}})))
(EpAnn Anchor
anc [AddEpAnn]
_ EpAnnComments
cs)
| 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 (GenLocated SrcSpanAnnN RdrName
-> LocatedAn NoEpAnns (HsOverLit GhcPs)
-> EpAnn EpaLocation
-> Pat GhcPs
mkNPlusKPat (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
nloc RdrName
n) (SrcAnn NoEpAnns
-> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
lloc) HsOverLit GhcPs
lit)
(Anchor -> EpaLocation -> EpAnnComments -> EpAnn EpaLocation
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc (SrcSpanAnnN -> EpaLocation
forall ann. SrcAnn ann -> EpaLocation
epaLocationFromSrcAnn SrcSpanAnnN
l) EpAnnComments
cs))
PatBuilderOpApp LocatedA (PatBuilder GhcPs)
_ GenLocated SrcSpanAnnN RdrName
op LocatedA (PatBuilder GhcPs)
_ EpAnn [AddEpAnn]
_ | RdrName -> Bool
opIsAt (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnN 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 EpAnn [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 = XConPat GhcPs
EpAnn [AddEpAnn]
anns
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN 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 LHsToken "(" GhcPs
lpar LocatedA (PatBuilder GhcPs)
e LHsToken ")" GhcPs
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
-> LHsToken "(" GhcPs
-> LPat GhcPs
-> LHsToken ")" GhcPs
-> Pat GhcPs
forall p.
XParPat p -> LHsToken "(" p -> LPat p -> LHsToken ")" p -> Pat p
ParPat (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)) NoEpAnns
NoEpAnns EpAnnComments
emptyComments) LHsToken "(" GhcPs
lpar LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p LHsToken ")" GhcPs
rpar)
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. SrcSpanAnn' 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 = GenLocated SrcSpanAnnN RdrName -> PV (LocatedA b)
forall b.
DisambECP b =>
GenLocated SrcSpanAnnN RdrName -> PV (LocatedA b)
mkHsVarPV (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an 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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
fld) = do GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
fld)
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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)
-> Maybe (AddEpAnn, LHsType GhcPs)
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
checkValDef :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> Maybe (AddEpAnn, LHsType GhcPs)
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (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 (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn 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
-> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc [] LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs Maybe (AddEpAnn, LHsType GhcPs)
Nothing Located (GRHSs GhcPs (LHsExpr GhcPs))
g
= do { Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder GhcPs)], [AddEpAnn])
mb_fun <- LocatedA (PatBuilder GhcPs)
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder GhcPs)], [AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
lhs
; case Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder GhcPs)], [AddEpAnn])
mb_fun of
Just (GenLocated SrcSpanAnnN RdrName
fun, LexicalFixity
is_infix, [LocatedA (PatBuilder GhcPs)]
pats, [AddEpAnn]
ann) ->
SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> LexicalFixity
-> [LocatedA (PatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkFunBind SrcStrictness
NoSrcStrict SrcSpan
loc [AddEpAnn]
ann
GenLocated SrcSpanAnnN RdrName
fun LexicalFixity
is_infix [LocatedA (PatBuilder GhcPs)]
pats Located (GRHSs GhcPs (LHsExpr GhcPs))
g
Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder GhcPs)], [AddEpAnn])
Nothing -> do
GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' <- LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern LocatedA (PatBuilder GhcPs)
lhs
SrcSpan
-> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc [] LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' Located (GRHSs GhcPs (LHsExpr GhcPs))
g }
checkFunBind :: SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> LocatedN RdrName
-> LexicalFixity
-> [LocatedA (PatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
checkFunBind :: SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> LexicalFixity
-> [LocatedA (PatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkFunBind SrcStrictness
strictness SrcSpan
locF [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
fun LexicalFixity
is_infix [LocatedA (PatBuilder 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 (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [LocatedA (PatBuilder 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 (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat [LocatedA (PatBuilder GhcPs)]
pats)
let match_span :: SrcSpanAnnA
match_span = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan
locF
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
locF
HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind GenLocated SrcSpanAnnN 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnL) -> SrcSpan -> SrcSpanAnnL
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' 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 = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
locF) [AddEpAnn]
ann EpAnnComments
cs
, m_ctxt :: HsMatchContext GhcPs
m_ctxt = FunRhs
{ mc_fun :: LIdP (NoGhcTc GhcPs)
mc_fun = LIdP (NoGhcTc GhcPs)
GenLocated SrcSpanAnnN 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 -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
fun) PatIncompleteDoBlock
NoIncompleteDoBlock
| Bool
otherwise = ParseContext
noParseContext
makeFunBind :: LocatedN RdrName -> LocatedL [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
makeFunBind :: GenLocated SrcSpanAnnN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind GenLocated SrcSpanAnnN 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)
GenLocated SrcSpanAnnN 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
-> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
checkPatBind :: SrcSpan
-> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc [AddEpAnn]
annsIn (L SrcSpanAnnA
_ (BangPat (EpAnn Anchor
_ [AddEpAnn]
ans EpAnnComments
cs) (L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ XRec GhcPs (IdP GhcPs)
v))))
(L SrcSpan
_match_span GRHSs GhcPs (LHsExpr GhcPs)
grhss)
= HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN 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 ann. SrcSpan -> SrcAnn ann
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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) ([AddEpAnn]
ans[AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++[AddEpAnn]
annsIn) EpAnnComments
cs) XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v)]))
where
m :: EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m EpAnn [AddEpAnn]
a GenLocated SrcSpanAnnN RdrName
v = Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
a
, m_ctxt :: HsMatchContext GhcPs
m_ctxt = FunRhs { mc_fun :: LIdP (NoGhcTc GhcPs)
mc_fun = LIdP (NoGhcTc GhcPs)
GenLocated SrcSpanAnnN 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 [AddEpAnn]
annsIn LPat GhcPs
lhs (L SrcSpan
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss) = do
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
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
-> GRHSs GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL -> GRHSs idR (LHsExpr idR) -> HsBindLR idL idR
PatBind (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
annsIn EpAnnComments
cs) LPat GhcPs
lhs GRHSs GhcPs (LHsExpr GhcPs)
grhss)
checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
checkValSigLhs :: LHsExpr GhcPs -> P (GenLocated SrcSpanAnnN RdrName)
checkValSigLhs (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ lrdr :: XRec GhcPs (IdP GhcPs)
lrdr@(L SrcSpanAnnN
_ RdrName
v)))
| RdrName -> Bool
isUnqual RdrName
v
, Bool -> Bool
not (OccName -> Bool
isDataOcc (RdrName -> OccName
rdrNameOcc RdrName
v))
= GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
lrdr
checkValSigLhs lhs :: LHsExpr GhcPs
lhs@(L SrcSpanAnnA
l HsExpr GhcPs
_)
= MsgEnvelope PsMessage -> P (GenLocated SrcSpanAnnN RdrName)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (GenLocated SrcSpanAnnN RdrName))
-> MsgEnvelope PsMessage -> P (GenLocated SrcSpanAnnN 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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> PsMessage
PsErrInvalidTypeSignature 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 LocatedA a
guardExpr Bool
semiThen LocatedA b
thenExpr Bool
semiElse LocatedA 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 (LocatedA a -> a
forall l e. GenLocated l e -> e
unLoc LocatedA a
guardExpr)
Bool
semiThen (LocatedA b -> b
forall l e. GenLocated l e -> e
unLoc LocatedA b
thenExpr)
Bool
semiElse (LocatedA c -> c
forall l e. GenLocated l e -> e
unLoc LocatedA c
elseExpr)
loc :: SrcSpan
loc = Located a -> Located c -> SrcSpan
forall a b. Located a -> Located b -> SrcSpan
combineLocs (LocatedA a -> Located a
forall a e. LocatedAn a e -> Located e
reLoc LocatedA a
guardExpr) (LocatedA c -> Located c
forall a e. LocatedAn a e -> Located e
reLoc LocatedA 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 (PatBuilder GhcPs)],[AddEpAnn]))
isFunLhs :: LocatedA (PatBuilder GhcPs)
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder GhcPs)], [AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
e = LocatedA (PatBuilder GhcPs)
-> [LocatedA (PatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder GhcPs)], [AddEpAnn]))
forall {m :: * -> *} {p}.
Monad m =>
LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> [AddEpAnn]
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
e [] [] []
where
go :: LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> [AddEpAnn]
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
go (L SrcSpanAnnA
_ (PatBuilderVar (L SrcSpanAnnN
loc RdrName
f))) [LocatedA (PatBuilder p)]
es [AddEpAnn]
ops [AddEpAnn]
cps
| Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
f) = Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
forall a. a -> Maybe a
Just (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc RdrName
f, LexicalFixity
Prefix, [LocatedA (PatBuilder p)]
es, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps))
go (L SrcSpanAnnA
_ (PatBuilderApp LocatedA (PatBuilder p)
f LocatedA (PatBuilder p)
e)) [LocatedA (PatBuilder p)]
es [AddEpAnn]
ops [AddEpAnn]
cps = LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> [AddEpAnn]
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder p)
f (LocatedA (PatBuilder p)
eLocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
:[LocatedA (PatBuilder p)]
es) [AddEpAnn]
ops [AddEpAnn]
cps
go (L SrcSpanAnnA
l (PatBuilderPar LHsToken "(" p
_ LocatedA (PatBuilder p)
e LHsToken ")" p
_)) es :: [LocatedA (PatBuilder p)]
es@(LocatedA (PatBuilder p)
_:[LocatedA (PatBuilder p)]
_) [AddEpAnn]
ops [AddEpAnn]
cps
= 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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
in
LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> [AddEpAnn]
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder p)
e [LocatedA (PatBuilder p)]
es (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps)
go (L SrcSpanAnnA
loc (PatBuilderOpApp LocatedA (PatBuilder p)
l (L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder p)
r (EpAnn Anchor
loca [AddEpAnn]
anns EpAnnComments
cs))) [LocatedA (PatBuilder p)]
es [AddEpAnn]
ops [AddEpAnn]
cps
| Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
op)
= Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
forall a. a -> Maybe a
Just (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
op, LexicalFixity
Infix, (LocatedA (PatBuilder p)
lLocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
:LocatedA (PatBuilder p)
rLocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
:[LocatedA (PatBuilder p)]
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 { Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
mb_l <- LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> [AddEpAnn]
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder p)
l [LocatedA (PatBuilder p)]
es [AddEpAnn]
ops [AddEpAnn]
cps
; case Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
mb_l of
Just (GenLocated SrcSpanAnnN RdrName
op', LexicalFixity
Infix, LocatedA (PatBuilder p)
j : LocatedA (PatBuilder p)
k : [LocatedA (PatBuilder p)]
es', [AddEpAnn]
anns')
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnN RdrName
op', LexicalFixity
Infix, LocatedA (PatBuilder p)
j LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
: LocatedA (PatBuilder p)
op_app LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
: [LocatedA (PatBuilder p)]
es', [AddEpAnn]
anns'))
where
op_app :: LocatedA (PatBuilder p)
op_app = SrcSpanAnnA -> PatBuilder p -> LocatedA (PatBuilder p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LocatedA (PatBuilder p)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder p)
-> EpAnn [AddEpAnn]
-> PatBuilder p
forall p.
LocatedA (PatBuilder p)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder p)
-> EpAnn [AddEpAnn]
-> PatBuilder p
PatBuilderOpApp LocatedA (PatBuilder p)
k
(SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder p)
r (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
loca ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops[AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++[AddEpAnn]
cps) EpAnnComments
cs))
Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
_ -> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
forall a. Maybe a
Nothing }
go LocatedA (PatBuilder p)
_ [LocatedA (PatBuilder p)]
_ [AddEpAnn]
_ [AddEpAnn]
_ = Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (PatBuilder p)], [AddEpAnn])
forall a. Maybe a
Nothing
mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy EpAnn [AddEpAnn]
anns SrcStrictness
strictness =
XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy XBangTy GhcPs
EpAnn [AddEpAnn]
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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
EpAnnComments
cs <- SrcSpan -> m EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l'
let an :: EpAnn [AddEpAnn]
an = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l') [AddEpAnn]
anns EpAnnComments
cs
t' :: HsType GhcPs
t' = EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness EpAnn [AddEpAnn]
an 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l') HsType GhcPs
t')
where
addUnpackedness :: EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness EpAnn [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 (EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns EpAnn [AddEpAnn]
an (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns XBangTy GhcPs
EpAnn [AddEpAnn]
x) (EpAnn [AddEpAnn] -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
epAnnComments XBangTy GhcPs
EpAnn [AddEpAnn]
x)) (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
prag SrcUnpackedness
unpk SrcStrictness
strictness) LHsType GhcPs
t
addUnpackedness EpAnn [AddEpAnn]
an GenLocated SrcSpanAnnA (HsType GhcPs)
t
= XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy XBangTy GhcPs
EpAnn [AddEpAnn]
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 :: SrcSpan -> (EpAnnComments -> EpAnn EpAnnUnboundVar) -> PV (Located b)
instance DisambInfixOp (HsExpr GhcPs) where
mkHsVarOpPV :: GenLocated SrcSpanAnnN RdrName -> PV (LocatedN (HsExpr GhcPs))
mkHsVarOpPV GenLocated SrcSpanAnnN 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 (GenLocated SrcSpanAnnN RdrName -> SrcSpanAnnN
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnN 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)
GenLocated SrcSpanAnnN RdrName
v)
mkHsConOpPV :: GenLocated SrcSpanAnnN RdrName -> PV (LocatedN (HsExpr GhcPs))
mkHsConOpPV GenLocated SrcSpanAnnN 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 (GenLocated SrcSpanAnnN RdrName -> SrcSpanAnnN
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnN 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)
GenLocated SrcSpanAnnN RdrName
v)
mkHsInfixHolePV :: SrcSpan
-> (EpAnnComments -> EpAnn EpAnnUnboundVar)
-> PV (Located (HsExpr GhcPs))
mkHsInfixHolePV SrcSpan
l EpAnnComments -> EpAnn EpAnnUnboundVar
ann = do
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr (EpAnnComments -> EpAnn EpAnnUnboundVar
ann EpAnnComments
cs))
instance DisambInfixOp RdrName where
mkHsConOpPV :: GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
mkHsConOpPV (L SrcSpanAnnN
l RdrName
v) = GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName))
-> GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
v
mkHsVarOpPV :: GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
mkHsVarOpPV (L SrcSpanAnnN
l RdrName
v) = GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName))
-> GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
v
mkHsInfixHolePV :: SrcSpan
-> (EpAnnComments -> EpAnn EpAnnUnboundVar) -> PV (Located RdrName)
mkHsInfixHolePV SrcSpan
l EpAnnComments -> EpAnn EpAnnUnboundVar
_ = MsgEnvelope PsMessage -> PV (Located RdrName)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (Located RdrName))
-> MsgEnvelope PsMessage -> PV (Located RdrName)
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
PsErrInvalidInfixHole
type AnnoBody b
= ( Anno (GRHS GhcPs (LocatedA (Body b GhcPs))) ~ SrcAnn NoEpAnns
, 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))
mkHsLamPV
:: SrcSpan -> (EpAnnComments -> MatchGroup GhcPs (LocatedA b)) -> PV (LocatedA b)
mkHsLetPV
:: SrcSpan
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> 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)
mkHsLamCasePV :: SrcSpan -> LamCaseVariant
-> (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 -> LHsToken "@" GhcPs -> 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 -> LHsToken "(" GhcPs -> LocatedA b -> LHsToken ")" GhcPs -> PV (LocatedA b)
mkHsVarPV :: LocatedN RdrName -> PV (LocatedA b)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located b)
mkHsOverLitPV :: LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a b)
mkHsWildCardPV :: SrcSpan -> PV (Located b)
mkHsTySigPV
:: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (Located 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 (Located b)
mkHsViewPatPV
:: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkHsAsPatPV
:: SrcSpan -> LocatedN RdrName -> LHsToken "@" GhcPs -> 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)
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. SrcSpanAnn' 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
-> (EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLamPV SrcSpan
l EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg = 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdLam GhcPs -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam XCmdLam GhcPs
NoExtField
NoExtField (EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg EpAnnComments
cs))
mkHsLetPV :: SrcSpan
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLetPV SrcSpan
l LHsToken "let" GhcPs
tkLet HsLocalBinds GhcPs
bs LHsToken "in" GhcPs
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdLet GhcPs
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> LHsCmd GhcPs
-> HsCmd GhcPs
forall id.
XCmdLet id
-> LHsToken "let" id
-> HsLocalBinds id
-> LHsToken "in" id
-> LHsCmd id
-> HsCmd id
HsCmdLet (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) NoEpAnns
NoEpAnns EpAnnComments
cs) LHsToken "let" GhcPs
tkLet HsLocalBinds GhcPs
bs LHsToken "in" GhcPs
tkIn 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 (SrcSpanAnn' a) (HsCmd p)
-> GenLocated (SrcAnn ann) (HsCmdTop p)
cmdArg GenLocated (SrcSpanAnn' a) (HsCmd p)
c = SrcAnn ann -> HsCmdTop p -> GenLocated (SrcAnn ann) (HsCmdTop p)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnn' a -> SrcAnn ann
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l (SrcSpanAnn' a -> SrcAnn ann) -> SrcSpanAnn' a -> SrcAnn ann
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcSpanAnn' a) (HsCmd p) -> SrcSpanAnn' a
forall l e. GenLocated l e -> l
getLoc GenLocated (SrcSpanAnn' a) (HsCmd p)
c) (HsCmdTop p -> GenLocated (SrcAnn ann) (HsCmdTop p))
-> HsCmdTop p -> GenLocated (SrcAnn ann) (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 (SrcSpanAnn' 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (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 (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [] []) EpAnnComments
cs) (LocatedN (HsExpr GhcPs) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e. LocatedN e -> LocatedA e
reLocL LocatedN (HsExpr GhcPs)
LocatedN (InfixOp (HsCmd GhcPs))
op) LexicalFixity
Infix Maybe Fixity
forall a. Maybe a
Nothing [GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
forall {p} {a} {ann}.
(XCmdTop p ~ NoExtField,
XRec p (HsCmd p) ~ GenLocated (SrcSpanAnn' a) (HsCmd p)) =>
GenLocated (SrcSpanAnn' a) (HsCmd p)
-> GenLocated (SrcAnn ann) (HsCmdTop p)
cmdArg GenLocated SrcSpanAnnA (HsCmd GhcPs)
c1, GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
forall {p} {a} {ann}.
(XCmdTop p ~ NoExtField,
XRec p (HsCmd p) ~ GenLocated (SrcSpanAnn' a) (HsCmd p)) =>
GenLocated (SrcSpanAnn' a) (HsCmd p)
-> GenLocated (SrcAnn ann) (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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdCase GhcPs
-> LHsExpr GhcPs -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase (Anchor -> EpAnnHsCase -> EpAnnComments -> EpAnn EpAnnHsCase
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) EpAnnHsCase
anns EpAnnComments
cs) LHsExpr GhcPs
c MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg)
mkHsLamCasePV :: SrcSpan
-> LamCaseVariant
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLamCasePV SrcSpan
l LamCaseVariant
lc_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
-> LamCaseVariant
-> LocatedL
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LamCaseVariant
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup Origin
FromSource LamCaseVariant
lc_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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdLamCase GhcPs
-> LamCaseVariant -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id.
XCmdLamCase id
-> LamCaseVariant -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLamCase (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) LamCaseVariant
lc_variant 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
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
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 (RealSrcSpan -> EpAnnComments -> EpAnn NoEpAnns
comment (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) EpAnnComments
cs) LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LHsExpr GhcPs
LocatedA (FunArg (HsCmd GhcPs))
e)
mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LHsToken "@" GhcPs
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LHsToken "@" GhcPs
_ LHsType GhcPs
t = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (LHsExpr GhcPs
-> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn AnnsIf -> HsCmd GhcPs
mkHsCmdIf LHsExpr GhcPs
c LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
a LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
b (Anchor -> AnnsIf -> EpAnnComments -> EpAnn AnnsIf
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnsIf
anns EpAnnComments
cs))
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdDo GhcPs -> XRec GhcPs [CmdLStmt GhcPs] -> HsCmd GhcPs
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) 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
-> LHsToken "(" GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LHsToken ")" GhcPs
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsParPV SrcSpan
l LHsToken "(" GhcPs
lpar GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LHsToken ")" GhcPs
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdPar GhcPs
-> LHsToken "(" GhcPs
-> LHsCmd GhcPs
-> LHsToken ")" GhcPs
-> HsCmd GhcPs
forall id.
XCmdPar id
-> LHsToken "(" id -> LHsCmd id -> LHsToken ")" id -> HsCmd id
HsCmdPar (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) NoEpAnns
NoEpAnns EpAnnComments
cs) LHsToken "(" GhcPs
lpar LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LHsToken ")" GhcPs
rpar)
mkHsVarPV :: GenLocated SrcSpanAnnN 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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located (HsCmd GhcPs))
mkHsLitPV (L SrcSpan
l HsLit GhcPs
a) = SrcSpan -> SDoc -> PV (Located (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 SrcAnn a
l HsOverLit GhcPs
a) = SrcSpan -> SDoc -> PV (LocatedAn a (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcAnn a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn a
l) (HsOverLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcPs
a)
mkHsWildCardPV :: SrcSpan -> PV (Located (HsCmd GhcPs))
mkHsWildCardPV SrcSpan
l = SrcSpan -> SDoc -> PV (Located (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. SrcSpanAnn' 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 (Located (HsCmd GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
sp) = SrcSpan -> SDoc -> PV (Located (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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsCmd GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
fbinds
if Bool -> Bool
not ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (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 (Located (HsCmd GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (HsCmd GhcPs))
op GenLocated SrcSpanAnnA (HsCmd GhcPs)
c = SrcSpan -> SDoc -> PV (Located (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (Located (HsCmd GhcPs)))
-> SDoc -> PV (Located (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
-> GenLocated SrcSpanAnnN RdrName
-> LHsToken "@" GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v LHsToken "@" GhcPs
_ 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 (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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. SrcSpanAnn' 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)
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 -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup :: SrcSpan -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup SrcSpan
l (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
_ 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. SrcSpanAnn' 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 (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn 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
-> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
fields LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
isPun (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs)
mkHsLamPV :: SrcSpan
-> (EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLamPV SrcSpan
l EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg = 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' = EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg EpAnnComments
cs
SrcSpan -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup SrcSpan
l 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
NoExtField
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg')
mkHsLetPV :: SrcSpan
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLetPV SrcSpan
l LHsToken "let" GhcPs
tkLet HsLocalBinds GhcPs
bs LHsToken "in" GhcPs
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XLet GhcPs
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> LHsExpr GhcPs
-> HsExpr GhcPs
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) NoEpAnns
NoEpAnns EpAnnComments
cs) LHsToken "let" GhcPs
tkLet HsLocalBinds GhcPs
bs LHsToken "in" GhcPs
tkIn 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [] EpAnnComments
cs) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 (LocatedN (HsExpr GhcPs) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e. LocatedN e -> LocatedA e
reLocL 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCase GhcPs
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase (Anchor -> EpAnnHsCase -> EpAnnComments -> EpAnn EpAnnHsCase
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) EpAnnHsCase
anns EpAnnComments
cs) LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg)
mkHsLamCasePV :: SrcSpan
-> LamCaseVariant
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLamCasePV SrcSpan
l LamCaseVariant
lc_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
-> LamCaseVariant
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LamCaseVariant
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup Origin
FromSource LamCaseVariant
lc_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)
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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XLamCase GhcPs
-> LamCaseVariant
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) LamCaseVariant
lc_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
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
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 (RealSrcSpan -> EpAnnComments -> EpAnn NoEpAnns
comment (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) EpAnnComments
cs) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LHsExpr GhcPs
LocatedA (FunArg (HsExpr GhcPs))
e2)
mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LHsToken "@" GhcPs
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e LHsToken "@" GhcPs
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
-> LHsToken "@" GhcPs
-> LHsWcType (NoGhcTc GhcPs)
-> HsExpr GhcPs
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcPs
NoExtField
noExtField LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e LHsToken "@" GhcPs
at (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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn AnnsIf -> HsExpr GhcPs
mkHsIf LHsExpr GhcPs
c LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b (Anchor -> AnnsIf -> EpAnnComments -> EpAnn AnnsIf
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnsIf
anns EpAnnComments
cs))
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XDo GhcPs
-> HsDoFlavour -> XRec GhcPs [ExprLStmt GhcPs] -> HsExpr GhcPs
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) (Maybe ModuleName -> HsDoFlavour
DoExpr Maybe ModuleName
mod) XRec GhcPs [ExprLStmt GhcPs]
LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts)
mkHsParPV :: SrcSpan
-> LHsToken "(" GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LHsToken ")" GhcPs
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsParPV SrcSpan
l LHsToken "(" GhcPs
lpar GenLocated SrcSpanAnnA (HsExpr GhcPs)
e LHsToken ")" GhcPs
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XPar GhcPs
-> LHsToken "(" GhcPs
-> LHsExpr GhcPs
-> LHsToken ")" GhcPs
-> HsExpr GhcPs
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) NoEpAnns
NoEpAnns EpAnnComments
cs) LHsToken "(" GhcPs
lpar LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e LHsToken ")" GhcPs
rpar)
mkHsVarPV :: GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsVarPV v :: GenLocated SrcSpanAnnN RdrName
v@(L SrcSpanAnnN
l RdrName
_) = 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 (SrcSpanAnnN -> SrcSpanAnnA
forall a ann. SrcSpanAnn' a -> SrcAnn ann
na2la SrcSpanAnnN
l) (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)
GenLocated SrcSpanAnnN RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located (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
Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit (RealSrcSpan -> EpAnnComments -> EpAnn NoEpAnns
comment (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) EpAnnComments
cs) HsLit GhcPs
a)
mkHsOverLitPV :: forall a.
LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
mkHsOverLitPV (L SrcAnn a
l HsOverLit GhcPs
a) = do
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcAnn a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn a
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
$ SrcAnn a -> HsExpr GhcPs -> LocatedAn a (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcAnn a
l (XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit (RealSrcSpan -> EpAnnComments -> EpAnn NoEpAnns
comment (SrcSpan -> RealSrcSpan
realSrcSpan (SrcAnn a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn a
l)) EpAnnComments
cs) HsOverLit GhcPs
a)
mkHsWildCardPV :: SrcSpan -> PV (Located (HsExpr GhcPs))
mkHsWildCardPV SrcSpan
l = Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn)
mkHsTySigPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsTySigPV SrcSpanAnnA
l 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. SrcSpanAnn' 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 SrcSpanAnnA
l (XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XExplicitList GhcPs -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (Located (HsExpr GhcPs))
mkHsSplicePV sp :: Located (HsUntypedSplice GhcPs)
sp@(L SrcSpan
l HsUntypedSplice GhcPs
_) = do
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ (HsUntypedSplice GhcPs -> HsExpr GhcPs)
-> Located (HsUntypedSplice GhcPs) -> Located (HsExpr GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan 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 (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) NoEpAnns
NoEpAnns EpAnnComments
cs)) Located (HsUntypedSplice GhcPs)
sp
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)
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate Bool
opts LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a SrcSpan
lrec ([Fbind (HsExpr GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs)
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XNegApp GhcPs -> LHsExpr GhcPs -> SyntaxExpr GhcPs -> HsExpr GhcPs
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) 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 (Located (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
Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XSectionR GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR (RealSrcSpan -> EpAnnComments -> EpAnn NoEpAnns
comment (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) EpAnnComments
cs) 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn))
mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> LHsToken "@" GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v LHsToken "@" GhcPs
_ 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 (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn 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
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. SrcSpanAnn' 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 :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
anns = XUnboundVar GhcPs -> RdrName -> HsExpr GhcPs
forall p. XUnboundVar p -> RdrName -> HsExpr p
HsUnboundVar XUnboundVar GhcPs
EpAnn EpAnnUnboundVar
anns (OccName -> RdrName
mkRdrUnqual (FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"_")))
type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs))) = SrcAnn NoEpAnns
type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL
type instance Anno (Match GhcPs (LocatedA (PatBuilder GhcPs))) = SrcSpanAnnA
type instance Anno (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs))) = SrcSpanAnnA
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. SrcSpanAnn' 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. SrcSpanAnn' 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
mkHsLamPV :: SrcSpan
-> (EpAnnComments
-> MatchGroup GhcPs (LocatedA (PatBuilder GhcPs)))
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLamPV SrcSpan
l EpAnnComments -> MatchGroup GhcPs (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
PsErrLambdaInPat
mkHsLetPV :: SrcSpan
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLetPV SrcSpan
l LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
_ LHsToken "in" GhcPs
_ 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
let anns :: EpAnn [AddEpAnn]
anns = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [] EpAnnComments
cs
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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs))
-> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ LocatedA (PatBuilder GhcPs)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder GhcPs)
-> EpAnn [AddEpAnn]
-> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder p)
-> EpAnn [AddEpAnn]
-> PatBuilder p
PatBuilderOpApp LocatedA (PatBuilder GhcPs)
p1 GenLocated SrcSpanAnnN RdrName
LocatedN (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p2 EpAnn [AddEpAnn]
anns
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
mkHsLamCasePV :: SrcSpan
-> LamCaseVariant
-> LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLamCasePV SrcSpan
l LamCaseVariant
lc_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 (LamCaseVariant -> PsMessage
PsErrLambdaCaseInPat LamCaseVariant
lc_variant)
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)
-> LHsToken "@" GhcPs
-> LHsType GhcPs
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAppTypePV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
p LHsToken "@" GhcPs
at LHsType GhcPs
t = do
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
let anns :: EpAnn NoEpAnns
anns = Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t)) NoEpAnns
NoEpAnns EpAnnComments
cs
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)
-> LHsToken "@" GhcPs -> HsPatSigType GhcPs -> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p)
-> LHsToken "@" p -> HsPatSigType GhcPs -> PatBuilder p
PatBuilderAppType LocatedA (PatBuilder GhcPs)
p LHsToken "@" GhcPs
at (EpAnn NoEpAnns -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnn NoEpAnns
anns 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
-> LHsToken "(" GhcPs
-> LocatedA (PatBuilder GhcPs)
-> LHsToken ")" GhcPs
-> PV (LocatedA (PatBuilder GhcPs))
mkHsParPV SrcSpan
l LHsToken "(" GhcPs
lpar LocatedA (PatBuilder GhcPs)
p LHsToken ")" GhcPs
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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (LHsToken "(" GhcPs
-> LocatedA (PatBuilder GhcPs)
-> LHsToken ")" GhcPs
-> PatBuilder GhcPs
forall p.
LHsToken "(" p
-> LocatedA (PatBuilder p) -> LHsToken ")" p -> PatBuilder p
PatBuilderPar LHsToken "(" GhcPs
lpar LocatedA (PatBuilder GhcPs)
p LHsToken ")" GhcPs
rpar)
mkHsVarPV :: GenLocated SrcSpanAnnN RdrName -> PV (LocatedA (PatBuilder GhcPs))
mkHsVarPV v :: GenLocated SrcSpanAnnN RdrName
v@(GenLocated SrcSpanAnnN 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 ann. SrcSpanAnn' a -> SrcAnn ann
na2la SrcSpanAnnN
l) (GenLocated SrcSpanAnnN RdrName -> PatBuilder GhcPs
forall p. GenLocated SrcSpanAnnN RdrName -> PatBuilder p
PatBuilderVar GenLocated SrcSpanAnnN RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located (PatBuilder GhcPs))
mkHsLitPV lit :: Located (HsLit GhcPs)
lit@(L SrcSpan
l HsLit GhcPs
a) = do
Located (HsLit GhcPs) -> PV ()
checkUnboxedLitPat Located (HsLit GhcPs)
lit
Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)))
-> Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PatBuilder GhcPs -> Located (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (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 SrcAnn 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
$ SrcAnn a -> PatBuilder GhcPs -> LocatedAn a (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcAnn a
l (HsOverLit GhcPs -> PatBuilder GhcPs
forall p. HsOverLit GhcPs -> PatBuilder p
PatBuilderOverLit HsOverLit GhcPs
a)
mkHsWildCardPV :: SrcSpan -> PV (Located (PatBuilder GhcPs))
mkHsWildCardPV SrcSpan
l = Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)))
-> Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PatBuilder GhcPs -> Located (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L 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
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' 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
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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p (EpAnn NoEpAnns -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnn NoEpAnns
forall a. EpAnn 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (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 (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps)))
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (Located (PatBuilder GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
sp) = Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)))
-> Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PatBuilder GhcPs -> Located (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (PatBuilder GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs))))]
fbinds
if Bool -> Bool
not ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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))
-> EpAnn [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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
fs Maybe SrcSpan
ddLoc) (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs)
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) 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 (SrcAnn NoEpAnns
-> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
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
let an :: EpAnn [AddEpAnn]
an = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs
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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (LocatedAn NoEpAnns (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs) -> EpAnn [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) EpAnn [AddEpAnn]
an))
mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
-> PV (Located (PatBuilder GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p = SrcSpan -> PsMessage -> PV (Located (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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) LHsExpr GhcPs
a LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p))
mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> LHsToken "@" GhcPs
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v LHsToken "@" GhcPs
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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XAsPat GhcPs
-> XRec GhcPs (IdP GhcPs)
-> LHsToken "@" GhcPs
-> LPat GhcPs
-> Pat GhcPs
forall p. XAsPat p -> LIdP p -> LHsToken "@" p -> LPat p -> Pat p
AsPat (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) NoEpAnns
NoEpAnns EpAnnComments
cs) XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v LHsToken "@" GhcPs
at 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
a EpAnnComments
cs) 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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
an EpAnnComments
cs) 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 (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (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
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)) ->
EpAnn [AddEpAnn] ->
PV (PatBuilder GhcPs)
mkPatRec :: LocatedA (PatBuilder GhcPs)
-> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
-> EpAnn [AddEpAnn]
-> PV (PatBuilder GhcPs)
mkPatRec (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc -> PatBuilderVar GenLocated SrcSpanAnnN RdrName
c) (HsRecFields [LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
fs Maybe (XRec GhcPs RecFieldsDotDot)
dd) EpAnn [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
c)
= do [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fs <- (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
-> PV
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
checkPatField [LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 = XConPat GhcPs
EpAnn [AddEpAnn]
anns
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN 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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fs Maybe (XRec GhcPs RecFieldsDotDot)
dd)
}
mkPatRec LocatedA (PatBuilder GhcPs)
p HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
_ EpAnn [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. GenLocated (SrcSpanAnn' 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 -> SrcSpan -> 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)
-> SrcSpan
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppKindTyPV GenLocated SrcSpanAnnA (HsType GhcPs)
t SrcSpan
l_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
SrcSpan
l_at LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t LHsType GhcPs
ki)
mkHsOpTyPV :: PromotionFlag
-> LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsOpTyPV PromotionFlag
prom LHsType GhcPs
t1 GenLocated SrcSpanAnnN RdrName
op 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 (PromotionFlag
-> LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> LHsType GhcPs
mkLHsOpTy PromotionFlag
prom LHsType GhcPs
t1 GenLocated SrcSpanAnnN RdrName
op LHsType GhcPs
t2)
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 :: DataConBuilder -> LocatedN RdrName
dataConBuilderCon :: DataConBuilder -> GenLocated SrcSpanAnnN RdrName
dataConBuilderCon (PrefixDataConBuilder OrdList (LHsType GhcPs)
_ GenLocated SrcSpanAnnN RdrName
dc) = GenLocated SrcSpanAnnN RdrName
dc
dataConBuilderCon (InfixDataConBuilder LHsType GhcPs
_ GenLocated SrcSpanAnnN RdrName
dc LHsType GhcPs
_) = GenLocated SrcSpanAnnN RdrName
dc
dataConBuilderDetails :: DataConBuilder -> HsConDeclH98Details GhcPs
dataConBuilderDetails :: DataConBuilder -> HsConDeclH98Details GhcPs
dataConBuilderDetails (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds GenLocated SrcSpanAnnN RdrName
_)
| [L SrcSpanAnnA
l_t (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 (EpAnn AnnList -> SrcSpan -> SrcSpanAnnL
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn XRecTy GhcPs
EpAnn AnnList
an (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_t)) [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields)
dataConBuilderDetails (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds GenLocated SrcSpanAnnN 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 a (p :: Pass). 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 (InfixDataConBuilder LHsType GhcPs
lhs GenLocated SrcSpanAnnN 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 a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs) (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a (p :: Pass). 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 GenLocated SrcSpanAnnN 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 ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
(OrdList (LHsType GhcPs)
-> GenLocated SrcSpanAnnN 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) GenLocated SrcSpanAnnN RdrName
fn)
mkHsAppTyPV (L SrcSpanAnnA
_ InfixDataConBuilder{}) LHsType GhcPs
_ =
String -> PV (LocatedA DataConBuilder)
forall a. HasCallStack => String -> a
panic String
"mkHsAppTyPV: InfixDataConBuilder"
mkHsAppKindTyPV :: LocatedA DataConBuilder
-> SrcSpan -> LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppKindTyPV LocatedA DataConBuilder
lhs SrcSpan
l_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 SrcSpan
l_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
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> PV (LocatedA DataConBuilder)
mkHsOpTyPV PromotionFlag
prom LHsType GhcPs
lhs GenLocated SrcSpanAnnN 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)
GenLocated SrcSpanAnnN RdrName
data_con <- Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a.
MonadP m =>
Either (MsgEnvelope PsMessage) a -> m a
eitherToP (Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName))
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
tyConToDataCon GenLocated SrcSpanAnnN RdrName
tc
PromotionFlag -> GenLocated SrcSpanAnnN RdrName -> PV ()
checkNotPromotedDataCon PromotionFlag
prom GenLocated SrcSpanAnnN 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 (LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> DataConBuilder
InfixDataConBuilder LHsType GhcPs
lhs GenLocated SrcSpanAnnN 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 (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn 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. SrcSpanAnn' 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) (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 GenLocated SrcSpanAnnN 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 (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
combineLocsA (Located UnpackednessPragma
-> GenLocated SrcSpanAnnA UnpackednessPragma
forall e ann. Located e -> LocatedAn ann e
reLocA 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
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> DataConBuilder
InfixDataConBuilder LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs' GenLocated SrcSpanAnnN 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
GenLocated SrcSpanAnnN RdrName
data_con <- Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a.
MonadP m =>
Either (MsgEnvelope PsMessage) a -> m a
eitherToP (Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName))
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName
-> Either (MsgEnvelope PsMessage) (GenLocated SrcSpanAnnN RdrName)
tyConToDataCon XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v
PromotionFlag -> GenLocated SrcSpanAnnN RdrName -> PV ()
checkNotPromotedDataCon PromotionFlag
prom GenLocated SrcSpanAnnN 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)
-> GenLocated SrcSpanAnnN RdrName -> DataConBuilder
PrefixDataConBuilder OrdList (LHsType GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. OrdList a
nilOL GenLocated SrcSpanAnnN RdrName
data_con)
tyToDataConBuilder (L SrcSpanAnnA
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts)) = do
let data_con :: GenLocated SrcSpanAnnN RdrName
data_con = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a ann. SrcSpanAnn' a -> SrcAnn ann
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)
-> GenLocated SrcSpanAnnN 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) GenLocated SrcSpanAnnN 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. GenLocated (SrcSpanAnn' 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 -> GenLocated SrcSpanAnnN RdrName -> PV ()
checkNotPromotedDataCon PromotionFlag
NotPromoted GenLocated SrcSpanAnnN 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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
RdrName -> PsMessage
PsErrIllegalPromotionQuoteDataCon RdrName
name
checkPrecP
:: Located (SourceText,Int)
-> Located (OrdList (LocatedN RdrName))
-> P ()
checkPrecP :: Located (SourceText, Int)
-> Located (OrdList (GenLocated SrcSpanAnnN RdrName)) -> P ()
checkPrecP (L SrcSpan
l (SourceText
_,Int
i)) (L SrcSpan
_ OrdList (GenLocated SrcSpanAnnN 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 ()
| (GenLocated SrcSpanAnnN RdrName -> Bool)
-> OrdList (GenLocated SrcSpanAnnN RdrName) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpanAnnN RdrName -> Bool
forall {l}. GenLocated l RdrName -> Bool
specialOp OrdList (GenLocated SrcSpanAnnN 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)
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate :: Bool
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> EpAnn [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) EpAnn [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon RdrName
c
= do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsExpr GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
fbinds
case [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps of
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p:[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (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 (GenLocated SrcSpanAnnN RdrName
-> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN 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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs Maybe SrcSpan
dd) EpAnn [AddEpAnn]
anns)
mkRecConstrOrUpdate Bool
overloaded_update LHsExpr GhcPs
exp SrcSpan
_ ([Fbind (HsExpr GhcPs)]
fs,Maybe SrcSpan
dd) EpAnn [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)]
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_update LHsExpr GhcPs
exp [Fbind (HsExpr GhcPs)]
fs EpAnn [AddEpAnn]
anns
mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> EpAnn [AddEpAnn] -> PV (HsExpr GhcPs)
mkRdrRecordUpd :: Bool
-> LHsExpr GhcPs
-> [Fbind (HsExpr GhcPs)]
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_on exp :: LHsExpr GhcPs
exp@(L SrcSpanAnnA
loc HsExpr GhcPs
_) [Fbind (HsExpr GhcPs)]
fbinds EpAnn [AddEpAnn]
anns = do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsExpr GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
fbinds
fs' :: [LHsRecUpdField GhcPs]
fs' :: [LHsRecUpdField GhcPs]
fs' = (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map ((HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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
HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
mk_rec_upd_field) [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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. SrcSpanAnn' 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 = XRecordUpd GhcPs
EpAnn [AddEpAnn]
anns
, rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
, rupd_flds :: Either [LHsRecUpdField GhcPs] [LHsRecProj GhcPs (LHsExpr GhcPs)]
rupd_flds = [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Either
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. a -> Either a b
Left [LHsRecUpdField GhcPs]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs' }
Bool
True -> do
let qualifiedFields :: [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)]
qualifiedFields =
[ SrcAnn NoEpAnns
-> AmbiguousFieldOcc GhcPs
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l AmbiguousFieldOcc GhcPs
lbl | L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
_ (L SrcAnn NoEpAnns
l AmbiguousFieldOcc GhcPs
lbl) GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ Bool
_) <- [LHsRecUpdField GhcPs]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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
rdrNameAmbiguousFieldOcc (AmbiguousFieldOcc GhcPs -> Bool)
-> AmbiguousFieldOcc GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc GhcPs
lbl
]
case [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)]
qualifiedFields of
GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
qf:[GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
qf) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields
[GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)]
_ -> 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 = XRecordUpd GhcPs
EpAnn [AddEpAnn]
anns
, rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
, rupd_flds :: Either [LHsRecUpdField GhcPs] [LHsRecProj GhcPs (LHsExpr GhcPs)]
rupd_flds = [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Either
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. b -> Either a b
Right ([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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (\case { Right GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p -> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p; Left GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
f -> LHsRecField GhcPs (LHsExpr GhcPs)
-> LHsRecProj GhcPs (LHsExpr GhcPs)
recFieldToProjUpdate LHsRecField GhcPs (LHsExpr GhcPs)
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
anns (L SrcAnn NoEpAnns
_ (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
EpAnn AnnFieldLabel
forall a. EpAnn 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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc
in SrcSpanAnnA
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> EpAnn [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 [SrcAnn NoEpAnns
-> DotFieldOcc GhcPs -> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnN
loc) DotFieldOcc GhcPs
fl]) (FastString -> LHsExpr GhcPs
punnedVar FastString
f) Bool
pun XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
EpAnn [AddEpAnn]
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 a an. a -> LocatedAn an 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 (GenLocated SrcSpanAnnN RdrName -> HsExpr GhcPs)
-> (FastString -> GenLocated SrcSpanAnnN RdrName)
-> FastString
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> (FastString -> RdrName)
-> FastString
-> GenLocated SrcSpanAnnN 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 -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon :: GenLocated SrcSpanAnnN RdrName
-> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon GenLocated SrcSpanAnnN RdrName
con HsRecordBinds GhcPs
flds EpAnn [AddEpAnn]
anns
= RecordCon { rcon_ext :: XRecordCon GhcPs
rcon_ext = XRecordCon GhcPs
EpAnn [AddEpAnn]
anns, rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_con = XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN 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 (Located 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 = Located RecFieldsDotDot -> Maybe (Located RecFieldsDotDot)
forall a. a -> Maybe a
Just (SrcSpan -> RecFieldsDotDot -> Located RecFieldsDotDot
forall l e. l -> e -> GenLocated l e
L SrcSpan
s (Int -> RecFieldsDotDot
RecFieldsDotDot (Int -> RecFieldsDotDot) -> Int -> RecFieldsDotDot
forall a b. (a -> b) -> a -> b
$ [LocatedA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)]
fs)) }
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field (HsFieldBind XHsFieldBind (LFieldOcc GhcPs)
noAnn (L SrcAnn NoEpAnns
loc (FieldOcc XCFieldOcc GhcPs
_ XRec GhcPs RdrName
rdr)) LHsExpr GhcPs
arg Bool
pun)
= XHsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall lhs rhs.
XHsFieldBind lhs -> lhs -> rhs -> Bool -> HsFieldBind lhs rhs
HsFieldBind XHsFieldBind (LFieldOcc GhcPs)
XHsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
noAnn (SrcAnn NoEpAnns
-> AmbiguousFieldOcc GhcPs
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
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 (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkImport :: Located CCallConv
-> Located Safety
-> (Located StringLiteral, GenLocated SrcSpanAnnN RdrName,
LHsSigType GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkImport Located CCallConv
cconv Located Safety
safety (L SrcSpan
loc (StringLiteral SourceText
esrc FastString
entity Maybe RealSrcSpan
_), GenLocated SrcSpanAnnN RdrName
v, LHsSigType GhcPs
ty) =
case Located CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc Located CCallConv
cconv of
CCallConv
CCallConv -> ForeignImport GhcPs -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec (ForeignImport GhcPs -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> P (ForeignImport GhcPs) -> P (EpAnn [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 (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> MsgEnvelope PsMessage -> P (EpAnn [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 (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
imp
CCallConv
StdCallConv -> ForeignImport GhcPs -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec (ForeignImport GhcPs -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> P (ForeignImport GhcPs) -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< P (ForeignImport GhcPs)
mkCImport
CCallConv
PrimCallConv -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
CCallConv
JavaScriptCallConv -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
where
mkCImport :: P (ForeignImport GhcPs)
mkCImport = do
let e :: String
e = FastString -> String
unpackFS FastString
entity
case Located CCallConv
-> Located Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport GhcPs)
forall (p :: Pass).
Located CCallConv
-> Located Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport Located CCallConv
cconv Located Safety
safety (RdrName -> FastString
mkExtName (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkOtherImport = ForeignImport GhcPs -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
importSpec
where
entity' :: FastString
entity' = if FastString -> Bool
nullFS FastString
entity
then RdrName -> FastString
mkExtName (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc SourceText
esrc) XRec GhcPs CCallConv
Located CCallConv
cconv XRec GhcPs Safety
Located Safety
safety Maybe Header
forall a. Maybe a
Nothing CImportSpec
funcTarget
returnSpec :: ForeignImport GhcPs -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
spec = (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \EpAnn [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 = XForeignImport GhcPs
EpAnn [AddEpAnn]
ann
, fd_name :: XRec GhcPs (IdP GhcPs)
fd_name = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v
, fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = LHsSigType GhcPs
ty
, fd_fi :: ForeignImport GhcPs
fd_fi = ForeignImport GhcPs
spec
}
parseCImport :: Located CCallConv -> Located Safety -> FastString -> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport :: forall (p :: Pass).
Located CCallConv
-> Located Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport Located CCallConv
cconv Located 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
Maybe Header -> CImportSpec -> ForeignImport (GhcPass p)
mk (Header -> Maybe Header
forall a. a -> Maybe a
Just (SourceText -> FastString -> Header
Header (String -> SourceText
SourceText String
h) (String -> FastString
mkFastString String
h)))
(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 XCImport (GhcPass p)
Located SourceText
sourceText XRec (GhcPass p) CCallConv
Located CCallConv
cconv XRec (GhcPass p) Safety
Located 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 Located CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc Located 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 (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkExport :: Located CCallConv
-> (Located StringLiteral, GenLocated SrcSpanAnnN RdrName,
LHsSigType GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkExport (L SrcSpan
lc CCallConv
cconv) (L SrcSpan
le (StringLiteral SourceText
esrc FastString
entity Maybe RealSrcSpan
_), GenLocated SrcSpanAnnN RdrName
v, LHsSigType GhcPs
ty)
= (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \EpAnn [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 = XForeignExport GhcPs
EpAnn [AddEpAnn]
ann, fd_name :: XRec GhcPs (IdP GhcPs)
fd_name = XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN 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 (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
le SourceText
esrc) (SrcSpan -> CExportSpec -> GenLocated SrcSpan CExportSpec
forall l e. l -> e -> GenLocated l e
L 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 (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 :: [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp :: [AddEpAnn]
-> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp [AddEpAnn]
anns (L SrcSpanAnnA
l ImpExpQcSpec
specname) ImpExpSubSpec
subs = do
EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
let ann :: EpAnn [AddEpAnn]
ann = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs
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 -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName pass -> IE pass
IEVar XIEVar GhcPs
NoExtField
noExtField (SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec ImpExpQcSpec
specname))
| Bool
otherwise -> XIEThingAbs GhcPs -> LIEWrappedName GhcPs -> IE GhcPs
forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
IEThingAbs XIEThingAbs GhcPs
EpAnn [AddEpAnn]
ann (GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IE GhcPs)
-> (IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> IEWrappedName 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 -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT
ImpExpSubSpec
ImpExpAll -> XIEThingAll GhcPs -> LIEWrappedName GhcPs -> IE GhcPs
forall pass. XIEThingAll pass -> LIEWrappedName pass -> IE pass
IEThingAll XIEThingAll GhcPs
EpAnn [AddEpAnn]
ann (GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IE GhcPs)
-> (IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> IEWrappedName 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 -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT
ImpExpList [LocatedA ImpExpQcSpec]
xs ->
(\IEWrappedName GhcPs
newName -> XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith XIEThingWith GhcPs
EpAnn [AddEpAnn]
ann (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 -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT
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]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith XIEThingWith GhcPs
EpAnn [AddEpAnn]
ann (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 -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT
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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrIllegalPatSynExport
where
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. SrcSpanAnn' 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 GenLocated SrcSpanAnnN RdrName
ln) = GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
ln
ieNameVal (ImpExpQcType EpaLocation
_ GenLocated SrcSpanAnnN RdrName
ln) = GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 -> GenLocated SrcSpanAnnN 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 -> GenLocated SrcSpanAnnN 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 :: GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
mkTypeImpExp GenLocated SrcSpanAnnN RdrName
name =
do Bool
allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ExplicitNamespacesBit
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 SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
name) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrIllegalExplicitNamespace
GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN 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) GenLocated SrcSpanAnnN 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]
_)) <- [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. SrcSpanAnn' 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 a. SrcSpanAnn' a -> EpaLocation
la2e 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 =>
GenLocated SrcSpanAnnN 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. SrcSpanAnn' 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) }
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 ->
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 SrcSpanAnnA
l Boxity
boxity (Tuple [Either
(EpAnn EpaLocation) (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. SrcSpanAnn' 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 SrcSpanAnnA
l (XExplicitTuple GhcPs -> [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) ((Either (EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsTupArg GhcPs)
-> [Either
(EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [HsTupArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
Either (EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsTupArg GhcPs
toTupArg [Either
(EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
es) Boxity
boxity)
where
toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg (Left EpAnn EpaLocation
ann) = EpAnn EpaLocation -> HsTupArg GhcPs
missingTupArg EpAnn EpaLocation
ann
toTupArg (Right LHsExpr GhcPs
a) = XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
a
mkSumOrTupleExpr SrcSpanAnnA
l 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. SrcSpanAnn' 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 SrcSpanAnnA
l (XExplicitSum GhcPs -> Int -> Int -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
ExplicitSum (Anchor -> AnnExplicitSum -> EpAnnComments -> EpAnn AnnExplicitSum
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) AnnExplicitSum
an EpAnnComments
cs) 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. SrcSpanAnn' 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 EpaLocation) (LocatedA (PatBuilder GhcPs))]
ps) [AddEpAnn]
anns = do
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- (Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [Either (EpAnn EpaLocation) (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 EpaLocation) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
toTupPat [Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))]
ps
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' 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
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 (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' Boxity
boxity))
where
toTupPat :: Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs)
toTupPat :: Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
toTupPat Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
p = case Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
p of
Left EpAnn EpaLocation
_ -> 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. SrcSpanAnn' 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
EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
let an :: EpAnn EpAnnSumPat
an = Anchor -> EpAnnSumPat -> EpAnnComments -> EpAnn EpAnnSumPat
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) ([AddEpAnn] -> [EpaLocation] -> [EpaLocation] -> EpAnnSumPat
EpAnnSumPat [AddEpAnn]
anns [EpaLocation]
barsb [EpaLocation]
barsa) EpAnnComments
cs
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
EpAnn 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. SrcSpanAnn' 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
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> LHsType GhcPs
mkLHsOpTy PromotionFlag
prom LHsType GhcPs
x GenLocated SrcSpanAnnN RdrName
op LHsType GhcPs
y =
let loc :: SrcSpanAnnA
loc = GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
`combineSrcSpansA` (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
op) SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
`combineSrcSpansA` GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
y
in SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
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)
GenLocated SrcSpanAnnN RdrName
op LHsType GhcPs
y)
mkMultTy :: LHsToken "%" GhcPs -> LHsType GhcPs -> LHsUniToken "->" "→" GhcPs -> HsArrow GhcPs
mkMultTy :: LHsToken "%" GhcPs
-> LHsType GhcPs -> LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
mkMultTy LHsToken "%" GhcPs
pct t :: LHsType GhcPs
t@(L SrcSpanAnnA
_ (HsTyLit XTyLit GhcPs
_ (HsNumTy (SourceText String
"1") Integer
1))) LHsUniToken "->" "\8594" GhcPs
arr
= HsLinearArrowTokens GhcPs -> HsArrow GhcPs
forall pass. HsLinearArrowTokens pass -> HsArrow pass
HsLinearArrow (LHsToken "%1" GhcPs
-> LHsUniToken "->" "\8594" GhcPs -> HsLinearArrowTokens GhcPs
forall pass.
LHsToken "%1" pass
-> LHsUniToken "->" "\8594" pass -> HsLinearArrowTokens pass
HsPct1 (TokenLocation
-> HsToken "%1" -> GenLocated TokenLocation (HsToken "%1")
forall l e. l -> e -> GenLocated l e
L TokenLocation
locOfPct1 HsToken "%1"
forall (tok :: Symbol). HsToken tok
HsTok) LHsUniToken "->" "\8594" GhcPs
arr)
where
locOfPct1 :: TokenLocation
locOfPct1 :: TokenLocation
locOfPct1 = TokenLocation -> SrcSpan -> TokenLocation
token_location_widenR (GenLocated TokenLocation (HsToken "%") -> TokenLocation
forall l e. GenLocated l e -> l
getLoc LHsToken "%" GhcPs
GenLocated TokenLocation (HsToken "%")
pct) (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
mkMultTy LHsToken "%" GhcPs
pct LHsType GhcPs
t LHsUniToken "->" "\8594" GhcPs
arr = LHsToken "%" GhcPs
-> LHsType GhcPs -> LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall pass.
LHsToken "%" pass
-> LHsType pass -> LHsUniToken "->" "\8594" pass -> HsArrow pass
HsExplicitMult LHsToken "%" GhcPs
pct LHsType GhcPs
t LHsUniToken "->" "\8594" GhcPs
arr
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation (UnhelpfulSpan UnhelpfulSpanReason
_) = TokenLocation
NoTokenLoc
mkTokenLocation (RealSrcSpan RealSrcSpan
r Maybe BufSpan
mb) = EpaLocation -> TokenLocation
TokenLoc (RealSrcSpan -> Maybe BufSpan -> EpaLocation
EpaSpan RealSrcSpan
r Maybe BufSpan
mb)
token_location_widenR :: TokenLocation -> SrcSpan -> TokenLocation
token_location_widenR :: TokenLocation -> SrcSpan -> TokenLocation
token_location_widenR TokenLocation
NoTokenLoc SrcSpan
_ = TokenLocation
NoTokenLoc
token_location_widenR TokenLocation
tl (UnhelpfulSpan UnhelpfulSpanReason
_) = TokenLocation
tl
token_location_widenR (TokenLoc (EpaSpan RealSrcSpan
r1 Maybe BufSpan
mb1)) (RealSrcSpan RealSrcSpan
r2 Maybe BufSpan
mb2) =
(EpaLocation -> TokenLocation
TokenLoc (RealSrcSpan -> Maybe BufSpan -> EpaLocation
EpaSpan (RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans RealSrcSpan
r1 RealSrcSpan
r2) ((BufSpan -> BufSpan -> BufSpan)
-> Maybe BufSpan -> Maybe BufSpan -> Maybe BufSpan
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 BufSpan -> BufSpan -> BufSpan
combineBufSpans Maybe BufSpan
mb1 Maybe BufSpan
mb2)))
token_location_widenR (TokenLoc (EpaDelta DeltaPos
_ [LEpaComment]
_)) SrcSpan
_ =
String -> TokenLocation
forall a. HasCallStack => String -> a
panic String
"token_location_widenR: EpaDelta"
starSym :: Bool -> FastString
starSym :: Bool -> FastString
starSym Bool
True = String -> FastString
fsLit String
"★"
starSym Bool
False = String -> FastString
fsLit String
"*"
mkRdrGetField :: SrcSpanAnnA -> LHsExpr GhcPs -> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> EpAnnCO -> LHsExpr GhcPs
mkRdrGetField :: SrcSpanAnnA
-> LHsExpr GhcPs
-> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> EpAnn NoEpAnns
-> LHsExpr GhcPs
mkRdrGetField SrcSpanAnnA
loc LHsExpr GhcPs
arg LocatedAn NoEpAnns (DotFieldOcc GhcPs)
field EpAnn NoEpAnns
anns =
SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsGetField {
gf_ext :: XGetField GhcPs
gf_ext = XGetField GhcPs
EpAnn NoEpAnns
anns
, 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)) -> EpAnn AnnProjection -> HsExpr GhcPs
mkRdrProjection :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
-> EpAnn AnnProjection -> HsExpr GhcPs
mkRdrProjection NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
flds EpAnn AnnProjection
anns =
HsProjection {
proj_ext :: XProjection GhcPs
proj_ext = XProjection GhcPs
EpAnn 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 -> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate :: SrcSpanAnnA
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate SrcSpanAnnA
_ (L SrcSpan
_ []) LHsExpr GhcPs
_ Bool
_ EpAnn [AddEpAnn]
_ = String
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (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 EpAnn [AddEpAnn]
anns =
SrcSpanAnnA
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsFieldBind {
hfbAnn :: XHsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
hfbAnn = XHsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
EpAnn [AddEpAnn]
anns
, hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs)
hfbLHS = SrcAnn NoEpAnns
-> FieldLabelStrings GhcPs
-> GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NoEpAnns
forall ann. SrcSpan -> SrcAnn ann
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
}