{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
module GHC.Parser.PostProcess (
mkRdrGetField, mkRdrProjection, Fbind,
mkHsOpApp,
mkHsIntegral, mkHsFractional, mkHsIsString,
mkHsDo, mkSpliceDecl,
mkRoleAnnotDecl,
mkClassDecl,
mkTyData, mkDataFamInst,
mkTySynonym, mkTyFamInstEqn,
mkStandaloneKindSig,
mkTyFamInst,
mkFamDecl,
mkInlinePragma,
mkOpaquePragma,
mkPatSynMatchGroup,
mkRecConstrOrUpdate,
mkTyClD, mkInstD,
mkRdrRecordCon, mkRdrRecordUpd,
setRdrNameSpace,
fromSpecTyVarBndr, fromSpecTyVarBndrs,
annBinds,
fixValbindsAnn,
stmtsAnchor, stmtsLoc,
cvBindGroup,
cvBindsAndSigs,
cvTopDecls,
placeHolderPunRhs,
mkImport,
parseCImport,
mkExport,
mkExtName,
mkGadtDecl,
mkConDeclH98,
checkImportDecl,
checkExpBlockArguments, checkCmdBlockArguments,
checkPrecP,
checkContext,
checkPattern,
checkPattern_details,
incompleteDoBlock,
ParseContext(..),
checkMonadComp,
checkValDef,
checkValSigLhs,
LRuleTyTmVar, RuleTyTmVar(..),
mkRuleBndrs, mkRuleTyVarBndrs,
checkRuleTyVarBndrNames,
checkRecordSyntax,
checkEmptyGADTs,
addFatalError, hintBangPat,
mkBangTy,
UnpackednessPragma(..),
mkMultTy,
mkMultAnn,
mkTokenLocation,
ImpExpSubSpec(..),
ImpExpQcSpec(..),
mkModuleImpExp,
mkTypeImpExp,
mkImpExpSubSpec,
checkImportSpec,
starSym,
warnStarIsType,
warnPrepositiveQualifiedModule,
failOpFewArgs,
failNotEnabledImportQualifiedPost,
failImportQualifiedTwice,
requireExplicitNamespaces,
SumOrTuple (..),
PV,
runPV,
ECP(ECP, unECP),
DisambInfixOp(..),
DisambECP(..),
ecpFromExp,
ecpFromCmd,
PatBuilder,
hsHoleExpr,
DisambTD(..),
addUnpackednessP,
dataConBuilderCon,
dataConBuilderDetails,
mkUnboxedSumCon,
mkTupleSyntaxTy,
mkTupleSyntaxTycon,
mkListSyntaxTy0,
mkListSyntaxTy1,
withCombinedComments,
requireLTPuns,
) where
import GHC.Prelude
import GHC.Hs
import GHC.Core.TyCon ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
import GHC.Core.DataCon ( DataCon, dataConTyCon )
import GHC.Core.ConLike ( ConLike(..) )
import GHC.Core.Coercion.Axiom ( Role, fsFromRole )
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Types.Error
import GHC.Types.Fixity
import GHC.Types.Hint
import GHC.Types.SourceText
import GHC.Parser.Types
import GHC.Parser.Lexer
import GHC.Parser.Errors.Types
import GHC.Parser.Errors.Ppr ()
import GHC.Utils.Lexeme ( okConOcc )
import GHC.Types.TyThing
import GHC.Core.Type ( Specificity(..) )
import GHC.Builtin.Types( cTupleTyConName, tupleTyCon, tupleDataCon,
nilDataConName, nilDataConKey,
listTyConName, listTyConKey, sumDataCon,
unrestrictedFunTyCon , listTyCon_RDR )
import GHC.Types.ForeignCall
import GHC.Types.SrcLoc
import GHC.Types.Unique ( hasKey )
import GHC.Data.OrdList
import GHC.Utils.Outputable as Outputable
import GHC.Data.FastString
import GHC.Data.Maybe
import GHC.Utils.Error
import GHC.Utils.Misc
import GHC.Utils.Monad (unlessM)
import Data.Either
import Data.List ( findIndex )
import Data.Foldable
import qualified Data.Semigroup as Semi
import GHC.Unit.Module.Warnings
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import Control.Monad
import Text.ParserCombinators.ReadP as ReadP
import Data.Char
import Data.Data ( dataTypeOf, fromConstr, dataTypeConstrs )
import Data.Kind ( Type )
import Data.List.NonEmpty (NonEmpty)
mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkTyClD :: forall (p :: Pass). LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkTyClD (L SrcSpanAnnA
loc TyClDecl (GhcPass p)
d) = SrcSpanAnnA
-> HsDecl (GhcPass p)
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass p))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XTyClD (GhcPass p) -> TyClDecl (GhcPass p) -> HsDecl (GhcPass p)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass p)
NoExtField
noExtField TyClDecl (GhcPass p)
d)
mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkInstD :: forall (p :: Pass). LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)
mkInstD (L SrcSpanAnnA
loc InstDecl (GhcPass p)
d) = SrcSpanAnnA
-> HsDecl (GhcPass p)
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass p))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XInstD (GhcPass p) -> InstDecl (GhcPass p) -> HsDecl (GhcPass p)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD (GhcPass p)
NoExtField
noExtField InstDecl (GhcPass p)
d)
mkClassDecl :: SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a,[LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
-> EpLayout
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkClassDecl :: forall a.
SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a, [LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
-> EpLayout
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkClassDecl SrcSpan
loc' (L SrcSpan
_ (Maybe (LHsContext GhcPs)
mcxt, LHsType GhcPs
tycl_hdr)) Located (a, [LHsFunDep GhcPs])
fds OrdList (LHsDecl GhcPs)
where_cls EpLayout
layout [AddEpAnn]
annsIn
= do { let loc :: SrcSpanAnnA
loc = SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc'
; (binds, sigs, ats, at_defs, _, docs) <- OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
where_cls
; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr
; tyvars <- checkTyVars (text "class") whereDots cls tparams
; let anns' = [AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
ann
; return (L loc (ClassDecl { tcdCExt = (anns', layout, NoAnnSortKey)
, tcdCtxt = mcxt
, tcdLName = cls, tcdTyVars = tyvars
, tcdFixity = fixity
, tcdFDs = snd (unLoc fds)
, tcdSigs = mkClassOpSigs sigs
, tcdMeths = binds
, tcdATs = ats, tcdATDefs = at_defs
, tcdDocs = 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 e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc'
; (tc, tparams, fixity, ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams
; let anns' = [AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
ann
; data_cons <- checkNewOrData (locA loc) (unLoc tc) is_type_data new_or_data data_cons
; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv
; return (L loc (DataDecl { tcdDExt = anns',
tcdLName = tc, tcdTyVars = tyvars,
tcdFixity = fixity,
tcdDataDefn = 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 { (tc, tparams, fixity, ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
; tyvars <- checkTyVars (text "type") equalsDots tc tparams
; let anns' = [AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
ann
; return (L (noAnnSrcSpan loc) (SynDecl
{ tcdSExt = anns'
, tcdLName = tc, tcdTyVars = tyvars
, tcdFixity = fixity
, tcdRhs = 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 { 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 :: * -> *} {l}.
(MonadP m, HasLoc l) =>
GenLocated l RdrName -> m (GenLocated l RdrName)
check_lhs_name (Located [GenLocated SrcSpanAnnN RdrName]
-> [GenLocated SrcSpanAnnN RdrName]
forall l e. GenLocated l e -> e
unLoc Located [GenLocated SrcSpanAnnN RdrName]
lhs)
; v <- check_singular_lhs (reverse vs)
; return $ L (noAnnSrcSpan loc)
$ StandaloneKindSig anns v rhs }
where
check_lhs_name :: GenLocated l RdrName -> m (GenLocated l RdrName)
check_lhs_name v :: GenLocated l RdrName
v@(GenLocated l RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc->RdrName
name) =
if RdrName -> Bool
isUnqual RdrName
name Bool -> Bool -> Bool
&& OccName -> Bool
isTcOcc (RdrName -> OccName
rdrNameOcc RdrName
name)
then GenLocated l RdrName -> m (GenLocated l RdrName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated l RdrName
v
else MsgEnvelope PsMessage -> m (GenLocated l RdrName)
forall a. MsgEnvelope PsMessage -> m a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> m (GenLocated l RdrName))
-> MsgEnvelope PsMessage -> m (GenLocated l RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated l RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated l RdrName
v) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> PsMessage
PsErrUnexpectedQualifiedConstructor (GenLocated l RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated l RdrName
v))
check_singular_lhs :: [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 { (tc, tparams, fixity, ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
; return (L (noAnnSrcSpan loc) $ FamEqn
{ feqn_ext = anns `mappend` ann
, feqn_tycon = tc
, feqn_bndrs = bndrs
, feqn_pats = tparams
, feqn_fixity = fixity
, feqn_rhs = 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 { (tc, tparams, fixity, ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
; data_cons <- checkNewOrData loc (unLoc tc) False new_or_data data_cons
; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv
; return (L (noAnnSrcSpan loc) (DataFamInstD noExtField (DataFamInstDecl
(FamEqn { feqn_ext = ann Semi.<> anns
, feqn_tycon = tc
, feqn_bndrs = bndrs
, feqn_pats = tparams
, feqn_fixity = fixity
, feqn_rhs = defn })))) }
mkTyFamInst :: SrcSpan
-> TyFamInstEqn GhcPs
-> [AddEpAnn]
-> P (LInstDecl GhcPs)
mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs -> [AddEpAnn] -> P (LInstDecl GhcPs)
mkTyFamInst SrcSpan
loc TyFamInstEqn GhcPs
eqn [AddEpAnn]
anns = do
GenLocated SrcSpanAnnA (InstDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (InstDecl GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> InstDecl GhcPs -> GenLocated SrcSpanAnnA (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) (XTyFamInstD GhcPs -> TyFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XTyFamInstD pass -> TyFamInstDecl pass -> InstDecl pass
TyFamInstD XTyFamInstD GhcPs
NoExtField
noExtField
(XCTyFamInstDecl GhcPs -> TyFamInstEqn GhcPs -> TyFamInstDecl GhcPs
forall pass.
XCTyFamInstDecl pass -> TyFamInstEqn pass -> TyFamInstDecl pass
TyFamInstDecl [AddEpAnn]
XCTyFamInstDecl GhcPs
anns TyFamInstEqn GhcPs
eqn)))
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LHsType GhcPs
-> LFamilyResultSig GhcPs
-> Maybe (LInjectivityAnn GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LHsType GhcPs
-> LFamilyResultSig GhcPs
-> Maybe (LInjectivityAnn GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkFamDecl SrcSpan
loc FamilyInfo GhcPs
info TopLevelFlag
topLevel LHsType GhcPs
lhs LFamilyResultSig GhcPs
ksig Maybe (LInjectivityAnn GhcPs)
injAnn [AddEpAnn]
annsIn
= do { (tc, tparams, fixity, ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
; tyvars <- checkTyVars (ppr info) equals_or_where tc tparams
; return (L (noAnnSrcSpan loc) (FamDecl noExtField
(FamilyDecl
{ fdExt = annsIn Semi.<> ann
, fdTopLevel = topLevel
, fdInfo = info, fdLName = tc
, fdTyVars = tyvars
, fdFixity = fixity
, fdResultSig = ksig
, fdInjectivityAnn = injAnn }))) }
where
equals_or_where :: SDoc
equals_or_where = case FamilyInfo GhcPs
info of
FamilyInfo GhcPs
DataFamily -> SDoc
forall doc. IsOutput doc => doc
empty
FamilyInfo GhcPs
OpenTypeFamily -> SDoc
forall doc. IsOutput doc => doc
empty
ClosedTypeFamily {} -> SDoc
whereDots
mkSpliceDecl :: LHsExpr GhcPs -> (LHsDecl GhcPs)
mkSpliceDecl :: LHsExpr GhcPs -> LHsDecl GhcPs
mkSpliceDecl lexpr :: LHsExpr GhcPs
lexpr@(L SrcSpanAnnA
loc HsExpr GhcPs
expr)
| HsUntypedSplice XUntypedSplice GhcPs
_ splice :: HsUntypedSplice GhcPs
splice@(HsUntypedSpliceExpr {}) <- HsExpr GhcPs
expr
= SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
NoExtField
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsUntypedSplice GhcPs)
-> SpliceDecoration
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsUntypedSplice p) -> SpliceDecoration -> SpliceDecl p
SpliceDecl XSpliceDecl GhcPs
NoExtField
noExtField (SrcSpanAnnA
-> HsUntypedSplice GhcPs
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) HsUntypedSplice GhcPs
splice) SpliceDecoration
DollarSplice)
| HsUntypedSplice XUntypedSplice GhcPs
_ splice :: HsUntypedSplice GhcPs
splice@(HsQuasiQuote {}) <- HsExpr GhcPs
expr
= SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
NoExtField
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsUntypedSplice GhcPs)
-> SpliceDecoration
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsUntypedSplice p) -> SpliceDecoration -> SpliceDecl p
SpliceDecl XSpliceDecl GhcPs
NoExtField
noExtField (SrcSpanAnnA
-> HsUntypedSplice GhcPs
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) HsUntypedSplice GhcPs
splice) SpliceDecoration
DollarSplice)
| Bool
otherwise
= SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD XSpliceD GhcPs
NoExtField
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsUntypedSplice GhcPs)
-> SpliceDecoration
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsUntypedSplice p) -> SpliceDecoration -> SpliceDecl p
SpliceDecl XSpliceDecl GhcPs
NoExtField
noExtField
(SrcSpanAnnA
-> HsUntypedSplice GhcPs
-> GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) (XUntypedSpliceExpr GhcPs -> LHsExpr GhcPs -> HsUntypedSplice GhcPs
forall id.
XUntypedSpliceExpr id -> LHsExpr id -> HsUntypedSplice id
HsUntypedSpliceExpr [AddEpAnn]
XUntypedSpliceExpr GhcPs
forall a. NoAnn a => a
noAnn (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lexpr)))
SpliceDecoration
BareSplice)
mkRoleAnnotDecl :: SrcSpan
-> LocatedN RdrName
-> [Located (Maybe FastString)]
-> [AddEpAnn]
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> [Located (Maybe FastString)]
-> [AddEpAnn]
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl SrcSpan
loc GenLocated SrcSpanAnnN RdrName
tycon [Located (Maybe FastString)]
roles [AddEpAnn]
anns
= do { roles' <- (Located (Maybe FastString) -> P (GenLocated EpAnnCO (Maybe Role)))
-> [Located (Maybe FastString)]
-> P [GenLocated EpAnnCO (Maybe Role)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Located (Maybe FastString) -> P (GenLocated EpAnnCO (Maybe Role))
parse_role [Located (Maybe FastString)]
roles
; !cs <- getCommentsFor loc
; return $ L (EpAnn (spanAsAnchor loc) noAnn cs)
$ RoleAnnotDecl anns tycon roles' }
where
role_data_type :: DataType
role_data_type = Role -> DataType
forall a. Data a => a -> DataType
dataTypeOf (Role
forall a. HasCallStack => a
undefined :: Role)
all_roles :: [Role]
all_roles = (Constr -> Role) -> [Constr] -> [Role]
forall a b. (a -> b) -> [a] -> [b]
map Constr -> Role
forall a. Data a => Constr -> a
fromConstr ([Constr] -> [Role]) -> [Constr] -> [Role]
forall a b. (a -> b) -> a -> b
$ DataType -> [Constr]
dataTypeConstrs DataType
role_data_type
possible_roles :: [(FastString, Role)]
possible_roles = [(Role -> FastString
fsFromRole Role
role, Role
role) | Role
role <- [Role]
all_roles]
parse_role :: Located (Maybe FastString) -> P (GenLocated EpAnnCO (Maybe Role))
parse_role (L SrcSpan
loc_role Maybe FastString
Nothing) = GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role)))
-> GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a b. (a -> b) -> a -> b
$ EpAnnCO -> Maybe Role -> GenLocated EpAnnCO (Maybe Role)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnnCO
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc_role) Maybe Role
forall a. Maybe a
Nothing
parse_role (L SrcSpan
loc_role (Just FastString
role))
= case FastString -> [(FastString, Role)] -> Maybe Role
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FastString
role [(FastString, Role)]
possible_roles of
Just Role
found_role -> GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role)))
-> GenLocated EpAnnCO (Maybe Role)
-> P (GenLocated EpAnnCO (Maybe Role))
forall a b. (a -> b) -> a -> b
$ EpAnnCO -> Maybe Role -> GenLocated EpAnnCO (Maybe Role)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnnCO
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc_role) (Maybe Role -> GenLocated EpAnnCO (Maybe Role))
-> Maybe Role -> GenLocated EpAnnCO (Maybe Role)
forall a b. (a -> b) -> a -> b
$ Role -> Maybe Role
forall a. a -> Maybe a
Just Role
found_role
Maybe Role
Nothing ->
let nearby :: [Role]
nearby = String -> [(String, Role)] -> [Role]
forall a. String -> [(String, a)] -> [a]
fuzzyLookup (FastString -> String
unpackFS FastString
role)
((FastString -> String) -> [(FastString, Role)] -> [(String, Role)]
forall (f :: * -> *) a c b.
Functor f =>
(a -> c) -> f (a, b) -> f (c, b)
mapFst FastString -> String
unpackFS [(FastString, Role)]
possible_roles)
in
MsgEnvelope PsMessage -> P (GenLocated EpAnnCO (Maybe Role))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (GenLocated EpAnnCO (Maybe Role)))
-> MsgEnvelope PsMessage -> P (GenLocated EpAnnCO (Maybe Role))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc_role (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(FastString -> [Role] -> PsMessage
PsErrIllegalRoleName FastString
role [Role]
nearby)
fromSpecTyVarBndrs :: [LHsTyVarBndr Specificity GhcPs] -> P [LHsTyVarBndr () GhcPs]
fromSpecTyVarBndrs :: [LHsTyVarBndr Specificity GhcPs] -> P [LHsTyVarBndr () GhcPs]
fromSpecTyVarBndrs = (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> P [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)
GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
fromSpecTyVarBndr
fromSpecTyVarBndr :: LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)
fromSpecTyVarBndr :: LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)
fromSpecTyVarBndr LHsTyVarBndr Specificity GhcPs
bndr = case LHsTyVarBndr Specificity GhcPs
bndr of
(L SrcSpanAnnA
loc (UserTyVar XUserTyVar GhcPs
xtv Specificity
flag XRec GhcPs (IdP GhcPs)
idp)) -> (Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
flag SrcSpanAnnA
loc)
P ()
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall a b. (a -> b) -> a -> b
$ XUserTyVar GhcPs
-> () -> XRec GhcPs (IdP GhcPs) -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar GhcPs
xtv () XRec GhcPs (IdP GhcPs)
idp)
(L SrcSpanAnnA
loc (KindedTyVar XKindedTyVar GhcPs
xtv Specificity
flag XRec GhcPs (IdP GhcPs)
idp LHsType GhcPs
k)) -> (Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
flag SrcSpanAnnA
loc)
P ()
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall a b. (a -> b) -> a -> b
$ XKindedTyVar GhcPs
-> ()
-> XRec GhcPs (IdP GhcPs)
-> LHsType GhcPs
-> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar GhcPs
xtv () XRec GhcPs (IdP GhcPs)
idp LHsType GhcPs
k)
where
check_spec :: Specificity -> SrcSpanAnnA -> P ()
check_spec :: Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
SpecifiedSpec SrcSpanAnnA
_ = () -> P ()
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
check_spec Specificity
InferredSpec SrcSpanAnnA
loc = MsgEnvelope PsMessage -> P ()
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrInferredTypeVarNotAllowed
annBinds :: AddEpAnn -> EpAnnComments -> HsLocalBinds GhcPs
-> (HsLocalBinds GhcPs, Maybe EpAnnComments)
annBinds :: AddEpAnn
-> EpAnnComments
-> HsLocalBinds GhcPs
-> (HsLocalBinds GhcPs, Maybe EpAnnComments)
annBinds AddEpAnn
a EpAnnComments
cs (HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
bs) = (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds (AddEpAnn -> SrcSpanAnnL -> EpAnnComments -> SrcSpanAnnL
add_where AddEpAnn
a XHsValBinds GhcPs GhcPs
SrcSpanAnnL
an EpAnnComments
cs) HsValBindsLR GhcPs GhcPs
bs, Maybe EpAnnComments
forall a. Maybe a
Nothing)
annBinds AddEpAnn
a EpAnnComments
cs (HsIPBinds XHsIPBinds GhcPs GhcPs
an HsIPBinds GhcPs
bs) = (XHsIPBinds GhcPs GhcPs -> HsIPBinds GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds (AddEpAnn -> SrcSpanAnnL -> EpAnnComments -> SrcSpanAnnL
add_where AddEpAnn
a XHsIPBinds GhcPs GhcPs
SrcSpanAnnL
an EpAnnComments
cs) HsIPBinds GhcPs
bs, Maybe EpAnnComments
forall a. Maybe a
Nothing)
annBinds AddEpAnn
_ EpAnnComments
cs (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
x) = (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
x, EpAnnComments -> Maybe EpAnnComments
forall a. a -> Maybe a
Just EpAnnComments
cs)
add_where :: AddEpAnn -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
add_where :: AddEpAnn -> SrcSpanAnnL -> EpAnnComments -> SrcSpanAnnL
add_where an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
_ (EpaSpan (RealSrcSpan RealSrcSpan
rs Maybe BufSpan
_))) (EpAnn EpaLocation
a (AnnList Maybe EpaLocation
anc Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs) EpAnnComments
cs2
| EpaLocation -> Bool
valid_anchor EpaLocation
a
= EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (EpaLocation -> [AddEpAnn] -> EpaLocation
widenAnchor EpaLocation
a [AddEpAnn
an]) (Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe EpaLocation
anc Maybe AddEpAnn
o Maybe AddEpAnn
c (AddEpAnn
anAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
r) [TrailingAnn]
t) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
| Bool
otherwise
= EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> EpaLocation -> EpaLocation
patch_anchor RealSrcSpan
rs EpaLocation
a)
(Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList ((EpaLocation -> EpaLocation)
-> Maybe EpaLocation -> Maybe EpaLocation
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcSpan -> EpaLocation -> EpaLocation
patch_anchor RealSrcSpan
rs) Maybe EpaLocation
anc) Maybe AddEpAnn
o Maybe AddEpAnn
c (AddEpAnn
anAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
r) [TrailingAnn]
t) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
add_where (AddEpAnn AnnKeywordId
_ EpaLocation
_) SrcSpanAnnL
_ EpAnnComments
_ = String -> SrcSpanAnnL
forall a. HasCallStack => String -> a
panic String
"add_where"
valid_anchor :: Anchor -> Bool
valid_anchor :: EpaLocation -> Bool
valid_anchor (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_)) = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
valid_anchor EpaLocation
_ = Bool
False
patch_anchor :: RealSrcSpan -> Anchor -> Anchor
patch_anchor :: RealSrcSpan -> EpaLocation -> EpaLocation
patch_anchor RealSrcSpan
r (EpaDelta DeltaPos
_ [LEpaComment]
_) = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
patch_anchor RealSrcSpan
r1 (EpaSpan (RealSrcSpan RealSrcSpan
r0 Maybe BufSpan
mb)) = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
mb)
where
r :: RealSrcSpan
r = if RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then RealSrcSpan
r1 else RealSrcSpan
r0
patch_anchor RealSrcSpan
_ (EpaSpan SrcSpan
ss) = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan SrcSpan
ss
fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn :: SrcSpanAnnL -> SrcSpanAnnL
fixValbindsAnn (EpAnn EpaLocation
anchor (AnnList Maybe EpaLocation
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
= (EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (EpaLocation -> [AddEpAnn] -> EpaLocation
widenAnchor EpaLocation
anchor ([AddEpAnn]
r [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ (TrailingAnn -> AddEpAnn) -> [TrailingAnn] -> [AddEpAnn]
forall a b. (a -> b) -> [a] -> [b]
map TrailingAnn -> AddEpAnn
trailingAnnToAddEpAnn [TrailingAnn]
t)) (Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe EpaLocation
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
stmtsAnchor :: Located (OrdList AddEpAnn,a) -> Maybe Anchor
stmtsAnchor :: forall a. Located (OrdList AddEpAnn, a) -> Maybe EpaLocation
stmtsAnchor (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb) ((ConsOL (AddEpAnn AnnKeywordId
_ (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
rb))) OrdList AddEpAnn
_), a
_))
= EpaLocation -> Maybe EpaLocation
forall a. a -> Maybe a
Just (EpaLocation -> Maybe EpaLocation)
-> EpaLocation -> Maybe EpaLocation
forall a b. (a -> b) -> a -> b
$ EpaLocation -> SrcSpan -> EpaLocation
widenAnchorS (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb)) (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
rb)
stmtsAnchor (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb) (OrdList AddEpAnn, a)
_) = EpaLocation -> Maybe EpaLocation
forall a. a -> Maybe a
Just (EpaLocation -> Maybe EpaLocation)
-> EpaLocation -> Maybe EpaLocation
forall a b. (a -> b) -> a -> b
$ SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb)
stmtsAnchor GenLocated SrcSpan (OrdList AddEpAnn, a)
_ = Maybe EpaLocation
forall a. Maybe a
Nothing
stmtsLoc :: Located (OrdList AddEpAnn,a) -> SrcSpan
stmtsLoc :: forall a. Located (OrdList AddEpAnn, a) -> SrcSpan
stmtsLoc (L SrcSpan
l ((ConsOL AddEpAnn
aa OrdList AddEpAnn
_), a
_))
= SrcSpan -> [AddEpAnn] -> SrcSpan
widenSpan SrcSpan
l [AddEpAnn
aa]
stmtsLoc (L SrcSpan
l (OrdList AddEpAnn, a)
_) = SrcSpan
l
cvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
cvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
cvTopDecls OrdList (LHsDecl GhcPs)
decls = [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll (OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. OrdList a -> [a]
fromOL OrdList (LHsDecl GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
decls)
cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)
cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBindsLR GhcPs GhcPs)
cvBindGroup OrdList (LHsDecl GhcPs)
binding
= do { (mbs, sigs, fam_ds, tfam_insts
, dfam_insts, _) <- OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
binding
; massert (null fam_ds && null tfam_insts && null dfam_insts)
; return $ ValBinds NoAnnSortKey mbs 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
fb' <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> P [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *} {a}.
(MonadP m, HasLoc a) =>
[GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls (OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. OrdList a -> [a]
fromOL OrdList (LHsDecl GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
fb)
return (partitionBindsAndSigs (getMonoBindAll fb'))
where
drop_bad_decls :: [GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls [] = [GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
drop_bad_decls (L a
l (SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
d) : [GenLocated a (HsDecl GhcPs)]
ds) = do
MsgEnvelope PsMessage -> m ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> m ()) -> MsgEnvelope PsMessage -> m ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SpliceDecl GhcPs -> PsMessage
PsErrDeclSpliceNotAtTopLevel SpliceDecl GhcPs
d
[GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls [GenLocated a (HsDecl GhcPs)]
ds
drop_bad_decls (GenLocated a (HsDecl GhcPs)
d:[GenLocated a (HsDecl GhcPs)]
ds) = (GenLocated a (HsDecl GhcPs)
dGenLocated a (HsDecl GhcPs)
-> [GenLocated a (HsDecl GhcPs)] -> [GenLocated a (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:) ([GenLocated a (HsDecl GhcPs)] -> [GenLocated a (HsDecl GhcPs)])
-> m [GenLocated a (HsDecl GhcPs)]
-> m [GenLocated a (HsDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated a (HsDecl GhcPs)] -> m [GenLocated a (HsDecl GhcPs)]
drop_bad_decls [GenLocated a (HsDecl GhcPs)]
ds
getMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
getMonoBind :: LHsBind GhcPs
-> [LHsDecl GhcPs] -> (LHsBind GhcPs, [LHsDecl GhcPs])
getMonoBind (L SrcSpanAnnA
loc1 (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = fun_id1 :: XRec GhcPs (IdP GhcPs)
fun_id1@(L SrcSpanAnnN
_ RdrName
f1)
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches =
MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ m1 :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
m1@[L SrcSpanAnnA
_ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs1]) } }))
[LHsDecl GhcPs]
binds
| [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
has_args [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
m1
= [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc1 Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs1] (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc1) [LHsDecl GhcPs]
binds []
where
go :: [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go :: [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs SrcSpanAnnA
loc
((L SrcSpanAnnA
loc2 (ValD XValD GhcPs
_ (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = (L SrcSpanAnnN
_ RdrName
f2)
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches =
MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [L SrcSpanAnnA
lm2 Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs2]) } })))
: [LHsDecl GhcPs]
binds) [LHsDecl GhcPs]
_
| RdrName
f1 RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
f2 =
let (SrcSpanAnnA
loc2', SrcSpanAnnA
lm2') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferAnnsA SrcSpanAnnA
loc2 SrcSpanAnnA
lm2
in [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lm2' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs2 GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mtchs)
(SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => EpAnn a -> EpAnn a -> EpAnn a
combineSrcSpansA SrcSpanAnnA
loc SrcSpanAnnA
loc2') [LHsDecl GhcPs]
binds []
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs SrcSpanAnnA
loc (doc_decl :: LHsDecl GhcPs
doc_decl@(L SrcSpanAnnA
loc2 (DocD {})) : [LHsDecl GhcPs]
binds) [LHsDecl GhcPs]
doc_decls
= let doc_decls' :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls' = LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
doc_decl GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls
in [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs (SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => EpAnn a -> EpAnn a -> EpAnn a
combineSrcSpansA SrcSpanAnnA
loc SrcSpanAnnA
loc2) [LHsDecl GhcPs]
binds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls'
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs SrcSpanAnnA
loc [LHsDecl GhcPs]
binds [LHsDecl GhcPs]
doc_decls
= let
L SrcSpanAnnA
llm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
last_m = [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => [a] -> a
head [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mtchs
(SrcSpanAnnA
llm',SrcSpanAnnA
loc') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferAnnsOnlyA SrcSpanAnnA
llm SrcSpanAnnA
loc
matches' :: [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches' = [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
llm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
last_mGenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. HasCallStack => [a] -> [a]
tail [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mtchs)
L SrcSpanAnnA
lfm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
first_m = [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => [a] -> a
head [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches'
(SrcSpanAnnA
lfm', SrcSpanAnnA
loc'') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferCommentsOnlyA SrcSpanAnnA
lfm SrcSpanAnnA
loc'
in
( SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc'' (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 an e2.
(Semigroup a, NoAnn an) =>
[GenLocated (EpAnn a) e2] -> LocatedAn an [GenLocated (EpAnn a) e2]
mkLocatedList ([GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lfm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
first_mGenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. HasCallStack => [a] -> [a]
tail [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches')))
, ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a]
reverse [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
doc_decls) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
binds)
getMonoBind LHsBind GhcPs
bind [LHsDecl GhcPs]
binds = (LHsBind GhcPs
bind, [LHsDecl GhcPs]
binds)
getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [] = []
getMonoBindAll (L SrcSpanAnnA
l (ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
b) : [LHsDecl GhcPs]
ds) =
let (L SrcSpanAnnA
l' HsBindLR GhcPs GhcPs
b', [LHsDecl GhcPs]
ds') = LHsBind GhcPs
-> [LHsDecl GhcPs] -> (LHsBind GhcPs, [LHsDecl GhcPs])
getMonoBind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
b) [LHsDecl GhcPs]
ds
in SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
NoExtField
noExtField HsBindLR GhcPs GhcPs
b') GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [LHsDecl GhcPs]
ds'
getMonoBindAll (LHsDecl GhcPs
d : [LHsDecl GhcPs]
ds) = LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
d GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [LHsDecl GhcPs]
ds
has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
has_args [] = String -> Bool
forall a. HasCallStack => String -> a
panic String
"GHC.Parser.PostProcess.has_args"
has_args (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcPs]
args }) : [LMatch GhcPs (LHsExpr GhcPs)]
_) = Bool -> Bool
not ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
args)
tyConToDataCon :: LocatedN RdrName -> Either (MsgEnvelope PsMessage) (LocatedN RdrName)
tyConToDataCon :: 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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ (RdrName -> PsMessage
PsErrNotADataCon RdrName
tc)
where
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
tc
mkPatSynMatchGroup :: LocatedN RdrName
-> LocatedL (OrdList (LHsDecl GhcPs))
-> P (MatchGroup GhcPs (LHsExpr GhcPs))
mkPatSynMatchGroup :: 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 { 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)
; when (null matches) (wrongNumberErr (locA loc))
; return $ mkMatchGroup FromSource (L ld matches) }
where
fromDecl :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
fromDecl (L SrcSpanAnnA
loc decl :: HsDecl GhcPs
decl@(ValD XValD GhcPs
_ (PatBind XPatBind GhcPs GhcPs
_
pat :: LPat GhcPs
pat@(L SrcSpanAnnA
_ (ConPat XConPat GhcPs
noAnn ln :: XRec GhcPs (ConLikeP GhcPs)
ln@(L SrcSpanAnnN
_ RdrName
name) HsConPatDetails GhcPs
details))
HsMultAnn GhcPs
_ GRHSs GhcPs (LHsExpr GhcPs)
rhs))) =
do { Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RdrName
name RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
patsyn_name) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
SrcSpan -> HsDecl GhcPs -> P ()
wrongNameBindingErr (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) HsDecl GhcPs
decl
; match <- case HsConPatDetails GhcPs
details of
PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
_ [LPat GhcPs]
pats -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = XConPat GhcPs
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
noAnn
, m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt = HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
ctxt, m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs]
pats
, m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
rhs }
where
ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
ctxt = FunRhs { mc_fun :: GenLocated SrcSpanAnnN RdrName
mc_fun = XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
ln
, mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Prefix
, mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
NoSrcStrict }
InfixCon LPat GhcPs
p1 LPat GhcPs
p2 -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = XConPat GhcPs
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
noAnn
, m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt = HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
ctxt
, m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs
p1, LPat GhcPs
p2]
, m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
rhs }
where
ctxt :: HsMatchContext (GenLocated SrcSpanAnnN RdrName)
ctxt = FunRhs { mc_fun :: GenLocated SrcSpanAnnN RdrName
mc_fun = XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
ln
, mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Infix
, mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
NoSrcStrict }
RecCon{} -> SrcSpan
-> LPat GhcPs
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. SrcSpan -> LPat GhcPs -> P a
recordPatSynErr (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) LPat GhcPs
pat
; return $ L loc match }
fromDecl (L SrcSpanAnnA
loc HsDecl GhcPs
decl) = SrcSpan
-> HsDecl GhcPs
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
extraDeclErr (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) HsDecl GhcPs
decl
extraDeclErr :: SrcSpan
-> HsDecl GhcPs
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
extraDeclErr SrcSpan
loc HsDecl GhcPs
decl =
MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> HsDecl GhcPs -> PsMessage
PsErrNoSingleWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl)
wrongNameBindingErr :: SrcSpan -> HsDecl GhcPs -> P ()
wrongNameBindingErr SrcSpan
loc HsDecl GhcPs
decl =
MsgEnvelope PsMessage -> P ()
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> HsDecl GhcPs -> PsMessage
PsErrInvalidWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl)
wrongNumberErr :: SrcSpan -> P ()
wrongNumberErr SrcSpan
loc =
MsgEnvelope PsMessage -> P ()
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> PsMessage
PsErrEmptyWhereInPatSynDecl RdrName
patsyn_name)
recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a
recordPatSynErr :: forall a. SrcSpan -> LPat GhcPs -> P a
recordPatSynErr SrcSpan
loc LPat GhcPs
pat =
MsgEnvelope PsMessage -> P a
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P a) -> MsgEnvelope PsMessage -> P a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LPat GhcPs -> PsMessage
PsErrRecordSyntaxInPatSynDecl LPat GhcPs
pat)
mkConDeclH98 :: [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 :: [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs)
-> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 [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 = [AddEpAnn]
XConDeclH98 GhcPs
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)
-> EpUniToken "::" "∷"
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl :: SrcSpan
-> NonEmpty (GenLocated SrcSpanAnnN RdrName)
-> EpUniToken "::" "\8759"
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl SrcSpan
loc NonEmpty (GenLocated SrcSpanAnnN RdrName)
names EpUniToken "::" "\8759"
dcol LHsSigType GhcPs
ty = do
(args, res_ty, annsa, csa) <-
case LHsType GhcPs
body_ty of
L SrcSpanAnnA
ll (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
hsArr (L (EpAnn EpaLocation
anc AnnListItem
_ EpAnnComments
cs) (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
rf)) LHsType GhcPs
res_ty) -> do
arr <- case HsArrow GhcPs
hsArr of
HsUnrestrictedArrow XUnrestrictedArrow GhcPs
arr -> EpUniToken "->" "\8594" -> P (EpUniToken "->" "\8594")
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return EpUniToken "->" "\8594"
XUnrestrictedArrow GhcPs
arr
HsArrow GhcPs
_ -> do MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
body_ty) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsArrow GhcPs -> PsMessage
PsErrIllegalGadtRecordMultiplicity HsArrow GhcPs
hsArr)
EpUniToken "->" "\8594" -> P (EpUniToken "->" "\8594")
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return EpUniToken "->" "\8594"
forall a. NoAnn a => a
noAnn
return ( RecConGADT arr (L (EpAnn anc an cs) rf), res_ty
, [], epAnnComments ll)
LHsType GhcPs
_ -> do
let ([AddEpAnn]
anns, EpAnnComments
cs, [HsScaled GhcPs (LHsType GhcPs)]
arg_types, LHsType GhcPs
res_type) = LHsType GhcPs
-> ([AddEpAnn], EpAnnComments, [HsScaled GhcPs (LHsType GhcPs)],
LHsType GhcPs)
forall (p :: Pass).
LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
[HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType LHsType GhcPs
body_ty
(HsConDeclGADTDetails GhcPs, GenLocated SrcSpanAnnA (HsType GhcPs),
[AddEpAnn], EpAnnComments)
-> P (HsConDeclGADTDetails GhcPs,
GenLocated SrcSpanAnnA (HsType GhcPs), [AddEpAnn], EpAnnComments)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPrefixConGADT GhcPs
-> [HsScaled GhcPs (LHsType GhcPs)] -> HsConDeclGADTDetails GhcPs
forall pass.
XPrefixConGADT pass
-> [HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
PrefixConGADT NoExtField
XPrefixConGADT GhcPs
noExtField [HsScaled GhcPs (LHsType GhcPs)]
arg_types, LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
res_type, [AddEpAnn]
anns, EpAnnComments
cs)
let bndrs_loc = case HsOuterSigTyVarBndrs GhcPs
outer_bndrs of
HsOuterImplicit{} -> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
HsOuterExplicit XHsOuterExplicit GhcPs Specificity
an [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
_ -> EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (EpAnn (AddEpAnn, AddEpAnn) -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry XHsOuterExplicit GhcPs Specificity
EpAnn (AddEpAnn, AddEpAnn)
an) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
emptyComments
let l = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
loc) AnnListItem
forall a. NoAnn a => a
noAnn EpAnnComments
csa
pure $ L l ConDeclGADT
{ con_g_ext = (dcol, annsa)
, con_names = names
, con_bndrs = L bndrs_loc outer_bndrs
, con_mb_cxt = mcxt
, con_g_args = args
, con_res_ty = res_ty
, con_doc = 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 (HasDebugCallStack => 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 { tvs <- (HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated
SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> P [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
check [LHsTypeArg GhcPs]
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tparms
; return (mkHsQTvs tvs) }
where
check :: HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
check (HsTypeArg XTypeArg GhcPs
at GenLocated SrcSpanAnnA (HsType GhcPs)
ki) = [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens [] [] (XBndrInvisible GhcPs -> HsBndrVis GhcPs
forall pass. XBndrInvisible pass -> HsBndrVis pass
HsBndrInvisible XTypeArg GhcPs
XBndrInvisible GhcPs
at) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki
check (HsValArg XValArg GhcPs
_ GenLocated SrcSpanAnnA (HsType GhcPs)
ty) = [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens [] [] (XBndrRequired GhcPs -> HsBndrVis GhcPs
forall pass. XBndrRequired pass -> HsBndrVis pass
HsBndrRequired NoExtField
XBndrRequired GhcPs
noExtField) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
check (HsArgPar XArgPar GhcPs
sp) = MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> P (GenLocated
SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)))
-> MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
XArgPar GhcPs
sp (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(SDoc -> RdrName -> PsMessage
PsErrMalformedDecl SDoc
pp_what (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tc))
chkParens :: [AddEpAnn] -> [AddEpAnn] -> HsBndrVis GhcPs -> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens :: [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis (L SrcSpanAnnA
l (HsParTy XParTy GhcPs
_ (L SrcSpanAnnA
lt HsType GhcPs
ty)))
= let
(AddEpAnn
o,AddEpAnn
c) = RealSrcSpan -> (AddEpAnn, AddEpAnn)
mkParensEpAnn (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
(SrcSpanAnnA
_,SrcSpanAnnA
lt') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferCommentsOnlyA SrcSpanAnnA
l SrcSpanAnnA
lt
in
[AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chkParens (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps) HsBndrVis GhcPs
bvis (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lt' HsType GhcPs
ty)
chkParens [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis LHsType GhcPs
ty = [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chk [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis LHsType GhcPs
ty
chk :: [AddEpAnn] -> [AddEpAnn] -> HsBndrVis GhcPs -> LHsType GhcPs -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chk :: [AddEpAnn]
-> [AddEpAnn]
-> HsBndrVis GhcPs
-> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
chk [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis (L SrcSpanAnnA
l (HsKindSig XKindSig GhcPs
annk (L SrcSpanAnnA
annt (HsTyVar XTyVar GhcPs
ann PromotionFlag
_ (L SrcSpanAnnN
lv RdrName
tv))) LHsType GhcPs
k))
| RdrName -> Bool
isRdrTyVar RdrName
tv
= let
an :: [AddEpAnn]
an = ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps
in
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> [AddEpAnn] -> SrcSpanAnnA
forall an. EpAnn an -> [AddEpAnn] -> EpAnn an
widenLocatedAn (SrcSpanAnnA
l SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA
annt) (HsBndrVis GhcPs -> AddEpAnn
for_widening HsBndrVis GhcPs
bvisAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
an))
(XKindedTyVar GhcPs
-> HsBndrVis GhcPs
-> XRec GhcPs (IdP GhcPs)
-> LHsType GhcPs
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar ([AddEpAnn]
an [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
XKindSig GhcPs
annk [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
XTyVar GhcPs
ann) HsBndrVis GhcPs
bvis (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lv RdrName
tv) LHsType GhcPs
k))
chk [AddEpAnn]
ops [AddEpAnn]
cps HsBndrVis GhcPs
bvis (L SrcSpanAnnA
l (HsTyVar XTyVar GhcPs
ann PromotionFlag
_ (L SrcSpanAnnN
ltv RdrName
tv)))
| RdrName -> Bool
isRdrTyVar RdrName
tv
= let
an :: [AddEpAnn]
an = ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps
in
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> [AddEpAnn] -> SrcSpanAnnA
forall an. EpAnn an -> [AddEpAnn] -> EpAnn an
widenLocatedAn SrcSpanAnnA
l (HsBndrVis GhcPs -> AddEpAnn
for_widening HsBndrVis GhcPs
bvisAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
an))
(XUserTyVar GhcPs
-> HsBndrVis GhcPs
-> XRec GhcPs (IdP GhcPs)
-> HsTyVarBndr (HsBndrVis GhcPs) GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar ([AddEpAnn]
an [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
XTyVar GhcPs
ann) HsBndrVis GhcPs
bvis (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
ltv RdrName
tv)))
chk [AddEpAnn]
_ [AddEpAnn]
_ HsBndrVis GhcPs
_ t :: LHsType GhcPs
t@(L SrcSpanAnnA
loc HsType GhcPs
_)
= MsgEnvelope PsMessage -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> MsgEnvelope PsMessage
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LHsType GhcPs
-> SDoc -> RdrName -> [LHsTypeArg GhcPs] -> SDoc -> PsMessage
PsErrUnexpectedTypeInDecl LHsType GhcPs
t SDoc
pp_what (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tc) [LHsTypeArg GhcPs]
tparms SDoc
equals_or_where)
for_widening :: HsBndrVis GhcPs -> AddEpAnn
for_widening :: HsBndrVis GhcPs -> AddEpAnn
for_widening (HsBndrInvisible (EpTok EpaLocation
loc)) = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnAnyclass EpaLocation
loc
for_widening HsBndrVis GhcPs
_ = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnAnyclass (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])
whereDots, equalsDots :: SDoc
whereDots :: SDoc
whereDots = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where ..."
equalsDots :: SDoc
equalsDots = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"= ..."
checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Maybe (LHsContext GhcPs)
Nothing = () -> P ()
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkDatatypeContext (Just LHsContext GhcPs
c)
= do allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
DatatypeContextsBit
unless allowed $ addError $ mkPlainErrorMsgEnvelope (getLocA c) $
(PsErrIllegalDataTypeContext c)
type LRuleTyTmVar = LocatedAn NoEpAnns RuleTyTmVar
data RuleTyTmVar = RuleTyTmVar [AddEpAnn] (LocatedN RdrName) (Maybe (LHsType GhcPs))
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs = (LRuleTyTmVar -> GenLocated EpAnnCO (RuleBndr GhcPs))
-> [LRuleTyTmVar] -> [GenLocated EpAnnCO (RuleBndr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RuleTyTmVar -> RuleBndr GhcPs)
-> LRuleTyTmVar -> GenLocated EpAnnCO (RuleBndr GhcPs)
forall a b.
(a -> b) -> GenLocated EpAnnCO a -> GenLocated EpAnnCO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleTyTmVar -> RuleBndr GhcPs
cvt_one)
where cvt_one :: RuleTyTmVar -> RuleBndr GhcPs
cvt_one (RuleTyTmVar [AddEpAnn]
ann 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 [AddEpAnn]
XCRuleBndr GhcPs
ann XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v
cvt_one (RuleTyTmVar [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 [AddEpAnn]
XRuleBndrSig GhcPs
ann XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v (EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnnCO
forall a. NoAnn a => a
noAnn LHsType GhcPs
sig)
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs]
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs]
mkRuleTyVarBndrs = (LRuleTyTmVar -> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> [LRuleTyTmVar]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LRuleTyTmVar -> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall {a} {l}.
(HasLoc a, HasAnnotation l) =>
GenLocated a RuleTyTmVar -> GenLocated l (HsTyVarBndr () GhcPs)
cvt_one
where cvt_one :: GenLocated a RuleTyTmVar -> GenLocated l (HsTyVarBndr () GhcPs)
cvt_one (L a
l (RuleTyTmVar [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v Maybe (LHsType GhcPs)
Nothing))
= l -> HsTyVarBndr () GhcPs -> GenLocated l (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (a -> l
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l a
l) (XUserTyVar GhcPs
-> () -> XRec GhcPs (IdP GhcPs) -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar [AddEpAnn]
XUserTyVar GhcPs
ann () ((RdrName -> RdrName)
-> 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 a
l (RuleTyTmVar [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v (Just LHsType GhcPs
sig)))
= l -> HsTyVarBndr () GhcPs -> GenLocated l (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (a -> l
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l a
l) (XKindedTyVar GhcPs
-> ()
-> XRec GhcPs (IdP GhcPs)
-> LHsType GhcPs
-> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar [AddEpAnn]
XKindedTyVar GhcPs
ann () ((RdrName -> RdrName)
-> 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, HasLoc a) =>
GenLocated a RdrName -> f ()
check (GenLocated SrcSpanAnnA RdrName -> P ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnA RdrName)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr flag GhcPs -> RdrName)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnA RdrName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr flag GhcPs -> IdP GhcPs
HsTyVarBndr flag GhcPs -> RdrName
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName)
where check :: GenLocated a RdrName -> f ()
check (L a
loc (Unqual OccName
occ)) =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OccName -> FastString
occNameFS OccName
occ FastString -> [FastString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String -> FastString
fsLit String
"family",String -> FastString
fsLit String
"role"])
(MsgEnvelope PsMessage -> f ()
forall a. MsgEnvelope PsMessage -> f a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> f ()) -> MsgEnvelope PsMessage -> f ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
loc) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(OccName -> PsMessage
PsErrParseErrorOnInput OccName
occ))
check GenLocated a RdrName
_ = String -> f ()
forall a. HasCallStack => String -> a
panic String
"checkRuleTyVarBndrNames"
checkRecordSyntax :: (MonadP m, Outputable a) => LocatedA a -> m (LocatedA a)
checkRecordSyntax :: forall (m :: * -> *) a.
(MonadP m, Outputable a) =>
LocatedA a -> m (LocatedA a)
checkRecordSyntax lr :: LocatedA a
lr@(L SrcSpanAnnA
loc a
r)
= do allowed <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
TraditionalRecordSyntaxBit
unless allowed $ addError $ mkPlainErrorMsgEnvelope (locA loc) $
(PsErrIllegalTraditionalRecordSyntax (ppr r))
return 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 gadtSyntax <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
GadtSyntaxBit
unless gadtSyntax $ addError $ mkPlainErrorMsgEnvelope span $
PsErrIllegalWhereInDataDecl
return 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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL (L SrcSpanAnnA
l HsType GhcPs
ty) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = SrcSpanAnnA
-> HsType GhcPs
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
go SrcSpanAnnA
l HsType GhcPs
ty [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go :: SrcSpanAnnA
-> HsType GhcPs
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
go SrcSpanAnnA
ll (HsParTy XParTy GhcPs
an (L SrcSpanAnnA
l (HsStarTy XStarTy GhcPs
_ Bool
isUni))) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops' [AddEpAnn]
cps' LexicalFixity
fix
= do { SrcSpan -> PsMessage -> P ()
addPsMessage (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) PsMessage
PsWarnStarBinder
; let name :: OccName
name = NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
tcClsName (Bool -> FastString
starSym Bool
isUni)
; let a' :: SrcSpanAnnN
a' = SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
newAnns SrcSpanAnnA
ll SrcSpanAnnA
l XParTy GhcPs
AnnParen
an
; (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc, LexicalFixity
fix
, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops') [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps') }
go SrcSpanAnnA
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ ltc :: XRec GhcPs (IdP GhcPs)
ltc@(L SrcSpanAnnN
_ RdrName
tc)) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
| RdrName -> Bool
isRdrTc RdrName
tc = (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc, LexicalFixity
fix, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps)
go SrcSpanAnnA
_ (HsOpTy XOpTy GhcPs
_ PromotionFlag
_ LHsType GhcPs
t1 ltc :: XRec GhcPs (IdP GhcPs)
ltc@(L SrcSpanAnnN
_ RdrName
tc) LHsType GhcPs
t2) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
_fix
| RdrName -> Bool
isRdrTc RdrName
tc = (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
lhsHsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
rhsHsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc, LexicalFixity
Infix, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps)
where lhs :: HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
lhs = XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1
rhs :: HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
rhs = XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2
go SrcSpanAnnA
l (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps) LexicalFixity
fix
where
(AddEpAnn
o,AddEpAnn
c) = RealSrcSpan -> (AddEpAnn, AddEpAnn)
mkParensEpAnn (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l))
go SrcSpanAnnA
_ (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
t1 LHsType GhcPs
t2) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1 (XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc) [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go SrcSpanAnnA
_ (HsAppKindTy XAppKindTy GhcPs
at LHsType GhcPs
ty LHsType GhcPs
ki) [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [AddEpAnn]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
goL LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (XTypeArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XTypeArg p -> ty -> HsArg p tm ty
HsTypeArg XAppKindTy GhcPs
XTypeArg GhcPs
at LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
kiHsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
acc) [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
go SrcSpanAnnA
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts) [] [AddEpAnn]
ops [AddEpAnn]
cps LexicalFixity
fix
= (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(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 (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) (Name -> RdrName
nameRdrName Name
tup_name)
, (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (XValArg GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. XValArg p -> tm -> HsArg p tm ty
HsValArg NoExtField
XValArg GhcPs
noExtField) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts, LexicalFixity
fix, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops)[AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++[AddEpAnn]
cps)
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 SrcSpanAnnA
l HsType GhcPs
_ [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
_ [AddEpAnn]
_ [AddEpAnn]
_ LexicalFixity
_
= MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))],
LexicalFixity, [AddEpAnn]))
-> MsgEnvelope PsMessage
-> P (GenLocated SrcSpanAnnN RdrName,
[HsArg
GhcPs
(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 (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(LHsType GhcPs -> PsMessage
PsErrMalformedTyOrClDecl LHsType GhcPs
ty)
newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
newAnns l :: SrcSpanAnnA
l@(EpAnn EpaLocation
_ (AnnListItem [TrailingAnn]
_) EpAnnComments
csp0) l1 :: SrcSpanAnnA
l1@(EpAnn EpaLocation
ap (AnnListItem [TrailingAnn]
ta) EpAnnComments
csp) (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) =
let
lr :: SrcSpan
lr = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l1) (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
in
EpaLocation -> NameAnn -> EpAnnComments -> SrcSpanAnnN
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan SrcSpan
lr) (NameAdornment
-> EpaLocation
-> EpaLocation
-> EpaLocation
-> [TrailingAnn]
-> NameAnn
NameAnn NameAdornment
NameParens EpaLocation
o EpaLocation
ap EpaLocation
c [TrailingAnn]
ta) (EpAnnComments
csp0 EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
csp)
checkExpBlockArguments :: LHsExpr GhcPs -> PV ()
checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
(LHsExpr GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
checkExpBlockArguments, LHsCmd GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
checkCmdBlockArguments) = (LHsExpr GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
checkExpr, LHsCmd GhcPs -> PV ()
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
checkCmd)
where
checkExpr :: LHsExpr GhcPs -> PV ()
checkExpr :: LHsExpr GhcPs -> PV ()
checkExpr LHsExpr GhcPs
expr = case GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr of
HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (Maybe ModuleName -> LHsExpr GhcPs -> PsMessage
PsErrDoInFunAppExpr Maybe ModuleName
m) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (Maybe ModuleName -> LHsExpr GhcPs -> PsMessage
PsErrMDoInFunAppExpr Maybe ModuleName
m) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsCase {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrCaseInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsLam XLam GhcPs
_ HsLamVariant
lam_variant MatchGroup GhcPs (LHsExpr GhcPs)
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (HsLamVariant -> LHsExpr GhcPs -> PsMessage
PsErrLambdaInFunAppExpr HsLamVariant
lam_variant) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsLet {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrLetInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsIf {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrIfInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsProc {} -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsExpr GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsMessage
PsErrProcInFunAppExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
HsExpr GhcPs
_ -> () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkCmd :: LHsCmd GhcPs -> PV ()
checkCmd :: LHsCmd GhcPs -> PV ()
checkCmd LHsCmd GhcPs
cmd = case GenLocated SrcSpanAnnA (HsCmd GhcPs) -> HsCmd GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd of
HsCmdLam XCmdLamCase GhcPs
_ HsLamVariant
lam_variant MatchGroup GhcPs (LHsCmd GhcPs)
_ -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check (HsLamVariant -> LHsCmd GhcPs -> PsMessage
PsErrLambdaCmdInFunAppCmd HsLamVariant
lam_variant) LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdCase {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrCaseCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdIf {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrIfCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdLet {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrLetCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmdDo {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
(MonadP m, HasLoc a) =>
(GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check LHsCmd GhcPs -> PsMessage
GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsMessage
PsErrDoCmdInFunAppCmd LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
HsCmd GhcPs
_ -> () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
check :: (GenLocated a e -> PsMessage) -> GenLocated a e -> m ()
check GenLocated a e -> PsMessage
err GenLocated a e
a = do
blockArguments <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
BlockArgumentsBit
unless blockArguments $
addError $ mkPlainErrorMsgEnvelope (getLocA a) $ (err a)
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext orig_t :: LHsType GhcPs
orig_t@(L (EpAnn EpaLocation
l AnnListItem
_ EpAnnComments
cs) HsType GhcPs
_orig_t) =
([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([],[],EpAnnComments
cs) LHsType GhcPs
orig_t
where
check :: ([EpaLocation],[EpaLocation],EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check :: ([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([EpaLocation]
oparens,[EpaLocation]
cparens,EpAnnComments
cs) (L SrcSpanAnnA
_l (HsTupleTy XTupleTy GhcPs
ann' HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts))
= ([EpaLocation], [EpaLocation], EpAnnComments)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mkCTuple ([EpaLocation]
oparens [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ [AnnParen -> EpaLocation
ap_open XTupleTy GhcPs
AnnParen
ann'], AnnParen -> EpaLocation
ap_close XTupleTy GhcPs
AnnParen
ann' EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
: [EpaLocation]
cparens, EpAnnComments
cs) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts
check ([EpaLocation]
oparens,[EpaLocation]
cparens,EpAnnComments
cs) (L SrcSpanAnnA
_l (HsExplicitTupleTy XExplicitTupleTy GhcPs
anns [LHsType GhcPs]
ts))
= P Bool
punsAllowed P Bool
-> (Bool
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> P (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
unprocessed
Bool
False -> do
let
([AddEpAnn]
op, [AddEpAnn]
cp) = case XExplicitTupleTy GhcPs
anns of
[AddEpAnn
o, AddEpAnn
c] -> ([AddEpAnn
o], [AddEpAnn
c])
[AddEpAnn
q, AddEpAnn
_, AddEpAnn
c] -> ([AddEpAnn
q], [AddEpAnn
c])
XExplicitTupleTy GhcPs
_ -> ([], [])
([EpaLocation], [EpaLocation], EpAnnComments)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mkCTuple ([EpaLocation]
oparens [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ (AddEpAnn -> EpaLocation
addLoc (AddEpAnn -> EpaLocation) -> [AddEpAnn] -> [EpaLocation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddEpAnn]
op), (AddEpAnn -> EpaLocation
addLoc (AddEpAnn -> EpaLocation) -> [AddEpAnn] -> [EpaLocation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddEpAnn]
cp) [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++ [EpaLocation]
cparens, EpAnnComments
cs) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts
check ([EpaLocation]
opi,[EpaLocation]
cpi,EpAnnComments
csi) (L SrcSpanAnnA
_lp1 (HsParTy XParTy GhcPs
ann' LHsType GhcPs
ty))
= ([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check (AnnParen -> EpaLocation
ap_open XParTy GhcPs
AnnParen
ann'EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
:[EpaLocation]
opi, AnnParen -> EpaLocation
ap_close XParTy GhcPs
AnnParen
ann'EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
:[EpaLocation]
cpi, EpAnnComments
csi) LHsType GhcPs
ty
check ([EpaLocation]
_opi,[EpaLocation]
_cpi,EpAnnComments
_csi) LHsType GhcPs
_t = P (LHsContext GhcPs)
P (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
unprocessed
unprocessed :: P (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
unprocessed =
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnContext -> EpAnnComments -> SrcSpanAnnC
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
l (Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing [] []) EpAnnComments
emptyComments) [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
orig_t])
addLoc :: AddEpAnn -> EpaLocation
addLoc (AddEpAnn AnnKeywordId
_ EpaLocation
l) = EpaLocation
l
mkCTuple :: ([EpaLocation], [EpaLocation], EpAnnComments)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mkCTuple ([EpaLocation]
oparens, [EpaLocation]
cparens, EpAnnComments
cs) [GenLocated SrcSpanAnnA (HsType GhcPs)]
ts =
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnContext -> EpAnnComments -> SrcSpanAnnC
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
l (Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing [EpaLocation]
oparens [EpaLocation]
cparens) EpAnnComments
cs) [GenLocated SrcSpanAnnA (HsType GhcPs)]
ts)
checkImportDecl :: Maybe EpaLocation
-> Maybe EpaLocation
-> P ()
checkImportDecl :: Maybe EpaLocation -> Maybe EpaLocation -> P ()
checkImportDecl Maybe EpaLocation
mPre Maybe EpaLocation
mPost = do
let whenJust :: Maybe a -> (a -> f ()) -> f ()
whenJust Maybe a
mg a -> f ()
f = f () -> (a -> f ()) -> Maybe a -> f ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> f ()
f Maybe a
mg
importQualifiedPostEnabled <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ImportQualifiedPostBit
whenJust mPost $ \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)
whenJust mPost $ \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)
whenJust mPre $ \EpaLocation
pre ->
SrcSpan -> P ()
warnPrepositiveQualifiedModule (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
pre) Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
checkPattern :: LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern :: LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern = PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. PV a -> P a
runPV (PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> LocatedA (PatBuilder GhcPs)
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat
checkPattern_details :: ParseContext -> PV (LocatedA (PatBuilder GhcPs)) -> P (LPat GhcPs)
checkPattern_details :: ParseContext -> PV (LocatedA (PatBuilder GhcPs)) -> P (LPat GhcPs)
checkPattern_details ParseContext
extraDetails PV (LocatedA (PatBuilder GhcPs))
pp = ParseContext
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
extraDetails (PV (LocatedA (PatBuilder GhcPs))
pp PV (LocatedA (PatBuilder GhcPs))
-> (LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. PV a -> (a -> PV b) -> PV b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat)
checkLArgPat :: LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs)
checkLArgPat :: LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs)
checkLArgPat (L SrcSpanAnnA
l (ArgPatBuilderVisPat PatBuilder GhcPs
p))
= SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsConPatTyArg GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
l (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l PatBuilder GhcPs
p) [] []
checkLArgPat (L SrcSpanAnnA
l (ArgPatBuilderArgPat Pat GhcPs
p)) = GenLocated SrcSpanAnnA (Pat GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Pat GhcPs
p)
checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat 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 = [AddEpAnn]
XConPat GhcPs
forall a. NoAnn a => 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 ([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
ctx <- PV ParseContext
askParseContext
patFail (locA l) . PsErrInPat e $ PEIP_RecPattern args YesPatIsRecursive ctx
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
_ (PatBuilderAppType LocatedA (PatBuilder GhcPs)
f EpToken "@"
at HsTyPat 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 (XConPatTyArg GhcPs -> HsTyPat GhcPs -> HsConPatTyArg GhcPs
forall p. XConPatTyArg p -> HsTyPat p -> HsConPatTyArg p
HsConPatTyArg EpToken "@"
XConPatTyArg GhcPs
at HsTyPat GhcPs
t HsConPatTyArg GhcPs
-> [HsConPatTyArg GhcPs] -> [HsConPatTyArg GhcPs]
forall a. a -> [a] -> [a]
: [HsConPatTyArg GhcPs]
tyargs) [LPat GhcPs]
args
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
_ (PatBuilderApp LocatedA (PatBuilder GhcPs)
f LocatedA (PatBuilder GhcPs)
e)) [] [LPat GhcPs]
args = do
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
checkPat loc f [] (p : args)
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
l PatBuilder GhcPs
e) [] [] = do
p <- SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat SrcSpanAnnA
loc PatBuilder GhcPs
e
return (L l p)
checkPat SrcSpanAnnA
loc LocatedA (PatBuilder GhcPs)
e [HsConPatTyArg GhcPs]
_ [LPat GhcPs]
_ = do
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
patFail (locA loc) (PsErrInPat (unLoc e) details)
checkAPat :: SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat :: SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat SrcSpanAnnA
loc PatBuilder GhcPs
e0 = do
nPlusKPatterns <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
NPlusKPatternsBit
case 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) -> [AddEpAnn] -> Pat GhcPs
mkNPat (EpAnnCO -> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) HsOverLit GhcPs
pos_lit) Maybe NoExtField
Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing [AddEpAnn]
forall a. NoAnn a => a
noAnn)
PatBuilderOpApp
(L SrcSpanAnnA
_ (PatBuilderVar (L SrcSpanAnnN
nloc RdrName
n)))
(L SrcSpanAnnN
l RdrName
plus)
(L SrcSpanAnnA
lloc (PatBuilderOverLit lit :: HsOverLit GhcPs
lit@(OverLit {ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = HsIntegral {}})))
[AddEpAnn]
_
| Bool
nPlusKPatterns Bool -> Bool -> Bool
&& (RdrName
plus RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
plus_RDR)
-> Pat GhcPs -> PV (Pat GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpaLocation -> Pat GhcPs
mkNPlusKPat (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
nloc RdrName
n) (EpAnnCO -> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
lloc) HsOverLit GhcPs
lit)
(SrcSpanAnnN -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry SrcSpanAnnN
l))
PatBuilderOpApp LocatedA (PatBuilder GhcPs)
_ GenLocated SrcSpanAnnN RdrName
op LocatedA (PatBuilder GhcPs)
_ [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. HasLoc a => GenLocated 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 [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon RdrName
c -> do
l <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
l
r <- checkLPat r
return $ ConPat
{ pat_con_ext = anns
, pat_con = L cl c
, pat_args = InfixCon l r
}
PatBuilderPar EpToken "("
lpar LocatedA (PatBuilder GhcPs)
e EpToken ")"
rpar -> do
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
return (ParPat (lpar, rpar) p)
PatBuilder GhcPs
_ -> do
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
patFail (locA loc) (PsErrInPat e0 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 e a. HasAnnotation e => a -> GenLocated e a
noLocA RdrName
pun_RDR)
plus_RDR, pun_RDR :: RdrName
plus_RDR :: RdrName
plus_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"+")
pun_RDR :: RdrName
pun_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"pun-right-hand-side")
checkPatField :: LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
checkPatField :: LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
checkPatField (L SrcSpanAnnA
l HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
fld) = do p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat (HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))
fld)
return (L l (fld { hfbRHS = p }))
patFail :: SrcSpan -> PsMessage -> PV a
patFail :: forall a. SrcSpan -> PsMessage -> PV a
patFail SrcSpan
loc PsMessage
msg = MsgEnvelope PsMessage -> PV a
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV a) -> MsgEnvelope PsMessage -> PV a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
msg
patIsRec :: RdrName -> Bool
patIsRec :: RdrName -> Bool
patIsRec RdrName
e = RdrName
e RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"rec")
checkValDef :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> (HsMultAnn GhcPs, Maybe (AddEpAnn, LHsType GhcPs))
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
checkValDef :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> (HsMultAnn GhcPs, Maybe (AddEpAnn, LHsType GhcPs))
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (HsMultAnn GhcPs
mult, Just (AddEpAnn
sigAnn, LHsType GhcPs
sig)) Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
= do lhs' <- PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. PV a -> P a
runPV (PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
forall b.
DisambECP b =>
SrcSpanAnnA
-> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
mkHsTySigPV (LocatedA (PatBuilder GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA LocatedA (PatBuilder GhcPs)
lhs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig) LocatedA (PatBuilder GhcPs)
lhs LHsType GhcPs
sig [AddEpAnn
sigAnn]
PV (LocatedA (PatBuilder GhcPs))
-> (LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. PV a -> (a -> PV b) -> PV b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLPat
checkPatBind loc lhs' grhss mult
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (HsMultAnn GhcPs
mult_ann, Maybe (AddEpAnn, LHsType GhcPs)
Nothing) Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
| HsNoMultAnn{} <- HsMultAnn GhcPs
mult_ann
= do { mb_fun <- LocatedA (PatBuilder GhcPs)
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
lhs
; case mb_fun of
Just (GenLocated SrcSpanAnnN RdrName
fun, LexicalFixity
is_infix, [LocatedA (ArgPatBuilder GhcPs)]
pats, [AddEpAnn]
ann) ->
SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> LexicalFixity
-> [LocatedA (ArgPatBuilder 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 (ArgPatBuilder GhcPs)]
pats Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
Nothing -> do
lhs' <- LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern LocatedA (PatBuilder GhcPs)
lhs
checkPatBind loc lhs' grhss mult_ann }
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (HsMultAnn GhcPs
mult_ann, Maybe (AddEpAnn, LHsType GhcPs)
Nothing) Located (GRHSs GhcPs (LHsExpr GhcPs))
ghrss
= do lhs' <- LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern LocatedA (PatBuilder GhcPs)
lhs
checkPatBind loc lhs' ghrss mult_ann
checkFunBind :: SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> LocatedN RdrName
-> LexicalFixity
-> [LocatedA (ArgPatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
checkFunBind :: SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> LexicalFixity
-> [LocatedA (ArgPatBuilder 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 (ArgPatBuilder GhcPs)]
pats (L SrcSpan
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss)
= do ps <- ParseContext
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> P [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
extraDetails ((LocatedA (ArgPatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [LocatedA (ArgPatBuilder GhcPs)]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs)
LocatedA (ArgPatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
checkLArgPat [LocatedA (ArgPatBuilder GhcPs)]
pats)
let match_span = SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan
locF
return (makeFunBind fun (L (noAnnSrcSpan $ locA match_span)
[L match_span (Match { m_ext = ann
, m_ctxt = FunRhs
{ mc_fun = fun
, mc_fixity = is_infix
, mc_strictness = strictness }
, m_pats = ps
, m_grhss = 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
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBind GhcPs)
checkPatBind :: SrcSpan
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc (L SrcSpanAnnA
_ (BangPat XBangPat GhcPs
ans (L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ XRec GhcPs (IdP GhcPs)
v))))
(L SrcSpan
_match_span GRHSs GhcPs (LHsExpr GhcPs)
grhss) (HsNoMultAnn XNoMultAnn GhcPs
_)
= HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (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 e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc)
[SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc) ([AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m [AddEpAnn]
XBangPat GhcPs
ans XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
v)]))
where
m :: [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m [AddEpAnn]
a GenLocated SrcSpanAnnN RdrName
v = Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = [AddEpAnn]
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a
, m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt = FunRhs { mc_fun :: GenLocated SrcSpanAnnN RdrName
mc_fun = 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 LPat GhcPs
lhs (L SrcSpan
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss) HsMultAnn GhcPs
mult = do
HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPatBind GhcPs GhcPs
-> LPat GhcPs
-> HsMultAnn GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL
-> HsMultAnn idL
-> GRHSs idR (LHsExpr idR)
-> HsBindLR idL idR
PatBind XPatBind GhcPs GhcPs
NoExtField
noExtField LPat GhcPs
lhs HsMultAnn GhcPs
mult GRHSs GhcPs (LHsExpr GhcPs)
grhss)
checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
checkValSigLhs :: LHsExpr GhcPs -> P (GenLocated SrcSpanAnnN RdrName)
checkValSigLhs lhs :: LHsExpr GhcPs
lhs@(L SrcSpanAnnA
l HsExpr GhcPs
lhs_expr) =
case HsExpr GhcPs
lhs_expr of
HsVar XVar GhcPs
_ lrdr :: XRec GhcPs (IdP GhcPs)
lrdr@(L SrcSpanAnnN
_ RdrName
v) -> RdrName
-> GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
check_var RdrName
v XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
lrdr
HsExpr GhcPs
_ -> PsInvalidTypeSignature -> P (GenLocated SrcSpanAnnN RdrName)
make_err PsInvalidTypeSignature
PsErrInvalidTypeSig_Other
where
check_var :: RdrName
-> GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
check_var RdrName
v GenLocated SrcSpanAnnN RdrName
lrdr
| Bool -> Bool
not (RdrName -> Bool
isUnqual RdrName
v) = PsInvalidTypeSignature -> P (GenLocated SrcSpanAnnN RdrName)
make_err PsInvalidTypeSignature
PsErrInvalidTypeSig_Qualified
| OccName -> Bool
isDataOcc OccName
occ_n = PsInvalidTypeSignature -> P (GenLocated SrcSpanAnnN RdrName)
make_err PsInvalidTypeSignature
PsErrInvalidTypeSig_DataCon
| Bool
otherwise = GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpanAnnN RdrName
lrdr
where occ_n :: OccName
occ_n = RdrName -> OccName
rdrNameOcc RdrName
v
make_err :: PsInvalidTypeSignature -> P (GenLocated SrcSpanAnnN RdrName)
make_err PsInvalidTypeSignature
reason = 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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsInvalidTypeSignature -> LHsExpr GhcPs -> PsMessage
PsErrInvalidTypeSignature PsInvalidTypeSignature
reason LHsExpr GhcPs
lhs)
checkDoAndIfThenElse
:: (Outputable a, Outputable b, Outputable c)
=> (a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse :: forall a b c.
(Outputable a, Outputable b, Outputable c) =>
(a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse a -> Bool -> b -> Bool -> c -> PsMessage
err GenLocated SrcSpanAnnA a
guardExpr Bool
semiThen LocatedA b
thenExpr Bool
semiElse GenLocated SrcSpanAnnA c
elseExpr
| Bool
semiThen Bool -> Bool -> Bool
|| Bool
semiElse = do
doAndIfThenElse <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
DoAndIfThenElseBit
let e = a -> Bool -> b -> Bool -> c -> PsMessage
err (GenLocated SrcSpanAnnA a -> a
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA a
guardExpr)
Bool
semiThen (LocatedA b -> b
forall l e. GenLocated l e -> e
unLoc LocatedA b
thenExpr)
Bool
semiElse (GenLocated SrcSpanAnnA c -> c
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA c
elseExpr)
loc = Located a -> Located c -> SrcSpan
forall a b. Located a -> Located b -> SrcSpan
combineLocs (GenLocated SrcSpanAnnA a -> Located a
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpanAnnA a
guardExpr) (GenLocated SrcSpanAnnA c -> Located c
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpanAnnA c
elseExpr)
unless doAndIfThenElse $ addError (mkPlainErrorMsgEnvelope loc e)
| Bool
otherwise = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isFunLhs :: LocatedA (PatBuilder GhcPs)
-> P (Maybe (LocatedN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)],[AddEpAnn]))
isFunLhs :: LocatedA (PatBuilder GhcPs)
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
e = LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
e [] [] []
where
mk :: GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk = (PatBuilder p -> ArgPatBuilder p)
-> GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PatBuilder p -> ArgPatBuilder p
forall p. PatBuilder p -> ArgPatBuilder p
ArgPatBuilderVisPat
go :: LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
go (L SrcSpanAnnA
_ (PatBuilderVar (L SrcSpanAnnN
loc RdrName
f))) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
| Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
f) = Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [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 (ArgPatBuilder GhcPs)]
es, ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps))
go (L SrcSpanAnnA
_ (PatBuilderApp LocatedA (PatBuilder GhcPs)
f LocatedA (PatBuilder GhcPs)
e)) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps = LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
f (LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk LocatedA (PatBuilder GhcPs)
eLocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
:[LocatedA (ArgPatBuilder GhcPs)]
es) [AddEpAnn]
ops [AddEpAnn]
cps
go (L SrcSpanAnnA
l (PatBuilderPar EpToken "("
_ LocatedA (PatBuilder GhcPs)
e EpToken ")"
_)) es :: [LocatedA (ArgPatBuilder GhcPs)]
es@(LocatedA (ArgPatBuilder GhcPs)
_:[LocatedA (ArgPatBuilder GhcPs)]
_) [AddEpAnn]
ops [AddEpAnn]
cps = LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
e [LocatedA (ArgPatBuilder GhcPs)]
es (AddEpAnn
oAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ops) (AddEpAnn
cAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
cps)
where
(AddEpAnn
o,AddEpAnn
c) = RealSrcSpan -> (AddEpAnn, AddEpAnn)
mkParensEpAnn (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
go (L SrcSpanAnnA
loc (PatBuilderOpApp LocatedA (PatBuilder GhcPs)
l (L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder GhcPs)
r [AddEpAnn]
anns)) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
| Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
op)
= Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [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 GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk LocatedA (PatBuilder GhcPs)
lLocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
:LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk LocatedA (PatBuilder GhcPs)
rLocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
:[LocatedA (ArgPatBuilder GhcPs)]
es), ([AddEpAnn]
anns [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps)))
| Bool
otherwise
= do { mb_l <- LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
l [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
; return (reassociate =<< mb_l) }
where
reassociate :: (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
reassociate (GenLocated SrcSpanAnnN RdrName
op', LexicalFixity
Infix, LocatedA (ArgPatBuilder GhcPs)
j : L SrcSpanAnnA
k_loc (ArgPatBuilderVisPat PatBuilder GhcPs
k) : [LocatedA (ArgPatBuilder GhcPs)]
es', [AddEpAnn]
anns')
= (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnN RdrName
op', LexicalFixity
Infix, LocatedA (ArgPatBuilder GhcPs)
j LocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
: LocatedA (ArgPatBuilder GhcPs)
op_app LocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
: [LocatedA (ArgPatBuilder GhcPs)]
es', [AddEpAnn]
anns')
where
op_app :: LocatedA (ArgPatBuilder GhcPs)
op_app = LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall {p}.
GenLocated SrcSpanAnnA (PatBuilder p)
-> GenLocated SrcSpanAnnA (ArgPatBuilder p)
mk (LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs) -> LocatedA (ArgPatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LocatedA (PatBuilder GhcPs)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder p)
-> [AddEpAnn]
-> PatBuilder p
PatBuilderOpApp (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
k_loc PatBuilder GhcPs
k)
(SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder GhcPs)
r ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
ops [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
cps))
reassociate (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
_other = Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
forall a. Maybe a
Nothing
go (L SrcSpanAnnA
_ (PatBuilderAppType LocatedA (PatBuilder GhcPs)
pat EpToken "@"
tok ty_pat :: HsTyPat GhcPs
ty_pat@(HsTP XHsTP GhcPs
_ (L (EpAnn EpaLocation
anc AnnListItem
ann EpAnnComments
cs) HsType GhcPs
_)))) [LocatedA (ArgPatBuilder GhcPs)]
es [AddEpAnn]
ops [AddEpAnn]
cps
= LocatedA (PatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [AddEpAnn]
-> [AddEpAnn]
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
pat (SrcSpanAnnA
-> ArgPatBuilder GhcPs -> LocatedA (ArgPatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc' AnnListItem
ann EpAnnComments
cs) (Pat GhcPs -> ArgPatBuilder GhcPs
forall p. Pat p -> ArgPatBuilder p
ArgPatBuilderArgPat Pat GhcPs
invis_pat) LocatedA (ArgPatBuilder GhcPs)
-> [LocatedA (ArgPatBuilder GhcPs)]
-> [LocatedA (ArgPatBuilder GhcPs)]
forall a. a -> [a] -> [a]
: [LocatedA (ArgPatBuilder GhcPs)]
es) [AddEpAnn]
ops [AddEpAnn]
cps
where invis_pat :: Pat GhcPs
invis_pat = XInvisPat GhcPs -> HsTyPat (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XInvisPat p -> HsTyPat (NoGhcTc p) -> Pat p
InvisPat XInvisPat GhcPs
EpToken "@"
tok HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
ty_pat
anc' :: EpaLocation
anc' = case EpToken "@"
tok of
EpToken "@"
NoEpTok -> EpaLocation
anc
EpTok EpaLocation
l -> EpaLocation -> [AddEpAnn] -> EpaLocation
widenAnchor EpaLocation
anc [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnAnyclass EpaLocation
l]
go LocatedA (PatBuilder GhcPs)
_ [LocatedA (ArgPatBuilder GhcPs)]
_ [AddEpAnn]
_ [AddEpAnn]
_ = Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
-> P (Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn]))
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
(GenLocated SrcSpanAnnN RdrName, LexicalFixity,
[LocatedA (ArgPatBuilder GhcPs)], [AddEpAnn])
forall a. Maybe a
Nothing
data ArgPatBuilder p
= ArgPatBuilderVisPat (PatBuilder p)
| ArgPatBuilderArgPat (Pat p)
instance Outputable (ArgPatBuilder GhcPs) where
ppr :: ArgPatBuilder GhcPs -> SDoc
ppr (ArgPatBuilderVisPat PatBuilder GhcPs
p) = PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
p
ppr (ArgPatBuilderArgPat Pat GhcPs
p) = Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcPs
p
mkBangTy :: [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy :: [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy [AddEpAnn]
anns SrcStrictness
strictness =
XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy [AddEpAnn]
XBangTy GhcPs
anns (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
strictness)
data UnpackednessPragma =
UnpackednessPragma [AddEpAnn] SourceText SrcUnpackedness
addUnpackednessP :: MonadP m => Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP :: forall (m :: * -> *).
MonadP m =>
Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP (L SrcSpan
lprag (UnpackednessPragma [AddEpAnn]
anns SourceText
prag SrcUnpackedness
unpk)) LHsType GhcPs
ty = do
let l' :: SrcSpan
l' = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
lprag (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
let t' :: HsType GhcPs
t' = [AddEpAnn] -> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness [AddEpAnn]
anns LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
GenLocated SrcSpanAnnA (HsType GhcPs)
-> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l') HsType GhcPs
t')
where
addUnpackedness :: [AddEpAnn] -> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness [AddEpAnn]
an (L SrcSpanAnnA
_ (HsBangTy XBangTy GhcPs
x HsSrcBang
bang LHsType GhcPs
t))
| HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
strictness <- HsSrcBang
bang
= XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy ([AddEpAnn]
an [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> [AddEpAnn]
XBangTy GhcPs
x) (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
prag SrcUnpackedness
unpk SrcStrictness
strictness) LHsType GhcPs
t
addUnpackedness [AddEpAnn]
an GenLocated SrcSpanAnnA (HsType GhcPs)
t
= XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy [AddEpAnn]
XBangTy GhcPs
an (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
prag SrcUnpackedness
unpk SrcStrictness
NoSrcStrict) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
checkMonadComp :: PV HsDoFlavour
checkMonadComp :: PV HsDoFlavour
checkMonadComp = do
monadComprehensions <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
MonadComprehensionsBit
return $ if monadComprehensions
then MonadComp
else ListComp
newtype ECP =
ECP { ECP -> forall b. DisambECP b => PV (LocatedA b)
unECP :: forall b. DisambECP b => PV (LocatedA b) }
ecpFromExp :: LHsExpr GhcPs -> ECP
ecpFromExp :: LHsExpr GhcPs -> ECP
ecpFromExp LHsExpr GhcPs
a = (forall b. DisambECP b => PV (LocatedA b)) -> ECP
ECP (LHsExpr GhcPs -> PV (LocatedA b)
forall b. DisambECP b => LHsExpr GhcPs -> PV (LocatedA b)
ecpFromExp' LHsExpr GhcPs
a)
ecpFromCmd :: LHsCmd GhcPs -> ECP
ecpFromCmd :: LHsCmd GhcPs -> ECP
ecpFromCmd LHsCmd GhcPs
a = (forall b. DisambECP b => PV (LocatedA b)) -> ECP
ECP (LHsCmd GhcPs -> PV (LocatedA b)
forall b. DisambECP b => LHsCmd GhcPs -> PV (LocatedA b)
ecpFromCmd' LHsCmd GhcPs
a)
type Fbind b = Either (LHsRecField GhcPs (LocatedA b)) (LHsRecProj GhcPs (LocatedA b))
class DisambInfixOp b where
mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN b)
mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN b)
mkHsInfixHolePV :: LocatedN (HsExpr GhcPs) -> PV (LocatedN b)
instance DisambInfixOp (HsExpr GhcPs) where
mkHsVarOpPV :: 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 :: LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
mkHsInfixHolePV LocatedN (HsExpr GhcPs)
h = LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedN (HsExpr GhcPs)
h
instance DisambInfixOp RdrName where
mkHsConOpPV :: 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 :: LocatedN (HsExpr GhcPs) -> PV (GenLocated SrcSpanAnnN RdrName)
mkHsInfixHolePV (L SrcSpanAnnN
l HsExpr GhcPs
_) = MsgEnvelope PsMessage -> PV (GenLocated SrcSpanAnnN RdrName)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (GenLocated SrcSpanAnnN RdrName))
-> MsgEnvelope PsMessage -> PV (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. HasLoc a => a -> SrcSpan
getHasLoc SrcSpanAnnN
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrInvalidInfixHole
type AnnoBody b
= ( Anno (GRHS GhcPs (LocatedA (Body b GhcPs))) ~ EpAnnCO
, Anno [LocatedA (Match GhcPs (LocatedA (Body b GhcPs)))] ~ SrcSpanAnnL
, Anno (Match GhcPs (LocatedA (Body b GhcPs))) ~ SrcSpanAnnA
, Anno (StmtLR GhcPs GhcPs (LocatedA (Body (Body b GhcPs) GhcPs))) ~ SrcSpanAnnA
, Anno [LocatedA (StmtLR GhcPs GhcPs
(LocatedA (Body (Body (Body b GhcPs) GhcPs) GhcPs)))] ~ SrcSpanAnnL
)
class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
type Body b :: Type -> Type
ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA b)
ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b)
mkHsProjUpdatePV :: SrcSpan -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b))
mkHsLetPV
:: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> LocatedA b
-> PV (LocatedA b)
type InfixOp b
superInfixOp
:: (DisambInfixOp (InfixOp b) => PV (LocatedA b )) -> PV (LocatedA b)
mkHsOpAppPV :: SrcSpan -> LocatedA b -> LocatedN (InfixOp b) -> LocatedA b
-> PV (LocatedA b)
mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> (LocatedL [LMatch GhcPs (LocatedA b)])
-> EpAnnHsCase -> PV (LocatedA b)
mkHsLamPV :: SrcSpan -> HsLamVariant
-> (LocatedL [LMatch GhcPs (LocatedA b)]) -> [AddEpAnn]
-> PV (LocatedA b)
type FunArg b
superFunArg :: (DisambECP (FunArg b) => PV (LocatedA b)) -> PV (LocatedA b)
mkHsAppPV :: SrcSpanAnnA -> LocatedA b -> LocatedA (FunArg b) -> PV (LocatedA b)
mkHsAppTypePV :: SrcSpanAnnA -> LocatedA b -> EpToken "@" -> LHsType GhcPs -> PV (LocatedA b)
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> LocatedA b
-> Bool
-> LocatedA b
-> AnnsIf
-> PV (LocatedA b)
mkHsDoPV ::
SrcSpan ->
Maybe ModuleName ->
LocatedL [LStmt GhcPs (LocatedA b)] ->
AnnList ->
PV (LocatedA b)
mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b)
mkHsVarPV :: LocatedN RdrName -> PV (LocatedA b)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (LocatedA b)
mkHsOverLitPV :: LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a b)
mkHsWildCardPV :: (NoAnn a) => SrcSpan -> PV (LocatedAn a b)
mkHsTySigPV
:: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA b)
mkHsRecordPV ::
Bool ->
SrcSpan ->
SrcSpan ->
LocatedA b ->
([Fbind b], Maybe SrcSpan) ->
[AddEpAnn] ->
PV (LocatedA b)
mkHsNegAppPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkHsSectionR_PV
:: SrcSpan -> LocatedA (InfixOp b) -> LocatedA b -> PV (LocatedA b)
mkHsViewPatPV
:: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkHsAsPatPV
:: SrcSpan -> LocatedN RdrName -> EpToken "@" -> LocatedA b -> PV (LocatedA b)
mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkHsBangPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
mkSumOrTuplePV
:: SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddEpAnn] -> PV (LocatedA b)
mkHsEmbTyPV :: SrcSpan -> EpToken "type" -> LHsType GhcPs -> PV (LocatedA b)
rejectPragmaPV :: LocatedA b -> PV ()
instance DisambECP (HsCmd GhcPs) where
type Body (HsCmd GhcPs) = HsCmd
ecpFromCmd' :: LHsCmd GhcPs -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
ecpFromCmd' = LHsCmd GhcPs -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return
ecpFromExp' :: LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
ecpFromExp' (L SrcSpanAnnA
l HsExpr GhcPs
e) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e)
mkHsProjUpdatePV :: SrcSpan
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
_ Bool
_ [AddEpAnn]
_ = MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))))
-> MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrOverloadedRecordDotInvalid
mkHsLamPV :: SrcSpan
-> HsLamVariant
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLamPV SrcSpan
l HsLamVariant
lam_variant (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
m) [AddEpAnn]
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let mg = Origin
-> HsLamVariant
-> LocatedL
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> HsLamVariant
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup Origin
FromSource HsLamVariant
lam_variant (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> LocatedL
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
m)
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdLam anns lam_variant mg)
mkHsLetPV :: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLetPV SrcSpan
l EpToken "let"
tkLet HsLocalBinds GhcPs
bs EpToken "in"
tkIn GenLocated SrcSpanAnnA (HsCmd GhcPs)
e = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdLet (tkLet, tkIn) bs e)
type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
superInfixOp :: (DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
superInfixOp DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m
mkHsOpAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LocatedN (InfixOp (HsCmd GhcPs))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsOpAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c1 LocatedN (InfixOp (HsCmd GhcPs))
op GenLocated SrcSpanAnnA (HsCmd GhcPs)
c2 = do
let cmdArg :: GenLocated a (HsCmd p) -> GenLocated l (HsCmdTop p)
cmdArg GenLocated a (HsCmd p)
c = l -> HsCmdTop p -> GenLocated l (HsCmdTop p)
forall l e. l -> e -> GenLocated l e
L (a -> l
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l (a -> l) -> a -> l
forall a b. (a -> b) -> a -> b
$ GenLocated a (HsCmd p) -> a
forall l e. GenLocated l e -> l
getLoc GenLocated a (HsCmd p)
c) (HsCmdTop p -> GenLocated l (HsCmdTop p))
-> HsCmdTop p -> GenLocated l (HsCmdTop p)
forall a b. (a -> b) -> a -> b
$ XCmdTop p -> XRec p (HsCmd p) -> HsCmdTop p
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop XCmdTop p
NoExtField
noExtField XRec p (HsCmd p)
GenLocated a (HsCmd p)
c
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ HsCmdArrForm (AnnList Nothing Nothing Nothing [] []) (reLoc op) Infix Nothing [cmdArg c1, cmdArg 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
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let 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)
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdCase anns c mg)
type FunArg (HsCmd GhcPs) = HsExpr GhcPs
superFunArg :: (DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
superFunArg DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m
mkHsAppPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LocatedA (FunArg (HsCmd GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAppPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LocatedA (FunArg (HsCmd GhcPs))
e = do
LHsCmd GhcPs -> PV ()
checkCmdBlockArguments LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
LocatedA (FunArg (HsCmd GhcPs))
e
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XCmdApp GhcPs -> LHsCmd GhcPs -> LHsExpr GhcPs -> HsCmd GhcPs
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp XCmdApp GhcPs
NoExtField
noExtField LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LHsExpr GhcPs
LocatedA (FunArg (HsCmd GhcPs))
e)
mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c EpToken "@"
_ LHsType GhcPs
t = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t)
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> AnnsIf
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsIfPV SrcSpan
l LHsExpr GhcPs
c Bool
semi1 GenLocated SrcSpanAnnA (HsCmd GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsCmd GhcPs)
b AnnsIf
anns = do
(HsExpr GhcPs
-> Bool -> HsCmd GhcPs -> Bool -> HsCmd GhcPs -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV ()
forall a b c.
(Outputable a, Outputable b, Outputable c) =>
(a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse HsExpr GhcPs
-> Bool -> HsCmd GhcPs -> Bool -> HsCmd GhcPs -> PsMessage
PsErrSemiColonsInCondCmd LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
c Bool
semi1 GenLocated SrcSpanAnnA (HsCmd GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsCmd GhcPs)
b
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns)
mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
Nothing LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
stmts AnnList
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo anns stmts)
mkHsDoPV SrcSpan
l (Just ModuleName
m) LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
_ AnnList
_ = MsgEnvelope PsMessage -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ ModuleName -> PsMessage
PsErrQualifiedDoInCmd ModuleName
m
mkHsParPV :: SrcSpan
-> EpToken "("
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> EpToken ")"
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsParPV SrcSpan
l EpToken "("
lpar GenLocated SrcSpanAnnA (HsCmd GhcPs)
c EpToken ")"
rpar = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c)
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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
l) (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLitPV (L SrcSpan
l HsLit GhcPs
a) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (HsLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit GhcPs
a)
mkHsOverLitPV :: forall a.
LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a (HsCmd GhcPs))
mkHsOverLitPV (L EpAnn a
l HsOverLit GhcPs
a) = SrcSpan -> SDoc -> PV (LocatedAn a (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (EpAnn a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpAnn a
l) (HsOverLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcPs
a)
mkHsWildCardPV :: forall a. NoAnn a => SrcSpan -> PV (LocatedAn a (HsCmd GhcPs))
mkHsWildCardPV SrcSpan
l = SrcSpan -> SDoc -> PV (LocatedAn a (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_")
mkHsTySigPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsTySigPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
a LHsType GhcPs
sig [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"::" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig)
mkHsExplicitListPV :: SrcSpan
-> [GenLocated SrcSpanAnnA (HsCmd GhcPs)]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsExplicitListPV SrcSpan
l [GenLocated SrcSpanAnnA (HsCmd GhcPs)]
xs AnnList
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ((GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsCmd GhcPs)] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (HsCmd GhcPs)]
xs)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
sp) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (Bool -> Maybe Name -> HsUntypedSplice GhcPs -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True Maybe Name
forall a. Maybe a
Nothing HsUntypedSplice GhcPs
sp)
mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> ([Fbind (HsCmd GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsRecordPV Bool
_ SrcSpan
l SrcSpan
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
a ([Fbind (HsCmd GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
_ = do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsCmd GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
fbinds
if Bool -> Bool
not ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
ps)
then MsgEnvelope PsMessage -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> MsgEnvelope PsMessage
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrOverloadedRecordDotInvalid
else SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([LocatedA
(HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Maybe SrcSpan
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (p :: Pass) arg.
[LocatedA (HsRecField (GhcPass p) arg)]
-> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields [LocatedA
(HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
fs Maybe SrcSpan
ddLoc)
mkHsNegAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsNegAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
a [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a)
mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (HsCmd GhcPs))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (HsCmd GhcPs))
op GenLocated SrcSpanAnnA (HsCmd GhcPs)
c = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
let pp_op :: SDoc
pp_op = SDoc -> Maybe SDoc -> SDoc
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc
forall a. HasCallStack => String -> a
panic String
"cannot print infix operator")
(HsExpr GhcPs -> Maybe SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsExpr (GhcPass p) -> Maybe SDoc
ppr_infix_expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
LocatedA (InfixOp (HsCmd GhcPs))
op))
in SDoc
pp_op SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a GenLocated SrcSpanAnnA (HsCmd GhcPs)
b [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"->" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
b
mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> EpToken "@"
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v EpToken "@"
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
c = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (Boxity -> SumOrTuple (HsCmd GhcPs) -> SDoc
forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple Boxity
boxity SumOrTuple (HsCmd GhcPs)
a)
mkHsEmbTyPV :: SrcSpan
-> EpToken "type"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsEmbTyPV SrcSpan
l EpToken "type"
_ LHsType GhcPs
ty = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
rejectPragmaPV :: GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
rejectPragmaPV GenLocated SrcSpanAnnA (HsCmd GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cmdFail :: SrcSpan -> SDoc -> PV a
cmdFail :: forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
loc SDoc
e = MsgEnvelope PsMessage -> PV a
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV a) -> MsgEnvelope PsMessage -> PV a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SDoc -> PsMessage
PsErrParseErrorInCmd SDoc
e
checkLamMatchGroup :: SrcSpan -> HsLamVariant -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup :: SrcSpan
-> HsLamVariant -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
checkLamMatchGroup SrcSpan
l HsLamVariant
LamSingle (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ (GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
matches:[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_))}) = do
Bool -> PV () -> PV ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LPat GhcPs]
forall (id :: Pass) body.
LMatch (GhcPass id) body -> [LPat (GhcPass id)]
hsLMatchPats LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
matches)) (PV () -> PV ()) -> PV () -> PV ()
forall a b. (a -> b) -> a -> b
$ MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrEmptyLambda
checkLamMatchGroup SrcSpan
_ HsLamVariant
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance DisambECP (HsExpr GhcPs) where
type Body (HsExpr GhcPs) = HsExpr
ecpFromCmd' :: LHsCmd GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ecpFromCmd' (L SrcSpanAnnA
l HsCmd GhcPs
c) = do
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ HsCmd GhcPs -> PsMessage
PsErrArrowCmdInExpr HsCmd GhcPs
c
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
ecpFromExp' :: LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ecpFromExp' = LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return
mkHsProjUpdatePV :: SrcSpan
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
fields GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
isPun [AddEpAnn]
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ mkRdrProjUpdate (EpAnn (spanAsAnchor l) noAnn cs) fields arg isPun anns
mkHsLetPV :: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLetPV SrcSpan
l EpToken "let"
tkLet HsLocalBinds GhcPs
bs EpToken "in"
tkIn GenLocated SrcSpanAnnA (HsExpr GhcPs)
c = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsLet (tkLet, tkIn) bs 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
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ OpApp [] e1 (reLoc op) 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
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let 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)
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCase anns e mg)
mkHsLamPV :: SrcSpan
-> HsLamVariant
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLamPV SrcSpan
l HsLamVariant
lam_variant (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
m) [AddEpAnn]
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
let mg = Origin
-> HsLamVariant
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> HsLamVariant
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup Origin
FromSource HsLamVariant
lam_variant (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
m)
checkLamMatchGroup l lam_variant mg
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsLam anns lam_variant mg)
type FunArg (HsExpr GhcPs) = HsExpr GhcPs
superFunArg :: (DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
superFunArg DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m
mkHsAppPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LocatedA (FunArg (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAppPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LocatedA (FunArg (HsExpr GhcPs))
e2 = do
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
LocatedA (FunArg (HsExpr GhcPs))
e2
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
NoExtField
noExtField LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LHsExpr GhcPs
LocatedA (FunArg (HsExpr GhcPs))
e2)
mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e EpToken "@"
at LHsType GhcPs
t = do
LHsExpr GhcPs -> PV ()
checkExpBlockArguments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XAppTypeE GhcPs
-> LHsExpr GhcPs -> LHsWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcPs
EpToken "@"
at LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> AnnsIf
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsIfPV SrcSpan
l LHsExpr GhcPs
c Bool
semi1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
b AnnsIf
anns = do
(HsExpr GhcPs
-> Bool -> HsExpr GhcPs -> Bool -> HsExpr GhcPs -> PsMessage)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV ()
forall a b c.
(Outputable a, Outputable b, Outputable c) =>
(a -> Bool -> b -> Bool -> c -> PsMessage)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse HsExpr GhcPs
-> Bool -> HsExpr GhcPs -> Bool -> HsExpr GhcPs -> PsMessage
PsErrSemiColonsInCondExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
c Bool
semi1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
b
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns)
mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
mod LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts AnnList
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo anns (DoExpr mod) stmts)
mkHsParPV :: SrcSpan
-> EpToken "("
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EpToken ")"
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsParPV SrcSpan
l EpToken "("
lpar GenLocated SrcSpanAnnA (HsExpr GhcPs)
e EpToken ")"
rpar = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e)
mkHsVarPV :: GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsVarPV v :: GenLocated SrcSpanAnnN RdrName
v@(L l :: SrcSpanAnnN
l@(EpAnn EpaLocation
anc NameAnn
_ EpAnnComments
_) RdrName
_) = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc SrcSpanAnnN
l)
return $ L (EpAnn anc noAnn cs) (HsVar noExtField v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLitPV (L SrcSpan
l HsLit GhcPs
a) = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsLit noExtField a)
mkHsOverLitPV :: forall a.
LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
mkHsOverLitPV (L (EpAnn EpaLocation
l a
an EpAnnComments
csIn) HsOverLit GhcPs
a) = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (EpaLocation -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpaLocation
l)
return $ L (EpAnn l an (cs Semi.<> csIn)) (HsOverLit NoExtField a)
mkHsWildCardPV :: forall a. NoAnn a => SrcSpan -> PV (LocatedAn a (HsExpr GhcPs))
mkHsWildCardPV SrcSpan
l = LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs)))
-> LocatedAn a (HsExpr GhcPs) -> PV (LocatedAn a (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn a -> HsExpr GhcPs -> LocatedAn a (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnn a
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn)
mkHsTySigPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsTySigPV l :: SrcSpanAnnA
l@(EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
csIn) GenLocated SrcSpanAnnA (HsExpr GhcPs)
a LHsType GhcPs
sig [AddEpAnn]
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
return $ L (EpAnn anc an (csIn Semi.<> cs)) (ExprWithTySig anns a (hsTypeToHsSigWcType sig))
mkHsExplicitListPV :: SrcSpan
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsExplicitListPV SrcSpan
l [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs AnnList
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (ExplicitList anns xs)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
a) = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ fmap (HsUntypedSplice NoExtField) (L (EpAnn (spanAsAnchor l) noAnn cs) a)
mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsRecordPV Bool
opts SrcSpan
l SrcSpan
lrec GenLocated SrcSpanAnnA (HsExpr GhcPs)
a ([Fbind (HsExpr GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
r <- mkRecConstrOrUpdate opts a lrec (fbinds, ddLoc) anns
checkRecordSyntax (L (EpAnn (spanAsAnchor l) noAnn cs) r)
mkHsNegAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsNegAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
a [AddEpAnn]
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (NegApp anns a noSyntaxExpr)
mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (HsExpr GhcPs))
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
e = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (SectionR noExtField op e)
mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a GenLocated SrcSpanAnnA (HsExpr GhcPs)
b [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> PsMessage
PsErrViewPatInExpr LHsExpr GhcPs
a LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b)
PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> EpToken "@"
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v EpToken "@"
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ RdrName -> LHsExpr GhcPs -> PsMessage
PsErrTypeAppWithoutSpace (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 e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkHsLazyPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLazyPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> PsMessage
PsErrLazyPatWithoutSpace LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkHsBangPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsBangPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> PsMessage
PsErrBangPatWithoutSpace LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
forall a. NoAnn a => a
noAnn))
mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkSumOrTuplePV = SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkSumOrTupleExpr
mkHsEmbTyPV :: SrcSpan
-> EpToken "type"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsEmbTyPV SrcSpan
l EpToken "type"
toktype LHsType GhcPs
ty =
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
XEmbTy GhcPs -> LHsWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p. XEmbTy p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsEmbTy XEmbTy GhcPs
EpToken "type"
toktype (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
rejectPragmaPV :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
rejectPragmaPV (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
e)) =
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall b. DisambECP b => LocatedA b -> PV ()
rejectPragmaPV LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
rejectPragmaPV (L SrcSpanAnnA
l (HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag LHsExpr GhcPs
_)) = MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsPragE GhcPs -> PsMessage
PsErrUnallowedPragma HsPragE GhcPs
prag)
rejectPragmaPV GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hsHoleExpr :: Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr :: Maybe EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr Maybe EpAnnUnboundVar
anns = XUnboundVar GhcPs -> RdrName -> HsExpr GhcPs
forall p. XUnboundVar p -> RdrName -> HsExpr p
HsUnboundVar Maybe EpAnnUnboundVar
XUnboundVar GhcPs
anns (OccName -> RdrName
mkRdrUnqual (FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"_")))
instance DisambECP (PatBuilder GhcPs) where
type Body (PatBuilder GhcPs) = PatBuilder
ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA (PatBuilder GhcPs))
ecpFromCmd' (L SrcSpanAnnA
l HsCmd GhcPs
c) = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ HsCmd GhcPs -> PsMessage
PsErrArrowCmdInPat HsCmd GhcPs
c
ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA (PatBuilder GhcPs))
ecpFromExp' (L SrcSpanAnnA
l HsExpr GhcPs
e) = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> PsMessage
PsErrArrowExprInPat HsExpr GhcPs
e
mkHsLetPV :: SrcSpan
-> EpToken "let"
-> HsLocalBinds GhcPs
-> EpToken "in"
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLetPV SrcSpan
l EpToken "let"
_ HsLocalBinds GhcPs
_ EpToken "in"
_ LocatedA (PatBuilder GhcPs)
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrLetInPat
mkHsProjUpdatePV :: SrcSpan
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LocatedA (PatBuilder GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
_ LocatedA (PatBuilder GhcPs)
_ Bool
_ [AddEpAnn]
_ = MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs))))
-> MsgEnvelope PsMessage
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrOverloadedRecordDotInvalid
type InfixOp (PatBuilder GhcPs) = RdrName
superInfixOp :: (DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs)))
-> PV (LocatedA (PatBuilder GhcPs))
superInfixOp DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m = PV (LocatedA (PatBuilder GhcPs))
DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m
mkHsOpAppPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> LocatedN (InfixOp (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsOpAppPV SrcSpan
l LocatedA (PatBuilder GhcPs)
p1 LocatedN (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p2 = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ PatBuilderOpApp p1 op p2 []
mkHsLamPV :: SrcSpan
-> HsLamVariant
-> LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLamPV SrcSpan
l HsLamVariant
lam_variant LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
_ [AddEpAnn]
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (HsLamVariant -> PsMessage
PsErrLambdaInPat HsLamVariant
lam_variant)
mkHsCasePV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
-> EpAnnHsCase
-> PV (LocatedA (PatBuilder GhcPs))
mkHsCasePV SrcSpan
l LHsExpr GhcPs
_ LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
_ EpAnnHsCase
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrCaseInPat
type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
superFunArg :: (DisambECP (FunArg (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs)))
-> PV (LocatedA (PatBuilder GhcPs))
superFunArg DisambECP (FunArg (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m = PV (LocatedA (PatBuilder GhcPs))
DisambECP (FunArg (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m
mkHsAppPV :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LocatedA (FunArg (PatBuilder GhcPs))
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAppPV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
p1 LocatedA (FunArg (PatBuilder GhcPs))
p2 = LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (LocatedA (PatBuilder GhcPs)
-> LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p) -> LocatedA (PatBuilder p) -> PatBuilder p
PatBuilderApp LocatedA (PatBuilder GhcPs)
p1 LocatedA (PatBuilder GhcPs)
LocatedA (FunArg (PatBuilder GhcPs))
p2)
mkHsAppTypePV :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAppTypePV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
p EpToken "@"
at LHsType GhcPs
t = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t))
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> LocatedA (PatBuilder GhcPs)
-> Bool
-> LocatedA (PatBuilder GhcPs)
-> AnnsIf
-> PV (LocatedA (PatBuilder GhcPs))
mkHsIfPV SrcSpan
l LHsExpr GhcPs
_ Bool
_ LocatedA (PatBuilder GhcPs)
_ Bool
_ LocatedA (PatBuilder GhcPs)
_ AnnsIf
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrIfThenElseInPat
mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (LocatedA (PatBuilder GhcPs))]
-> AnnList
-> PV (LocatedA (PatBuilder GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
_ LocatedL [LStmt GhcPs (LocatedA (PatBuilder GhcPs))]
_ AnnList
_ = MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrDoNotationInPat
mkHsParPV :: SrcSpan
-> EpToken "("
-> LocatedA (PatBuilder GhcPs)
-> EpToken ")"
-> PV (LocatedA (PatBuilder GhcPs))
mkHsParPV SrcSpan
l EpToken "("
lpar LocatedA (PatBuilder GhcPs)
p EpToken ")"
rpar = LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (EpToken "("
-> LocatedA (PatBuilder GhcPs) -> EpToken ")" -> PatBuilder GhcPs
forall p.
EpToken "("
-> LocatedA (PatBuilder p) -> EpToken ")" -> PatBuilder p
PatBuilderPar EpToken "("
lpar LocatedA (PatBuilder GhcPs)
p EpToken ")"
rpar)
mkHsVarPV :: 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 b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
l) (GenLocated SrcSpanAnnN RdrName -> PatBuilder GhcPs
forall p. GenLocated SrcSpanAnnN RdrName -> PatBuilder p
PatBuilderVar GenLocated SrcSpanAnnN RdrName
v)
mkHsLitPV :: Located (HsLit GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
mkHsLitPV lit :: Located (HsLit GhcPs)
lit@(L SrcSpan
l HsLit GhcPs
a) = do
Located (HsLit GhcPs) -> PV ()
checkUnboxedLitPat Located (HsLit GhcPs)
lit
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (LitPat noExtField a))
mkHsOverLitPV :: forall a.
LocatedAn a (HsOverLit GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
mkHsOverLitPV (L EpAnn a
l HsOverLit GhcPs
a) = LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs)))
-> LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn a -> PatBuilder GhcPs -> LocatedAn a (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L EpAnn a
l (HsOverLit GhcPs -> PatBuilder GhcPs
forall p. HsOverLit GhcPs -> PatBuilder p
PatBuilderOverLit HsOverLit GhcPs
a)
mkHsWildCardPV :: forall a. NoAnn a => SrcSpan -> PV (LocatedAn a (PatBuilder GhcPs))
mkHsWildCardPV SrcSpan
l = LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs)))
-> LocatedAn a (PatBuilder GhcPs)
-> PV (LocatedAn a (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn a -> PatBuilder GhcPs -> LocatedAn a (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnn a
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcPs
NoExtField
noExtField))
mkHsTySigPV :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsTySigPV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
b LHsType GhcPs
sig [AddEpAnn]
anns = do
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
b
return $ L l (PatBuilderPat (SigPat anns p (mkHsPatSigType noAnn sig)))
mkHsExplicitListPV :: SrcSpan
-> [LocatedA (PatBuilder GhcPs)]
-> AnnList
-> PV (LocatedA (PatBuilder GhcPs))
mkHsExplicitListPV SrcSpan
l [LocatedA (PatBuilder GhcPs)]
xs AnnList
anns = do
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
!cs <- getCommentsFor l
return (L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (ListPat anns ps)))
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
mkHsSplicePV (L SrcSpan
l HsUntypedSplice GhcPs
sp) = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (SplicePat noExtField sp))
mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> ([Fbind (PatBuilder GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsRecordPV Bool
_ SrcSpan
l SrcSpan
_ LocatedA (PatBuilder GhcPs)
a ([Fbind (PatBuilder GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
anns = do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (PatBuilder GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs))))]
fbinds
if Bool -> Bool
not ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(LocatedA (PatBuilder GhcPs)))]
ps)
then MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrOverloadedRecordDotInvalid
else do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
r <- mkPatRec a (mk_rec_fields fs ddLoc) anns
checkRecordSyntax (L (EpAnn (spanAsAnchor l) noAnn cs) r)
mkHsNegAppPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsNegAppPV SrcSpan
l (L SrcSpanAnnA
lp PatBuilder GhcPs
p) [AddEpAnn]
anns = do
lit <- case PatBuilder GhcPs
p of
PatBuilderOverLit HsOverLit GhcPs
pos_lit -> LocatedAn NoEpAnns (HsOverLit GhcPs)
-> PV (LocatedAn NoEpAnns (HsOverLit GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnnCO -> HsOverLit GhcPs -> LocatedAn NoEpAnns (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
lp) HsOverLit GhcPs
pos_lit)
PatBuilder GhcPs
_ -> SrcSpan -> PsMessage -> PV (LocatedAn NoEpAnns (HsOverLit GhcPs))
forall a. SrcSpan -> PsMessage -> PV a
patFail SrcSpan
l (PsMessage -> PV (LocatedAn NoEpAnns (HsOverLit GhcPs)))
-> PsMessage -> PV (LocatedAn NoEpAnns (HsOverLit GhcPs))
forall a b. (a -> b) -> a -> b
$ PatBuilder GhcPs -> PsErrInPatDetails -> PsMessage
PsErrInPat PatBuilder GhcPs
p PsErrInPatDetails
PEIP_NegApp
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (mkNPat lit (Just noSyntaxExpr) anns))
mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p = SrcSpan -> PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. SrcSpan -> PsMessage -> PV a
patFail SrcSpan
l (RdrName -> PatBuilder GhcPs -> PsMessage
PsErrParseRightOpSectionInPat (GenLocated SrcSpanAnnA RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA RdrName
LocatedA (InfixOp (PatBuilder GhcPs))
op) (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (PatBuilder GhcPs)
p))
mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a LocatedA (PatBuilder GhcPs)
b [AddEpAnn]
anns = do
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
b
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (ViewPat anns a p))
mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> EpToken "@"
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v EpToken "@"
at LocatedA (PatBuilder GhcPs)
e = do
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (AsPat at v p))
mkHsLazyPatPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLazyPatPV SrcSpan
l LocatedA (PatBuilder GhcPs)
e [AddEpAnn]
a = do
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (LazyPat a p))
mkHsBangPatPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsBangPatPV SrcSpan
l LocatedA (PatBuilder GhcPs)
e [AddEpAnn]
an = do
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
!cs <- getCommentsFor l
let pb = XBangPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XBangPat p -> LPat p -> Pat p
BangPat [AddEpAnn]
XBangPat GhcPs
an LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p
hintBangPat l pb
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat pb)
mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePV = SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat
mkHsEmbTyPV :: SrcSpan
-> EpToken "type"
-> LHsType GhcPs
-> PV (LocatedA (PatBuilder GhcPs))
mkHsEmbTyPV SrcSpan
l EpToken "type"
toktype LHsType GhcPs
ty =
LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) (PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs))
-> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$
Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XEmbTyPat GhcPs -> HsTyPat (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XEmbTyPat p -> HsTyPat (NoGhcTc p) -> Pat p
EmbTyPat XEmbTyPat GhcPs
EpToken "type"
toktype (LHsType GhcPs -> HsTyPat GhcPs
mkHsTyPat LHsType GhcPs
ty))
rejectPragmaPV :: LocatedA (PatBuilder GhcPs) -> PV ()
rejectPragmaPV LocatedA (PatBuilder GhcPs)
_ = () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkUnboxedLitPat :: Located (HsLit GhcPs) -> PV ()
checkUnboxedLitPat :: Located (HsLit GhcPs) -> PV ()
checkUnboxedLitPat (L SrcSpan
loc HsLit GhcPs
lit) =
case HsLit GhcPs
lit of
HsStringPrim {}
-> MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsLit GhcPs -> PsMessage
PsErrIllegalUnboxedStringInPat HsLit GhcPs
lit)
HsLit GhcPs
_ | HsLit GhcPs -> Bool
is_floating_lit HsLit GhcPs
lit
-> MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsLit GhcPs -> PsMessage
PsErrIllegalUnboxedFloatingLitInPat HsLit GhcPs
lit)
| Bool
otherwise
-> () -> PV ()
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
is_floating_lit :: HsLit GhcPs -> Bool
is_floating_lit :: HsLit GhcPs -> Bool
is_floating_lit (HsFloatPrim {}) = Bool
True
is_floating_lit (HsDoublePrim {}) = Bool
True
is_floating_lit HsLit GhcPs
_ = Bool
False
mkPatRec ::
LocatedA (PatBuilder GhcPs) ->
HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) ->
[AddEpAnn] ->
PV (PatBuilder GhcPs)
mkPatRec :: LocatedA (PatBuilder GhcPs)
-> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
-> [AddEpAnn]
-> PV (PatBuilder GhcPs)
mkPatRec (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc -> PatBuilderVar GenLocated SrcSpanAnnN RdrName
c) (HsRecFields [LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
fs Maybe (XRec GhcPs RecFieldsDotDot)
dd) [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
c)
= do fs <- (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
-> PV
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))
-> PV
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
checkPatField [LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(LocatedA (PatBuilder GhcPs)))]
fs
return $ PatBuilderPat $ ConPat
{ pat_con_ext = anns
, pat_con = c
, pat_args = RecCon (HsRecFields fs dd)
}
mkPatRec LocatedA (PatBuilder GhcPs)
p HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
_ [AddEpAnn]
_ =
MsgEnvelope PsMessage -> PV (PatBuilder GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (PatBuilder GhcPs))
-> MsgEnvelope PsMessage -> PV (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (LocatedA (PatBuilder GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedA (PatBuilder GhcPs)
p) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(PatBuilder GhcPs -> PsMessage
PsErrInvalidRecordCon (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (PatBuilder GhcPs)
p))
class DisambTD b where
mkHsAppTyHeadPV :: LHsType GhcPs -> PV (LocatedA b)
mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b)
mkHsAppKindTyPV :: LocatedA b -> EpToken "@" -> LHsType GhcPs -> PV (LocatedA b)
mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
mkUnpackednessPV :: Located UnpackednessPragma -> LocatedA b -> PV (LocatedA b)
instance DisambTD (HsType GhcPs) where
mkHsAppTyHeadPV :: LHsType GhcPs -> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppTyHeadPV = LHsType GhcPs -> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return
mkHsAppTyPV :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> LHsType GhcPs -> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppTyPV GenLocated SrcSpanAnnA (HsType GhcPs)
t1 LHsType GhcPs
t2 = GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1 LHsType GhcPs
t2)
mkHsAppKindTyPV :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> EpToken "@"
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppKindTyPV GenLocated SrcSpanAnnA (HsType GhcPs)
t EpToken "@"
at LHsType GhcPs
ki = GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppKindTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
XAppKindTy (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
mkHsAppKindTy XAppKindTy GhcPs
EpToken "@"
at LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t LHsType GhcPs
ki)
mkHsOpTyPV :: PromotionFlag
-> LHsType GhcPs
-> 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 (EpAnn EpaLocation
anc AnnListItem
_ EpAnnComments
cs) (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
fields)] <- OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. OrdList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrdList (LHsType GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
flds
= GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon (SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc XRecTy GhcPs
AnnList
an EpAnnComments
cs) [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields)
dataConBuilderDetails (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 (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear (OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. OrdList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrdList (LHsType GhcPs)
OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
flds))
dataConBuilderDetails (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 (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs) (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs)
instance DisambTD DataConBuilder where
mkHsAppTyHeadPV :: LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppTyHeadPV = LHsType GhcPs -> PV (LocatedA DataConBuilder)
tyToDataConBuilder
mkHsAppTyPV :: LocatedA DataConBuilder
-> LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppTyPV (L SrcSpanAnnA
l (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds 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 e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
(OrdList (LHsType GhcPs)
-> 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
-> EpToken "@" -> LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppKindTyPV LocatedA DataConBuilder
lhs EpToken "@"
at LHsType GhcPs
ki =
MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder))
-> MsgEnvelope PsMessage -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (EpToken "@" -> SrcSpan
forall (tok :: Symbol). EpToken tok -> SrcSpan
getEpTokenSrcSpan EpToken "@"
at) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(DataConBuilder -> HsType GhcPs -> PsMessage
PsErrUnexpectedKindAppInDataCon (LocatedA DataConBuilder -> DataConBuilder
forall l e. GenLocated l e -> e
unLoc LocatedA DataConBuilder
lhs) (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki))
mkHsOpTyPV :: PromotionFlag
-> LHsType GhcPs
-> 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)
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
checkNotPromotedDataCon prom data_con
return $ L l (InfixDataConBuilder lhs data_con rhs)
where
l :: SrcSpanAnnA
l = GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs
check_no_ops :: HsType GhcPs -> PV ()
check_no_ops (HsBangTy XBangTy GhcPs
_ HsSrcBang
_ LHsType GhcPs
t) = HsType GhcPs -> PV ()
check_no_ops (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t)
check_no_ops (HsOpTy{}) =
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> PV ()) -> MsgEnvelope PsMessage -> PV ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsType GhcPs -> RdrName -> HsType GhcPs -> PsMessage
PsErrInvalidInfixDataCon (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs) (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 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 = GenLocated SrcSpanAnnA UnpackednessPragma
-> LocatedA DataConBuilder -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA (Located UnpackednessPragma
-> GenLocated SrcSpanAnnA UnpackednessPragma
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc Located UnpackednessPragma
unpk) LocatedA DataConBuilder
constr_stuff
return $ L l (InfixDataConBuilder lhs' data_con 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
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
checkNotPromotedDataCon prom data_con
return $ L l (PrefixDataConBuilder nilOL 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 b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> DataCon
tupleDataCon Boxity
Boxed ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts)))
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (OrdList (LHsType GhcPs)
-> 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 (L SrcSpanAnnA
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsUnboxedTuple [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 b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> DataCon
tupleDataCon Boxity
Unboxed ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ts)))
LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (OrdList (LHsType GhcPs)
-> 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. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(HsType GhcPs -> PsMessage
PsErrInvalidDataCon (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
checkNotPromotedDataCon :: PromotionFlag -> LocatedN RdrName -> PV ()
checkNotPromotedDataCon :: PromotionFlag -> 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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
RdrName -> PsMessage
PsErrIllegalPromotionQuoteDataCon RdrName
name
mkUnboxedSumCon :: LHsType GhcPs -> ConTag -> Arity -> (LocatedN RdrName, HsConDeclH98Details GhcPs)
mkUnboxedSumCon :: LHsType GhcPs
-> Int
-> Int
-> (GenLocated SrcSpanAnnN RdrName, HsConDeclH98Details GhcPs)
mkUnboxedSumCon LHsType GhcPs
t Int
tag Int
arity =
(RdrName -> GenLocated SrcSpanAnnN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Int -> Int -> DataCon
sumDataCon Int
tag Int
arity)), [Void]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs [GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t])
checkPrecP
:: Located (SourceText,Int)
-> Located (OrdList (LocatedN RdrName))
-> P ()
checkPrecP :: Located (SourceText, Int)
-> Located (OrdList (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)
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate :: Bool
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate Bool
_ (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
l RdrName
c))) SrcSpan
_lrec ([Fbind (HsExpr GhcPs)]
fbinds,Maybe SrcSpan
dd) [AddEpAnn]
anns
| RdrName -> Bool
isRdrDataCon RdrName
c
= do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsExpr GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
fbinds
case [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps of
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p:[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrOverloadedRecordDotInvalid
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> HsRecordBinds GhcPs -> [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 SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs Maybe SrcSpan
dd) [AddEpAnn]
anns)
mkRecConstrOrUpdate Bool
overloaded_update LHsExpr GhcPs
exp SrcSpan
_ ([Fbind (HsExpr GhcPs)]
fs,Maybe SrcSpan
dd) [AddEpAnn]
anns
| Just SrcSpan
dd_loc <- Maybe SrcSpan
dd = MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
dd_loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrDotsInRecordUpdate
| Bool
otherwise = Bool
-> LHsExpr GhcPs
-> [Fbind (HsExpr GhcPs)]
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_update LHsExpr GhcPs
exp [Fbind (HsExpr GhcPs)]
fs [AddEpAnn]
anns
mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> [AddEpAnn] -> PV (HsExpr GhcPs)
mkRdrRecordUpd :: Bool
-> LHsExpr GhcPs
-> [Fbind (HsExpr GhcPs)]
-> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_on exp :: LHsExpr GhcPs
exp@(L SrcSpanAnnA
loc HsExpr GhcPs
_) [Fbind (HsExpr GhcPs)]
fbinds [AddEpAnn]
anns = do
let ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Fbind (HsExpr GhcPs)]
[Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
fbinds
fs' :: [LHsRecUpdField GhcPs GhcPs]
fs' :: [LHsRecUpdField GhcPs GhcPs]
fs' = (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map ((HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
mk_rec_upd_field) [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs
case Bool
overloaded_on of
Bool
False | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps ->
MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) PsMessage
PsErrOverloadedRecordUpdateNotEnabled
Bool
False ->
HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return RecordUpd {
rupd_ext :: XRecordUpd GhcPs
rupd_ext = [AddEpAnn]
XRecordUpd GhcPs
anns
, rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
, rupd_flds :: LHsRecUpdFields GhcPs
rupd_flds =
RegularRecUpdFields
{ xRecUpdFields :: XLHsRecUpdLabels GhcPs
xRecUpdFields = XLHsRecUpdLabels GhcPs
NoExtField
noExtField
, recUpdFields :: [LHsRecUpdField GhcPs GhcPs]
recUpdFields = [LHsRecUpdField GhcPs GhcPs]
fs' } }
Bool
True -> do
let qualifiedFields :: [GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
qualifiedFields =
[ SrcSpanAnnA
-> AmbiguousFieldOcc GhcPs
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l AmbiguousFieldOcc GhcPs
lbl | L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
_ (L SrcSpanAnnA
l AmbiguousFieldOcc GhcPs
lbl) GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ Bool
_) <- [LHsRecUpdField GhcPs GhcPs]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs'
, RdrName -> Bool
isQual (RdrName -> Bool)
-> (AmbiguousFieldOcc GhcPs -> RdrName)
-> AmbiguousFieldOcc GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousFieldOcc GhcPs -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName (AmbiguousFieldOcc GhcPs -> Bool)
-> AmbiguousFieldOcc GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc GhcPs
lbl
]
case [GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
qualifiedFields of
GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
qf:[GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
_ -> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (HsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
qf) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields
[GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)]
_ -> HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a. a -> PV a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> PV (HsExpr GhcPs))
-> HsExpr GhcPs -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
RecordUpd
{ rupd_ext :: XRecordUpd GhcPs
rupd_ext = [AddEpAnn]
XRecordUpd GhcPs
anns
, rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
, rupd_flds :: LHsRecUpdFields GhcPs
rupd_flds =
OverloadedRecUpdFields
{ xOLRecUpdFields :: XLHsOLRecUpdLabels GhcPs
xOLRecUpdFields = XLHsOLRecUpdLabels GhcPs
NoExtField
noExtField
, olRecUpdFields :: [LHsRecProj GhcPs (LHsExpr GhcPs)]
olRecUpdFields = [Fbind (HsExpr GhcPs)] -> [LHsRecProj GhcPs (LHsExpr GhcPs)]
toProjUpdates [Fbind (HsExpr GhcPs)]
fbinds } }
where
toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdProj GhcPs]
toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecProj GhcPs (LHsExpr GhcPs)]
toProjUpdates = (Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [Either
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (\case { Right GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p -> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p; Left GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
f -> LHsRecField GhcPs (LHsExpr GhcPs)
-> LHsRecProj GhcPs (LHsExpr GhcPs)
recFieldToProjUpdate LHsRecField GhcPs (LHsExpr GhcPs)
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
f })
recFieldToProjUpdate :: LHsRecField GhcPs (LHsExpr GhcPs) -> LHsRecUpdProj GhcPs
recFieldToProjUpdate :: LHsRecField GhcPs (LHsExpr GhcPs)
-> LHsRecProj GhcPs (LHsExpr GhcPs)
recFieldToProjUpdate (L SrcSpanAnnA
l (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
anns (L SrcSpanAnnA
_ (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpanAnnN
loc RdrName
rdr))) GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
pun)) =
let f :: FastString
f = OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> FastString) -> RdrName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName
rdr
fl :: DotFieldOcc GhcPs
fl = XCDotFieldOcc GhcPs
-> XRec GhcPs FieldLabelString -> DotFieldOcc GhcPs
forall p.
XCDotFieldOcc p -> XRec p FieldLabelString -> DotFieldOcc p
DotFieldOcc XCDotFieldOcc GhcPs
AnnFieldLabel
forall a. NoAnn a => a
noAnn (SrcSpanAnnN
-> FieldLabelString -> GenLocated SrcSpanAnnN FieldLabelString
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc (FastString -> FieldLabelString
FieldLabelString FastString
f))
lf :: SrcSpan
lf = SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc
in SrcSpanAnnA
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate SrcSpanAnnA
l (SrcSpan
-> [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
lf [EpAnnCO
-> DotFieldOcc GhcPs -> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> EpAnnCO
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
loc) DotFieldOcc GhcPs
fl]) (FastString -> LHsExpr GhcPs
punnedVar FastString
f) Bool
pun [AddEpAnn]
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
anns
where
punnedVar :: FastString -> LHsExpr GhcPs
punnedVar :: FastString -> LHsExpr GhcPs
punnedVar FastString
f = if Bool -> Bool
not Bool
pun then LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg else HsExpr GhcPs -> LHsExpr GhcPs
HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (HsExpr GhcPs -> LHsExpr GhcPs)
-> (FastString -> HsExpr GhcPs) -> FastString -> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField (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 e a. HasAnnotation e => a -> GenLocated e 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 -> [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon :: GenLocated SrcSpanAnnN RdrName
-> HsRecordBinds GhcPs -> [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon GenLocated SrcSpanAnnN RdrName
con HsRecordBinds GhcPs
flds [AddEpAnn]
anns
= RecordCon { rcon_ext :: XRecordCon GhcPs
rcon_ext = [AddEpAnn]
XRecordCon GhcPs
anns, rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_con = XRec GhcPs (ConLikeP GhcPs)
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 (LocatedE RecFieldsDotDot)
forall a. Maybe a
Nothing }
mk_rec_fields [LocatedA (HsRecField (GhcPass p) arg)]
fs (Just SrcSpan
s) = HsRecFields { rec_flds :: [LHsRecField (GhcPass p) arg]
rec_flds = [LHsRecField (GhcPass p) arg]
[LocatedA (HsRecField (GhcPass p) arg)]
fs
, rec_dotdot :: Maybe (XRec (GhcPass p) RecFieldsDotDot)
rec_dotdot = LocatedE RecFieldsDotDot -> Maybe (LocatedE RecFieldsDotDot)
forall a. a -> Maybe a
Just (EpaLocation -> RecFieldsDotDot -> LocatedE RecFieldsDotDot
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
s) (Int -> RecFieldsDotDot
RecFieldsDotDot (Int -> RecFieldsDotDot) -> Int -> RecFieldsDotDot
forall a b. (a -> b) -> a -> b
$ [LocatedA
(HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) arg)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocatedA (HsRecField (GhcPass p) arg)]
[LocatedA
(HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) arg)]
fs)) }
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
mk_rec_upd_field (HsFieldBind XHsFieldBind (LFieldOcc GhcPs)
noAnn (L SrcSpanAnnA
loc (FieldOcc XCFieldOcc GhcPs
_ XRec GhcPs RdrName
rdr)) LHsExpr GhcPs
arg Bool
pun)
= XHsFieldBind (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> HsFieldBind
(GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall lhs rhs.
XHsFieldBind lhs -> lhs -> rhs -> Bool -> HsFieldBind lhs rhs
HsFieldBind XHsFieldBind (LFieldOcc GhcPs)
XHsFieldBind (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
noAnn (SrcSpanAnnA
-> AmbiguousFieldOcc GhcPs
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XUnambiguous GhcPs -> XRec GhcPs RdrName -> AmbiguousFieldOcc GhcPs
forall pass.
XUnambiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
Unambiguous XUnambiguous GhcPs
NoExtField
noExtField XRec GhcPs RdrName
rdr)) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
pun
mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
-> InlinePragma
mkInlinePragma :: SourceText
-> (InlineSpec, RuleMatchInfo) -> Maybe Activation -> InlinePragma
mkInlinePragma SourceText
src (InlineSpec
inl, RuleMatchInfo
match_info) Maybe Activation
mb_act
= InlinePragma { inl_src :: SourceText
inl_src = SourceText
src
, inl_inline :: InlineSpec
inl_inline = InlineSpec
inl
, inl_sat :: Maybe Int
inl_sat = Maybe Int
forall a. Maybe a
Nothing
, inl_act :: Activation
inl_act = Activation
act
, inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
match_info }
where
act :: Activation
act = case Maybe Activation
mb_act of
Just Activation
act -> Activation
act
Maybe Activation
Nothing ->
case InlineSpec
inl of
NoInline SourceText
_ -> Activation
NeverActive
Opaque SourceText
_ -> Activation
NeverActive
InlineSpec
_other -> Activation
AlwaysActive
mkOpaquePragma :: SourceText -> InlinePragma
mkOpaquePragma :: SourceText -> InlinePragma
mkOpaquePragma SourceText
src
= InlinePragma { inl_src :: SourceText
inl_src = SourceText
src
, inl_inline :: InlineSpec
inl_inline = SourceText -> InlineSpec
Opaque SourceText
src
, inl_sat :: Maybe Int
inl_sat = Maybe Int
forall a. Maybe a
Nothing
, inl_act :: Activation
inl_act = Activation
NeverActive
, inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
FunLike
}
checkNewOrData :: SrcSpan -> RdrName -> Bool -> NewOrData -> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData :: SrcSpan
-> RdrName
-> Bool
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
checkNewOrData SrcSpan
span RdrName
name Bool
is_type_data = ((NewOrData, [LConDecl GhcPs])
-> P (DataDefnCons (LConDecl GhcPs)))
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((NewOrData, [LConDecl GhcPs])
-> P (DataDefnCons (LConDecl GhcPs)))
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs)))
-> ((NewOrData, [LConDecl GhcPs])
-> P (DataDefnCons (LConDecl GhcPs)))
-> NewOrData
-> [LConDecl GhcPs]
-> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ \ case
(NewOrData
NewType, [LConDecl GhcPs
a]) -> DataDefnCons (LConDecl GhcPs) -> P (DataDefnCons (LConDecl GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. a -> DataDefnCons a
NewTypeCon LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
a
(NewOrData
DataType, [LConDecl GhcPs]
as) -> DataDefnCons (LConDecl GhcPs) -> P (DataDefnCons (LConDecl GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons (LConDecl GhcPs)
-> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Bool
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. Bool -> [a] -> DataDefnCons a
DataTypeCons Bool
is_type_data ([GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
handle_type_data [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
as)
(NewOrData
NewType, [LConDecl GhcPs]
as) -> MsgEnvelope PsMessage -> P (DataDefnCons (LConDecl GhcPs))
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (DataDefnCons (LConDecl GhcPs)))
-> MsgEnvelope PsMessage -> P (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
span (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ RdrName -> Int -> PsMessage
PsErrMultipleConForNewtype RdrName
name ([GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
as)
where
handle_type_data :: [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
handle_type_data
| Bool
is_type_data = (GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((ConDecl GhcPs -> ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConDecl GhcPs -> ConDecl GhcPs
forall {pass} {f :: * -> *}.
(XRec pass (IdP pass) ~ f RdrName, Functor f) =>
ConDecl pass -> ConDecl pass
promote_constructor)
| Bool
otherwise = [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall a. a -> a
id
promote_constructor :: ConDecl pass -> ConDecl pass
promote_constructor (dc :: ConDecl pass
dc@ConDeclGADT { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (XRec pass (IdP pass))
cons })
= ConDecl pass
dc { con_names = fmap (fmap promote_name) cons }
promote_constructor (dc :: ConDecl pass
dc@ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = XRec pass (IdP pass)
con })
= ConDecl pass
dc { con_name = fmap promote_name con }
promote_constructor ConDecl pass
dc = ConDecl pass
dc
promote_name :: RdrName -> RdrName
promote_name RdrName
name = RdrName -> Maybe RdrName -> RdrName
forall a. a -> Maybe a -> a
fromMaybe RdrName
name (RdrName -> Maybe RdrName
promoteRdrName RdrName
name)
mkImport :: Located CCallConv
-> Located Safety
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkImport :: GenLocated SrcSpan CCallConv
-> GenLocated SrcSpan Safety
-> (Located StringLiteral, GenLocated SrcSpanAnnN RdrName,
LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkImport GenLocated SrcSpan CCallConv
cconv GenLocated SrcSpan Safety
safety (L SrcSpan
loc (StringLiteral SourceText
esrc FastString
entity Maybe NoCommentsLocation
_), GenLocated SrcSpanAnnN RdrName
v, LHsSigType GhcPs
ty) =
case GenLocated SrcSpan CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan CCallConv
cconv of
CCallConv
CCallConv -> ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec (ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs))
-> P (ForeignImport GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< P (ForeignImport GhcPs)
mkCImport
CCallConv
CApiConv -> do
imp <- P (ForeignImport GhcPs)
mkCImport
if isCWrapperImport imp
then addFatalError $ mkPlainErrorMsgEnvelope loc PsErrInvalidCApiImport
else returnSpec imp
CCallConv
StdCallConv -> ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec (ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs))
-> P (ForeignImport GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< P (ForeignImport GhcPs)
mkCImport
CCallConv
PrimCallConv -> P ([AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
CCallConv
JavaScriptCallConv -> P ([AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
where
mkCImport :: P (ForeignImport GhcPs)
mkCImport = do
let e :: String
e = FastString -> String
unpackFS FastString
entity
case LocatedE CCallConv
-> LocatedE Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport GhcPs)
forall (p :: Pass).
LocatedE CCallConv
-> LocatedE Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport (GenLocated SrcSpan CCallConv -> LocatedE CCallConv
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan CCallConv
cconv) (GenLocated SrcSpan Safety -> LocatedE Safety
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan Safety
safety) (RdrName -> FastString
mkExtName (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 ([AddEpAnn] -> HsDecl GhcPs)
mkOtherImport = ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
importSpec
where
entity' :: FastString
entity' = if FastString -> Bool
nullFS FastString
entity
then RdrName -> FastString
mkExtName (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 (EpaLocation -> SourceText -> GenLocated EpaLocation SourceText
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
loc) SourceText
esrc) (GenLocated SrcSpan CCallConv -> LocatedE CCallConv
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan CCallConv
cconv) (GenLocated SrcSpan Safety -> LocatedE Safety
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc GenLocated SrcSpan Safety
safety) Maybe Header
forall a. Maybe a
Nothing CImportSpec
funcTarget
returnSpec :: ForeignImport GhcPs -> P ([AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport GhcPs
spec = ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs))
-> ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \[AddEpAnn]
ann -> XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD XForD GhcPs
NoExtField
noExtField (ForeignDecl GhcPs -> HsDecl GhcPs)
-> ForeignDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ForeignImport
{ fd_i_ext :: XForeignImport GhcPs
fd_i_ext = [AddEpAnn]
XForeignImport GhcPs
ann
, fd_name :: XRec GhcPs (IdP GhcPs)
fd_name = XRec GhcPs (IdP GhcPs)
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 :: LocatedE CCallConv -> LocatedE Safety -> FastString -> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport :: forall (p :: Pass).
LocatedE CCallConv
-> LocatedE Safety
-> FastString
-> String
-> Located SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport LocatedE CCallConv
cconv LocatedE Safety
safety FastString
nm String
str Located SourceText
sourceText =
[ForeignImport (GhcPass p)] -> Maybe (ForeignImport (GhcPass p))
forall a. [a] -> Maybe a
listToMaybe ([ForeignImport (GhcPass p)] -> Maybe (ForeignImport (GhcPass p)))
-> [ForeignImport (GhcPass p)] -> Maybe (ForeignImport (GhcPass p))
forall a b. (a -> b) -> a -> b
$ ((ForeignImport (GhcPass p), String) -> ForeignImport (GhcPass p))
-> [(ForeignImport (GhcPass p), String)]
-> [ForeignImport (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map (ForeignImport (GhcPass p), String) -> ForeignImport (GhcPass p)
forall a b. (a, b) -> a
fst ([(ForeignImport (GhcPass p), String)]
-> [ForeignImport (GhcPass p)])
-> [(ForeignImport (GhcPass p), String)]
-> [ForeignImport (GhcPass p)]
forall a b. (a -> b) -> a -> b
$ ((ForeignImport (GhcPass p), String) -> Bool)
-> [(ForeignImport (GhcPass p), String)]
-> [(ForeignImport (GhcPass p), String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null(String -> Bool)
-> ((ForeignImport (GhcPass p), String) -> String)
-> (ForeignImport (GhcPass p), String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ForeignImport (GhcPass p), String) -> String
forall a b. (a, b) -> b
snd) ([(ForeignImport (GhcPass p), String)]
-> [(ForeignImport (GhcPass p), String)])
-> [(ForeignImport (GhcPass p), String)]
-> [(ForeignImport (GhcPass p), String)]
forall a b. (a -> b) -> a -> b
$
ReadP (ForeignImport (GhcPass p))
-> ReadS (ForeignImport (GhcPass p))
forall a. ReadP a -> ReadS a
readP_to_S ReadP (ForeignImport (GhcPass p))
parse String
str
where
parse :: ReadP (ForeignImport (GhcPass p))
parse = do
ReadP ()
skipSpaces
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 h <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
hdr_char
skipSpaces
let src = String -> FastString
mkFastString String
h
mk (Just (Header (SourceText src) src))
<$> cimp nm))
]
skipSpaces
return r
token :: String -> ReadP ()
token String
str = do _ <- String -> ReadP String
string String
str
toks <- look
case toks of
Char
c : String
_
| Char -> Bool
id_char Char
c -> ReadP ()
forall a. ReadP a
pfail
String
_ -> () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mk :: Maybe Header -> CImportSpec -> ForeignImport (GhcPass p)
mk Maybe Header
h CImportSpec
n = XCImport (GhcPass p)
-> XRec (GhcPass p) CCallConv
-> XRec (GhcPass p) Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport (GhcPass p)
forall pass.
XCImport pass
-> XRec pass CCallConv
-> XRec pass Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport pass
CImport (Located SourceText -> GenLocated EpaLocation SourceText
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc Located SourceText
sourceText) (LocatedE CCallConv -> LocatedE CCallConv
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc LocatedE CCallConv
cconv) (LocatedE Safety -> LocatedE Safety
forall a e b.
(HasLoc (GenLocated a e), HasAnnotation b) =>
GenLocated a e -> GenLocated b e
reLoc LocatedE Safety
safety) Maybe Header
h CImportSpec
n
hdr_char :: Char -> Bool
hdr_char Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c)
id_first_char :: Char -> Bool
id_first_char Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
id_char :: Char -> Bool
id_char Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
cimp :: FastString -> ReadP CImportSpec
cimp FastString
nm = (Char -> ReadP Char
ReadP.char Char
'&' ReadP Char -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
skipSpaces ReadP () -> ReadP CImportSpec -> ReadP CImportSpec
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FastString -> CImportSpec
CLabel (FastString -> CImportSpec)
-> ReadP FastString -> ReadP CImportSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP FastString
cid)
ReadP CImportSpec -> ReadP CImportSpec -> ReadP CImportSpec
forall a. ReadP a -> ReadP a -> ReadP a
+++ (do isFun <- case LocatedE CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc LocatedE CCallConv
cconv of
CCallConv
CApiConv ->
Bool -> ReadP Bool -> ReadP Bool
forall a. a -> ReadP a -> ReadP a
option Bool
True
(do String -> ReadP ()
token String
"value"
ReadP ()
skipSpaces
Bool -> ReadP Bool
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
CCallConv
_ -> Bool -> ReadP Bool
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
cid' <- cid
return (CFunction (StaticTarget NoSourceText cid'
Nothing 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 c <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
id_first_char
cs <- many (satisfy id_char)
return (mkFastString (c:cs)))
mkExport :: Located CCallConv
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkExport :: GenLocated SrcSpan CCallConv
-> (Located StringLiteral, GenLocated SrcSpanAnnN RdrName,
LHsSigType GhcPs)
-> P ([AddEpAnn] -> HsDecl GhcPs)
mkExport (L SrcSpan
lc CCallConv
cconv) (L SrcSpan
le (StringLiteral SourceText
esrc FastString
entity Maybe NoCommentsLocation
_), GenLocated SrcSpanAnnN RdrName
v, LHsSigType GhcPs
ty)
= ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs))
-> ([AddEpAnn] -> HsDecl GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \[AddEpAnn]
ann -> XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD XForD GhcPs
NoExtField
noExtField (ForeignDecl GhcPs -> HsDecl GhcPs)
-> ForeignDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
ForeignExport { fd_e_ext :: XForeignExport GhcPs
fd_e_ext = [AddEpAnn]
XForeignExport GhcPs
ann, fd_name :: XRec GhcPs (IdP GhcPs)
fd_name = XRec GhcPs (IdP GhcPs)
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 (EpaLocation -> SourceText -> GenLocated EpaLocation SourceText
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
le) SourceText
esrc) (EpaLocation -> CExportSpec -> GenLocated EpaLocation CExportSpec
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpaLocation
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpan
lc) (SourceText -> FastString -> CCallConv -> CExportSpec
CExportStatic SourceText
esrc FastString
entity' CCallConv
cconv)) }
where
entity' :: FastString
entity' | FastString -> Bool
nullFS FastString
entity = RdrName -> FastString
mkExtName (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 :: Maybe (LWarningTxt GhcPs) -> [AddEpAnn] -> LocatedA ImpExpQcSpec
-> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp :: Maybe (LWarningTxt GhcPs)
-> [AddEpAnn]
-> LocatedA ImpExpQcSpec
-> ImpExpSubSpec
-> P (IE GhcPs)
mkModuleImpExp Maybe (LWarningTxt GhcPs)
warning [AddEpAnn]
anns (L SrcSpanAnnA
l ImpExpQcSpec
specname) ImpExpSubSpec
subs = do
case ImpExpSubSpec
subs of
ImpExpSubSpec
ImpExpAbs
| NameSpace -> Bool
isVarNameSpace (RdrName -> NameSpace
rdrNameSpace RdrName
name)
-> IE GhcPs -> P (IE GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (IE GhcPs -> P (IE GhcPs)) -> IE GhcPs -> P (IE GhcPs)
forall a b. (a -> b) -> a -> b
$ XIEVar GhcPs
-> LIEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs
forall pass.
XIEVar pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEVar Maybe (LWarningTxt GhcPs)
XIEVar GhcPs
warning
(SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec ImpExpQcSpec
specname)) Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing
| Bool
otherwise -> XIEThingAbs GhcPs
-> LIEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs
forall pass.
XIEThingAbs pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAbs (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> (IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> IEWrappedName GhcPs
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (Maybe (LHsDoc GhcPs)) -> P (IE GhcPs)
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LHsDoc GhcPs) -> P (Maybe (LHsDoc GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LHsDoc GhcPs)
noExportDoc
ImpExpSubSpec
ImpExpAll -> XIEThingAll GhcPs
-> LIEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs
forall pass.
XIEThingAll pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAll (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> (IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> IEWrappedName GhcPs
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (Maybe (LHsDoc GhcPs)) -> P (IE GhcPs)
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LHsDoc GhcPs) -> P (Maybe (LHsDoc GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LHsDoc GhcPs)
noExportDoc
ImpExpList [LocatedA ImpExpQcSpec]
xs ->
(\IEWrappedName GhcPs
newName -> XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName GhcPs
newName)
IEWildcard
NoIEWildcard ([LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
wrapped [LocatedA ImpExpQcSpec]
xs)) (IEWrappedName GhcPs -> Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (IEWrappedName GhcPs) -> P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName GhcPs)
nameT P (Maybe (LHsDoc GhcPs) -> IE GhcPs)
-> P (Maybe (LHsDoc GhcPs)) -> P (IE GhcPs)
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LHsDoc GhcPs) -> P (Maybe (LHsDoc GhcPs))
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LHsDoc GhcPs)
noExportDoc
ImpExpAllWith [LocatedA ImpExpQcSpec]
xs ->
do allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
PatternSynonymsBit
if allowed
then
let 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 -> (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 = [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
wrapped ([LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)])
-> [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall a b. (a -> b) -> a -> b
$ (LocatedA ImpExpQcSpec -> Bool)
-> [LocatedA ImpExpQcSpec] -> [LocatedA ImpExpQcSpec]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (LocatedA ImpExpQcSpec -> Bool) -> LocatedA ImpExpQcSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImpExpQcSpec -> Bool
isImpExpQcWildcard (ImpExpQcSpec -> Bool)
-> (LocatedA ImpExpQcSpec -> ImpExpQcSpec)
-> LocatedA ImpExpQcSpec
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA ImpExpQcSpec -> ImpExpQcSpec
forall l e. GenLocated l e -> e
unLoc) [LocatedA ImpExpQcSpec]
xs
in (\IEWrappedName GhcPs
newName
-> XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> Maybe (LHsDoc GhcPs)
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warning, [AddEpAnn]
anns) (SrcSpanAnnA
-> IEWrappedName GhcPs
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName GhcPs
newName) IEWildcard
pos [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ies)
<$> nameT <*> pure noExportDoc
else addFatalError $ mkPlainErrorMsgEnvelope (locA l) $
PsErrIllegalPatSynExport
where
noExportDoc :: Maybe (LHsDoc GhcPs)
noExportDoc :: Maybe (LHsDoc GhcPs)
noExportDoc = Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing
name :: RdrName
name = ImpExpQcSpec -> RdrName
ieNameVal ImpExpQcSpec
specname
nameT :: P (IEWrappedName GhcPs)
nameT =
if NameSpace -> Bool
isVarNameSpace (RdrName -> NameSpace
rdrNameSpace RdrName
name)
then MsgEnvelope PsMessage -> P (IEWrappedName GhcPs)
forall a. MsgEnvelope PsMessage -> P a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> P (IEWrappedName GhcPs))
-> MsgEnvelope PsMessage -> P (IEWrappedName GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$
(RdrName -> PsMessage
PsErrVarForTyCon RdrName
name)
else IEWrappedName GhcPs -> P (IEWrappedName GhcPs)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (IEWrappedName GhcPs -> P (IEWrappedName GhcPs))
-> IEWrappedName GhcPs -> P (IEWrappedName GhcPs)
forall a b. (a -> b) -> a -> b
$ ImpExpQcSpec -> IEWrappedName GhcPs
ieNameFromSpec ImpExpQcSpec
specname
ieNameVal :: ImpExpQcSpec -> RdrName
ieNameVal (ImpExpQcName 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 SrcSpan -> P ()
forall (m :: * -> *). MonadP m => SrcSpan -> m ()
requireExplicitNamespaces (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
name)
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]
_ Maybe (LHsDoc GhcPs)
_)) <- [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
specs] of
[] -> LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> P (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedL [LIE GhcPs]
LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
ie
(SrcSpanAnnA
l:[SrcSpanAnnA]
_) -> SrcSpan -> P (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall {m :: * -> *} {a}. MonadP m => SrcSpan -> m a
importSpecError (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
where
importSpecError :: SrcSpan -> m a
importSpecError SrcSpan
l =
MsgEnvelope PsMessage -> m a
forall a. MsgEnvelope PsMessage -> m a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> m a) -> MsgEnvelope PsMessage -> m a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l PsMessage
PsErrIllegalImportBundleForm
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec [] = ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [LocatedA ImpExpQcSpec] -> ImpExpSubSpec
ImpExpList [])
mkImpExpSubSpec [L SrcSpanAnnA
la ImpExpQcSpec
ImpExpQcWildcard] =
([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnDotdot (SrcSpanAnnA -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry SrcSpanAnnA
la)], ImpExpSubSpec
ImpExpAll)
mkImpExpSubSpec [LocatedA ImpExpQcSpec]
xs =
if ((LocatedA ImpExpQcSpec -> Bool) -> [LocatedA ImpExpQcSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ImpExpQcSpec -> Bool
isImpExpQcWildcard (ImpExpQcSpec -> Bool)
-> (LocatedA ImpExpQcSpec -> ImpExpQcSpec)
-> LocatedA ImpExpQcSpec
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA ImpExpQcSpec -> ImpExpQcSpec
forall l e. GenLocated l e -> e
unLoc) [LocatedA ImpExpQcSpec]
xs)
then ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec))
-> ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a b. (a -> b) -> a -> b
$ ([], [LocatedA ImpExpQcSpec] -> ImpExpSubSpec
ImpExpAllWith [LocatedA ImpExpQcSpec]
xs)
else ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a. a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec))
-> ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
forall a b. (a -> b) -> a -> b
$ ([], [LocatedA ImpExpQcSpec] -> ImpExpSubSpec
ImpExpList [LocatedA ImpExpQcSpec]
xs)
isImpExpQcWildcard :: ImpExpQcSpec -> Bool
isImpExpQcWildcard :: ImpExpQcSpec -> Bool
isImpExpQcWildcard ImpExpQcSpec
ImpExpQcWildcard = Bool
True
isImpExpQcWildcard ImpExpQcSpec
_ = Bool
False
warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule SrcSpan
span =
SrcSpan -> PsMessage -> P ()
addPsMessage SrcSpan
span PsMessage
PsWarnImportPreQualified
failNotEnabledImportQualifiedPost :: SrcSpan -> P ()
failNotEnabledImportQualifiedPost :: SrcSpan -> P ()
failNotEnabledImportQualifiedPost SrcSpan
loc =
MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrImportPostQualified
failImportQualifiedTwice :: SrcSpan -> P ()
failImportQualifiedTwice :: SrcSpan -> P ()
failImportQualifiedTwice SrcSpan
loc =
MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (MsgEnvelope PsMessage -> P ()) -> MsgEnvelope PsMessage -> P ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ PsMessage
PsErrImportQualifiedTwice
warnStarIsType :: SrcSpan -> P ()
warnStarIsType :: SrcSpan -> P ()
warnStarIsType SrcSpan
span = SrcSpan -> PsMessage -> P ()
addPsMessage SrcSpan
span PsMessage
PsWarnStarIsType
failOpFewArgs :: MonadP m => LocatedN RdrName -> m a
failOpFewArgs :: forall (m :: * -> *) a.
MonadP m =>
GenLocated SrcSpanAnnN RdrName -> m a
failOpFewArgs (L SrcSpanAnnN
loc RdrName
op) =
do { star_is_type <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
StarIsTypeBit
; let is_star_type = if Bool
star_is_type then StarIsType
StarIsType else StarIsType
StarIsNotType
; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $
(PsErrOpFewArgs is_star_type op) }
requireExplicitNamespaces :: MonadP m => SrcSpan -> m ()
requireExplicitNamespaces :: forall (m :: * -> *). MonadP m => SrcSpan -> m ()
requireExplicitNamespaces SrcSpan
l = do
allowed <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ExplicitNamespacesBit
unless allowed $
addError $ mkPlainErrorMsgEnvelope l PsErrIllegalExplicitNamespace
data PV_Context =
PV_Context
{ PV_Context -> ParserOpts
pv_options :: ParserOpts
, PV_Context -> ParseContext
pv_details :: ParseContext
}
data PV_Accum =
PV_Accum
{ PV_Accum -> Messages PsMessage
pv_warnings :: Messages PsMessage
, PV_Accum -> Messages PsMessage
pv_errors :: Messages PsMessage
, :: Strict.Maybe [LEpaComment]
, :: [LEpaComment]
}
data PV_Result a = PV_Ok PV_Accum a | PV_Failed PV_Accum
deriving ((forall m. Monoid m => PV_Result m -> m)
-> (forall m a. Monoid m => (a -> m) -> PV_Result a -> m)
-> (forall m a. Monoid m => (a -> m) -> PV_Result a -> m)
-> (forall a b. (a -> b -> b) -> b -> PV_Result a -> b)
-> (forall a b. (a -> b -> b) -> b -> PV_Result a -> b)
-> (forall b a. (b -> a -> b) -> b -> PV_Result a -> b)
-> (forall b a. (b -> a -> b) -> b -> PV_Result a -> b)
-> (forall a. (a -> a -> a) -> PV_Result a -> a)
-> (forall a. (a -> a -> a) -> PV_Result a -> a)
-> (forall a. PV_Result a -> [a])
-> (forall a. PV_Result a -> Bool)
-> (forall a. PV_Result a -> Int)
-> (forall a. Eq a => a -> PV_Result a -> Bool)
-> (forall a. Ord a => PV_Result a -> a)
-> (forall a. Ord a => PV_Result a -> a)
-> (forall a. Num a => PV_Result a -> a)
-> (forall a. Num a => PV_Result a -> a)
-> Foldable PV_Result
forall a. Eq a => a -> PV_Result a -> Bool
forall a. Num a => PV_Result a -> a
forall a. Ord a => PV_Result a -> a
forall m. Monoid m => PV_Result m -> m
forall a. PV_Result a -> Bool
forall a. PV_Result a -> Int
forall a. PV_Result a -> [a]
forall a. (a -> a -> a) -> PV_Result a -> a
forall m a. Monoid m => (a -> m) -> PV_Result a -> m
forall b a. (b -> a -> b) -> b -> PV_Result a -> b
forall a b. (a -> b -> b) -> b -> PV_Result a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => PV_Result m -> m
fold :: forall m. Monoid m => PV_Result m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> PV_Result a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PV_Result a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> PV_Result a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> PV_Result a -> a
foldr1 :: forall a. (a -> a -> a) -> PV_Result a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PV_Result a -> a
foldl1 :: forall a. (a -> a -> a) -> PV_Result a -> a
$ctoList :: forall a. PV_Result a -> [a]
toList :: forall a. PV_Result a -> [a]
$cnull :: forall a. PV_Result a -> Bool
null :: forall a. PV_Result a -> Bool
$clength :: forall a. PV_Result a -> Int
length :: forall a. PV_Result a -> Int
$celem :: forall a. Eq a => a -> PV_Result a -> Bool
elem :: forall a. Eq a => a -> PV_Result a -> Bool
$cmaximum :: forall a. Ord a => PV_Result a -> a
maximum :: forall a. Ord a => PV_Result a -> a
$cminimum :: forall a. Ord a => PV_Result a -> a
minimum :: forall a. Ord a => PV_Result a -> a
$csum :: forall a. Num a => PV_Result a -> a
sum :: forall a. Num a => PV_Result a -> a
$cproduct :: forall a. Num a => PV_Result a -> a
product :: forall a. Num a => PV_Result a -> a
Foldable, (forall a b. (a -> b) -> PV_Result a -> PV_Result b)
-> (forall a b. a -> PV_Result b -> PV_Result a)
-> Functor PV_Result
forall a b. a -> PV_Result b -> PV_Result a
forall a b. (a -> b) -> PV_Result a -> PV_Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PV_Result a -> PV_Result b
fmap :: forall a b. (a -> b) -> PV_Result a -> PV_Result b
$c<$ :: forall a b. a -> PV_Result b -> PV_Result a
<$ :: forall a b. a -> PV_Result b -> PV_Result a
Functor, Functor PV_Result
Foldable PV_Result
(Functor PV_Result, Foldable PV_Result) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b))
-> (forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b))
-> (forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a))
-> Traversable PV_Result
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a)
forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PV_Result a -> f (PV_Result b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PV_Result (f a) -> f (PV_Result a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PV_Result a -> m (PV_Result b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a)
sequence :: forall (m :: * -> *) a.
Monad m =>
PV_Result (m a) -> m (PV_Result a)
Traversable)
newtype PV a = PV { forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV :: PV_Context -> PV_Accum -> PV_Result a }
deriving ((forall a b. (a -> b) -> PV a -> PV b)
-> (forall a b. a -> PV b -> PV a) -> Functor PV
forall a b. a -> PV b -> PV a
forall a b. (a -> b) -> PV a -> PV b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PV a -> PV b
fmap :: forall a b. (a -> b) -> PV a -> PV b
$c<$ :: forall a b. a -> PV b -> PV a
<$ :: forall a b. a -> PV b -> PV a
Functor)
instance Applicative PV where
pure :: forall a. a -> PV a
pure a
a = a
a a -> PV a -> PV a
forall a b. a -> b -> b
`seq` (PV_Context -> PV_Accum -> PV_Result a) -> PV a
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV (\PV_Context
_ PV_Accum
acc -> PV_Accum -> a -> PV_Result a
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc a
a)
<*> :: forall a b. PV (a -> b) -> PV a -> PV b
(<*>) = PV (a -> b) -> PV a -> PV b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad PV where
PV a
m >>= :: forall a b. PV a -> (a -> PV b) -> PV b
>>= a -> PV b
f = (PV_Context -> PV_Accum -> PV_Result b) -> PV b
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result b) -> PV b)
-> (PV_Context -> PV_Accum -> PV_Result b) -> PV b
forall a b. (a -> b) -> a -> b
$ \PV_Context
ctx PV_Accum
acc ->
case PV a -> PV_Context -> PV_Accum -> PV_Result a
forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV PV a
m PV_Context
ctx PV_Accum
acc of
PV_Ok PV_Accum
acc' a
a -> PV b -> PV_Context -> PV_Accum -> PV_Result b
forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV (a -> PV b
f a
a) PV_Context
ctx PV_Accum
acc'
PV_Failed PV_Accum
acc' -> PV_Accum -> PV_Result b
forall a. PV_Accum -> PV_Result a
PV_Failed PV_Accum
acc'
runPV :: PV a -> P a
runPV :: forall a. PV a -> P a
runPV = ParseContext -> PV a -> P a
forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
noParseContext
askParseContext :: PV ParseContext
askParseContext :: PV ParseContext
askParseContext = (PV_Context -> PV_Accum -> PV_Result ParseContext)
-> PV ParseContext
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result ParseContext)
-> PV ParseContext)
-> (PV_Context -> PV_Accum -> PV_Result ParseContext)
-> PV ParseContext
forall a b. (a -> b) -> a -> b
$ \(PV_Context ParserOpts
_ ParseContext
details) PV_Accum
acc -> PV_Accum -> ParseContext -> PV_Result ParseContext
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc ParseContext
details
runPV_details :: ParseContext -> PV a -> P a
runPV_details :: forall a. ParseContext -> PV a -> P a
runPV_details ParseContext
details PV a
m =
(PState -> ParseResult a) -> P a
forall a. (PState -> ParseResult a) -> P a
P ((PState -> ParseResult a) -> P a)
-> (PState -> ParseResult a) -> P a
forall a b. (a -> b) -> a -> b
$ \PState
s ->
let
pv_ctx :: PV_Context
pv_ctx = PV_Context
{ pv_options :: ParserOpts
pv_options = PState -> ParserOpts
options PState
s
, pv_details :: ParseContext
pv_details = ParseContext
details }
pv_acc :: PV_Accum
pv_acc = PV_Accum
{ pv_warnings :: Messages PsMessage
pv_warnings = PState -> Messages PsMessage
warnings PState
s
, pv_errors :: Messages PsMessage
pv_errors = PState -> Messages PsMessage
errors PState
s
, pv_header_comments :: Maybe [LEpaComment]
pv_header_comments = PState -> Maybe [LEpaComment]
header_comments PState
s
, pv_comment_q :: [LEpaComment]
pv_comment_q = PState -> [LEpaComment]
comment_q PState
s }
mkPState :: PV_Accum -> PState
mkPState PV_Accum
acc' =
PState
s { warnings = pv_warnings acc'
, errors = pv_errors acc'
, comment_q = pv_comment_q acc' }
in
case PV a -> PV_Context -> PV_Accum -> PV_Result a
forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV PV a
m PV_Context
pv_ctx PV_Accum
pv_acc of
PV_Ok PV_Accum
acc' a
a -> PState -> a -> ParseResult a
forall a. PState -> a -> ParseResult a
POk (PV_Accum -> PState
mkPState PV_Accum
acc') a
a
PV_Failed PV_Accum
acc' -> PState -> ParseResult a
forall a. PState -> ParseResult a
PFailed (PV_Accum -> PState
mkPState PV_Accum
acc')
instance MonadP PV where
addError :: MsgEnvelope PsMessage -> PV ()
addError MsgEnvelope PsMessage
err =
(PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result ()) -> PV ())
-> (PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ctx PV_Accum
acc -> PV_Accum -> () -> PV_Result ()
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc{pv_errors = err `addMessage` pv_errors acc} ()
addWarning :: MsgEnvelope PsMessage -> PV ()
addWarning MsgEnvelope PsMessage
w =
(PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result ()) -> PV ())
-> (PV_Context -> PV_Accum -> PV_Result ()) -> PV ()
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ctx PV_Accum
acc ->
PV_Accum -> () -> PV_Result ()
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc{pv_warnings= w `addMessage` pv_warnings acc} ()
addFatalError :: forall a. MsgEnvelope PsMessage -> PV a
addFatalError MsgEnvelope PsMessage
err =
MsgEnvelope PsMessage -> PV ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError MsgEnvelope PsMessage
err PV () -> PV a -> PV a
forall a b. PV a -> PV b -> PV b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PV_Context -> PV_Accum -> PV_Result a) -> PV a
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Accum -> PV_Result a) -> PV_Context -> PV_Accum -> PV_Result a
forall a b. a -> b -> a
const PV_Accum -> PV_Result a
forall a. PV_Accum -> PV_Result a
PV_Failed)
getBit :: ExtBits -> PV Bool
getBit ExtBits
ext =
(PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool)
-> (PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool
forall a b. (a -> b) -> a -> b
$ \PV_Context
ctx PV_Accum
acc ->
let b :: Bool
b = ExtBits
ext ExtBits -> ExtsBitmap -> Bool
`xtest` ParserOpts -> ExtsBitmap
pExtsBitmap (PV_Context -> ParserOpts
pv_options PV_Context
ctx) in
PV_Accum -> Bool -> PV_Result Bool
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc (Bool -> PV_Result Bool) -> Bool -> PV_Result Bool
forall a b. (a -> b) -> a -> b
$! Bool
b
allocateCommentsP :: RealSrcSpan -> PV EpAnnComments
allocateCommentsP RealSrcSpan
ss = (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments)
-> (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ PV_Accum
s ->
if [LEpaComment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) then PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s EpAnnComments
emptyComments else
let ([LEpaComment]
comment_q', [LEpaComment]
newAnns) = RealSrcSpan -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
allocateComments RealSrcSpan
ss (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) in
PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s {
pv_comment_q = comment_q'
} ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
newAnns)
allocatePriorCommentsP :: RealSrcSpan -> PV EpAnnComments
allocatePriorCommentsP RealSrcSpan
ss = (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments)
-> (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ PV_Accum
s ->
let (Maybe [LEpaComment]
header_comments', [LEpaComment]
comment_q', [LEpaComment]
newAnns)
= RealSrcSpan
-> [LEpaComment]
-> Maybe [LEpaComment]
-> (Maybe [LEpaComment], [LEpaComment], [LEpaComment])
allocatePriorComments RealSrcSpan
ss (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) (PV_Accum -> Maybe [LEpaComment]
pv_header_comments PV_Accum
s) in
PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s {
pv_header_comments = header_comments',
pv_comment_q = comment_q'
} ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
newAnns)
allocateFinalCommentsP :: RealSrcSpan -> PV EpAnnComments
allocateFinalCommentsP RealSrcSpan
ss = (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments)
-> (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ PV_Accum
s ->
let (Maybe [LEpaComment]
header_comments', [LEpaComment]
comment_q', [LEpaComment]
newAnns)
= RealSrcSpan
-> [LEpaComment]
-> Maybe [LEpaComment]
-> (Maybe [LEpaComment], [LEpaComment], [LEpaComment])
allocateFinalComments RealSrcSpan
ss (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) (PV_Accum -> Maybe [LEpaComment]
pv_header_comments PV_Accum
s) in
PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s {
pv_header_comments = header_comments',
pv_comment_q = comment_q'
} ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced ([LEpaComment] -> Maybe [LEpaComment] -> [LEpaComment]
forall a. a -> Maybe a -> a
Strict.fromMaybe [] Maybe [LEpaComment]
header_comments') [LEpaComment]
newAnns)
hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat SrcSpan
span Pat GhcPs
e = do
bang_on <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
BangPatBit
unless bang_on $
addError $ mkPlainErrorMsgEnvelope span $ PsErrIllegalBangPattern e
mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
mkSumOrTupleExpr :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
mkSumOrTupleExpr l :: SrcSpanAnnA
l@(EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
csIn) Boxity
boxity (Tuple [Either (EpAnn Bool) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
es) [AddEpAnn]
anns = do
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
return $ L (EpAnn anc an (csIn Semi.<> cs)) (ExplicitTuple anns (map toTupArg es) boxity)
where
toTupArg :: Either (EpAnn Bool) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg :: Either (EpAnn Bool) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg (Left EpAnn Bool
ann) = EpAnn Bool -> HsTupArg GhcPs
missingTupArg EpAnn Bool
ann
toTupArg (Right LHsExpr GhcPs
a) = XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
NoExtField
noExtField LHsExpr GhcPs
a
mkSumOrTupleExpr l :: SrcSpanAnnA
l@(EpAnn EpaLocation
anc AnnListItem
anIn EpAnnComments
csIn) Boxity
Unboxed (Sum Int
alt Int
arity GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [EpaLocation]
barsp [EpaLocation]
barsa) [AddEpAnn]
anns = do
let an :: AnnExplicitSum
an = case [AddEpAnn]
anns of
[AddEpAnn AnnKeywordId
AnnOpenPH EpaLocation
o, AddEpAnn AnnKeywordId
AnnClosePH EpaLocation
c] ->
EpaLocation
-> [EpaLocation] -> [EpaLocation] -> EpaLocation -> AnnExplicitSum
AnnExplicitSum EpaLocation
o [EpaLocation]
barsp [EpaLocation]
barsa EpaLocation
c
[AddEpAnn]
_ -> String -> AnnExplicitSum
forall a. HasCallStack => String -> a
panic String
"mkSumOrTupleExpr"
!cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l)
return $ L (EpAnn anc anIn (csIn Semi.<> cs)) (ExplicitSum an alt arity e)
mkSumOrTupleExpr SrcSpanAnnA
l Boxity
Boxed a :: SumOrTuple (HsExpr GhcPs)
a@Sum{} [AddEpAnn]
_ =
MsgEnvelope PsMessage -> PV (LHsExpr GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LHsExpr GhcPs))
-> MsgEnvelope PsMessage -> PV (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SumOrTuple (HsExpr GhcPs) -> PsMessage
PsErrUnsupportedBoxedSumExpr SumOrTuple (HsExpr GhcPs)
a
mkSumOrTuplePat
:: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat SrcSpanAnnA
l Boxity
boxity (Tuple [Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))]
ps) [AddEpAnn]
anns = do
ps' <- (Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
toTupPat [Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))]
ps
return $ L l (PatBuilderPat (TuplePat anns ps' boxity))
where
toTupPat :: Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs)
toTupPat :: Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
toTupPat Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
p = case Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs))
p of
Left EpAnn Bool
_ -> MsgEnvelope PsMessage -> PV (LPat GhcPs)
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LPat GhcPs))
-> MsgEnvelope PsMessage -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$
SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) PsMessage
PsErrTupleSectionInPat
Right LocatedA (PatBuilder GhcPs)
p' -> LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
p'
mkSumOrTuplePat SrcSpanAnnA
l Boxity
Unboxed (Sum Int
alt Int
arity LocatedA (PatBuilder GhcPs)
p [EpaLocation]
barsb [EpaLocation]
barsa) [AddEpAnn]
anns = do
p' <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
p
let an = [AddEpAnn] -> [EpaLocation] -> [EpaLocation] -> EpAnnSumPat
EpAnnSumPat [AddEpAnn]
anns [EpaLocation]
barsb [EpaLocation]
barsa
return $ L l (PatBuilderPat (SumPat an p' alt arity))
mkSumOrTuplePat SrcSpanAnnA
l Boxity
Boxed a :: SumOrTuple (PatBuilder GhcPs)
a@Sum{} [AddEpAnn]
_ =
MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a. MsgEnvelope PsMessage -> PV a
forall (m :: * -> *) a. MonadP m => MsgEnvelope PsMessage -> m a
addFatalError (MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs)))
-> MsgEnvelope PsMessage -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$
SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l) (PsMessage -> MsgEnvelope PsMessage)
-> PsMessage -> MsgEnvelope PsMessage
forall a b. (a -> b) -> a -> b
$ SumOrTuple (PatBuilder GhcPs) -> PsMessage
PsErrUnsupportedBoxedSumPat SumOrTuple (PatBuilder GhcPs)
a
mkLHsOpTy :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> LHsType GhcPs
mkLHsOpTy :: PromotionFlag
-> LHsType GhcPs
-> 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 => EpAnn a -> EpAnn a -> EpAnn a
`combineSrcSpansA` (SrcSpan -> SrcSpanAnnA
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
op) SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => EpAnn a -> EpAnn a -> EpAnn 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 :: EpToken "%" -> LHsType GhcPs -> EpUniToken "->" "→" -> HsArrow GhcPs
mkMultTy :: EpToken "%"
-> LHsType GhcPs -> EpUniToken "->" "\8594" -> HsArrow GhcPs
mkMultTy EpToken "%"
pct t :: LHsType GhcPs
t@(L SrcSpanAnnA
_ (HsTyLit XTyLit GhcPs
_ (HsNumTy (SourceText (FastString -> String
unpackFS -> String
"1")) Integer
1))) EpUniToken "->" "\8594"
arr
= XLinearArrow GhcPs -> HsArrow GhcPs
forall pass. XLinearArrow pass -> HsArrow pass
HsLinearArrow (EpToken "%1" -> EpUniToken "->" "\8594" -> EpLinearArrow
EpPct1 EpToken "%1"
pct1 EpUniToken "->" "\8594"
arr)
where
pct1 :: EpToken "%1"
pct1 :: EpToken "%1"
pct1 = EpToken "%" -> SrcSpan -> EpToken "%1"
forall (tok :: Symbol) (tok' :: Symbol).
EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR EpToken "%"
pct (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
mkMultTy EpToken "%"
pct LHsType GhcPs
t EpUniToken "->" "\8594"
arr = XExplicitMult GhcPs -> LHsType GhcPs -> HsArrow GhcPs
forall pass. XExplicitMult pass -> LHsType pass -> HsArrow pass
HsExplicitMult (EpToken "%"
pct, EpUniToken "->" "\8594"
arr) LHsType GhcPs
t
mkMultAnn :: EpToken "%" -> LHsType GhcPs -> HsMultAnn GhcPs
mkMultAnn :: EpToken "%" -> LHsType GhcPs -> HsMultAnn GhcPs
mkMultAnn EpToken "%"
pct t :: LHsType GhcPs
t@(L SrcSpanAnnA
_ (HsTyLit XTyLit GhcPs
_ (HsNumTy (SourceText (FastString -> String
unpackFS -> String
"1")) Integer
1)))
= XPct1Ann GhcPs -> HsMultAnn GhcPs
forall pass. XPct1Ann pass -> HsMultAnn pass
HsPct1Ann EpToken "%1"
XPct1Ann GhcPs
pct1
where
pct1 :: EpToken "%1"
pct1 :: EpToken "%1"
pct1 = EpToken "%" -> SrcSpan -> EpToken "%1"
forall (tok :: Symbol) (tok' :: Symbol).
EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR EpToken "%"
pct (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t))
mkMultAnn EpToken "%"
pct LHsType GhcPs
t = XMultAnn GhcPs -> LHsType (NoGhcTc GhcPs) -> HsMultAnn GhcPs
forall pass.
XMultAnn pass -> LHsType (NoGhcTc pass) -> HsMultAnn pass
HsMultAnn EpToken "%"
XMultAnn GhcPs
pct LHsType (NoGhcTc GhcPs)
LHsType GhcPs
t
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation (UnhelpfulSpan UnhelpfulSpanReason
_) = TokenLocation
NoTokenLoc
mkTokenLocation (RealSrcSpan RealSrcSpan
r Maybe BufSpan
mb) = EpaLocation -> TokenLocation
TokenLoc (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r Maybe BufSpan
mb))
epTokenWidenR :: EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR :: forall (tok :: Symbol) (tok' :: Symbol).
EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR EpToken tok
NoEpTok SrcSpan
_ = EpToken tok'
forall (tok :: Symbol). EpToken tok
NoEpTok
epTokenWidenR (EpTok EpaLocation
l) (UnhelpfulSpan UnhelpfulSpanReason
_) = EpaLocation -> EpToken tok'
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok EpaLocation
l
epTokenWidenR (EpTok (EpaSpan SrcSpan
s1)) SrcSpan
s2 = EpaLocation -> EpToken tok'
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok (SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
s1 SrcSpan
s2))
epTokenWidenR (EpTok (EpaDelta DeltaPos
_ [LEpaComment]
_)) SrcSpan
_ =
String -> EpToken tok'
forall a. HasCallStack => String -> a
panic String
"epTokenWidenR: EpaDelta"
starSym :: Bool -> FastString
starSym :: Bool -> FastString
starSym Bool
True = String -> FastString
fsLit String
"★"
starSym Bool
False = String -> FastString
fsLit String
"*"
mkRdrGetField :: LHsExpr GhcPs -> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
-> HsExpr GhcPs
mkRdrGetField :: LHsExpr GhcPs
-> LocatedAn NoEpAnns (DotFieldOcc GhcPs) -> HsExpr GhcPs
mkRdrGetField LHsExpr GhcPs
arg LocatedAn NoEpAnns (DotFieldOcc GhcPs)
field =
HsGetField {
gf_ext :: XGetField GhcPs
gf_ext = XGetField GhcPs
NoExtField
NoExtField
, gf_expr :: LHsExpr GhcPs
gf_expr = LHsExpr GhcPs
arg
, gf_field :: XRec GhcPs (DotFieldOcc GhcPs)
gf_field = XRec GhcPs (DotFieldOcc GhcPs)
LocatedAn NoEpAnns (DotFieldOcc GhcPs)
field
}
mkRdrProjection :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)) -> AnnProjection -> HsExpr GhcPs
mkRdrProjection :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
-> AnnProjection -> HsExpr GhcPs
mkRdrProjection NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
flds AnnProjection
anns =
HsProjection {
proj_ext :: XProjection GhcPs
proj_ext = XProjection GhcPs
AnnProjection
anns
, proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_flds = NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))
flds
}
mkRdrProjUpdate :: SrcSpanAnnA -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs -> Bool -> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate :: SrcSpanAnnA
-> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate SrcSpanAnnA
_ (L SrcSpan
_ []) LHsExpr GhcPs
_ Bool
_ [AddEpAnn]
_ = String
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => String -> a
panic String
"mkRdrProjUpdate: The impossible has happened!"
mkRdrProjUpdate SrcSpanAnnA
loc (L SrcSpan
l [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
flds) LHsExpr GhcPs
arg Bool
isPun [AddEpAnn]
anns =
SrcSpanAnnA
-> HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated EpAnnCO (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsFieldBind {
hfbAnn :: XHsFieldBind (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
hfbAnn = [AddEpAnn]
XHsFieldBind (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
anns
, hfbLHS :: GenLocated EpAnnCO (FieldLabelStrings GhcPs)
hfbLHS = EpAnnCO
-> FieldLabelStrings GhcPs
-> GenLocated EpAnnCO (FieldLabelStrings GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> EpAnnCO
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) ([XRec GhcPs (DotFieldOcc GhcPs)] -> FieldLabelStrings GhcPs
forall p. [XRec p (DotFieldOcc p)] -> FieldLabelStrings p
FieldLabelStrings [XRec GhcPs (DotFieldOcc GhcPs)]
[LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
flds)
, hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbRHS = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
, hfbPun :: Bool
hfbPun = Bool
isPun
}
punsAllowed :: P Bool
punsAllowed :: P Bool
punsAllowed = ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ListTuplePunsBit
punsIfElse :: a -> a -> P a
punsIfElse :: forall a. a -> a -> P a
punsIfElse a
enabled a
disabled = do
allowed <- P Bool
punsAllowed
pure (if allowed then enabled else disabled)
requireLTPuns :: PsErrPunDetails -> Located a -> Located b -> P ()
requireLTPuns :: forall a b. PsErrPunDetails -> Located a -> Located b -> P ()
requireLTPuns PsErrPunDetails
err Located a
start Located b
end =
P Bool -> P () -> P ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM P Bool
punsAllowed (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
MsgEnvelope PsMessage -> P ()
forall (m :: * -> *). MonadP m => MsgEnvelope PsMessage -> m ()
addError (SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
loc (PsErrPunDetails -> PsMessage
PsErrInvalidPun PsErrPunDetails
err))
where
loc :: SrcSpan
loc = (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located a -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located a
start) (Located b -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located b
end))
withCombinedComments ::
HasLoc l1 =>
HasLoc l2 =>
l1 ->
l2 ->
(SrcSpan -> P a) ->
P (LocatedA a)
l1
start l2
end SrcSpan -> P a
use = do
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
fullSpan
a <- use fullSpan
pure (L (EpAnn (spanAsAnchor fullSpan) noAnn cs) a)
where
fullSpan :: SrcSpan
fullSpan = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (l1 -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc l1
start) (l2 -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc l2
end)
mkTupleSyntaxTy :: EpaLocation
-> [LocatedA (HsType GhcPs)]
-> EpaLocation
-> P (HsType GhcPs)
mkTupleSyntaxTy :: EpaLocation
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> EpaLocation
-> P (HsType GhcPs)
mkTupleSyntaxTy EpaLocation
parOpen [GenLocated SrcSpanAnnA (HsType GhcPs)]
args EpaLocation
parClose =
HsType GhcPs -> HsType GhcPs -> P (HsType GhcPs)
forall a. a -> a -> P a
punsIfElse HsType GhcPs
enabled HsType GhcPs
disabled
where
enabled :: HsType GhcPs
enabled =
XTupleTy GhcPs -> HsTupleSort -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy GhcPs
AnnParen
annParen HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
args
disabled :: HsType GhcPs
disabled =
XExplicitTupleTy GhcPs -> [LHsType GhcPs] -> HsType GhcPs
forall pass. XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
HsExplicitTupleTy [AddEpAnn]
XExplicitTupleTy GhcPs
annsKeyword [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
args
annParen :: AnnParen
annParen = ParenType -> EpaLocation -> EpaLocation -> AnnParen
AnnParen ParenType
AnnParens EpaLocation
parOpen EpaLocation
parClose
annsKeyword :: [AddEpAnn]
annsKeyword = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenP EpaLocation
parOpen, AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseP EpaLocation
parClose]
mkTupleSyntaxTycon :: Boxity -> Int -> P RdrName
mkTupleSyntaxTycon :: Boxity -> Int -> P RdrName
mkTupleSyntaxTycon Boxity
boxity Int
n =
RdrName -> RdrName -> P RdrName
forall a. a -> a -> P a
punsIfElse
(TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
n))
(DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
n))
mkListSyntaxTy0 :: EpaLocation
-> EpaLocation
-> SrcSpan
-> P (HsType GhcPs)
mkListSyntaxTy0 :: EpaLocation -> EpaLocation -> SrcSpan -> P (HsType GhcPs)
mkListSyntaxTy0 EpaLocation
brkOpen EpaLocation
brkClose SrcSpan
span =
HsType GhcPs -> HsType GhcPs -> P (HsType GhcPs)
forall a. a -> a -> P a
punsIfElse HsType GhcPs
enabled HsType GhcPs
disabled
where
enabled :: HsType GhcPs
enabled = XTyVar GhcPs
-> PromotionFlag -> XRec GhcPs (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar [AddEpAnn]
XTyVar GhcPs
forall a. NoAnn a => a
noAnn PromotionFlag
NotPromoted XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
rn
rn :: GenLocated SrcSpanAnnN RdrName
rn = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> NameAnn -> EpAnnComments -> SrcSpanAnnN
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
fullLoc NameAnn
rdrNameAnn EpAnnComments
emptyComments) RdrName
listTyCon_RDR
disabled :: HsType GhcPs
disabled =
XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy [AddEpAnn]
XExplicitListTy GhcPs
annsKeyword PromotionFlag
NotPromoted []
rdrNameAnn :: NameAnn
rdrNameAnn = NameAdornment
-> EpaLocation -> EpaLocation -> [TrailingAnn] -> NameAnn
NameAnnOnly NameAdornment
NameSquare EpaLocation
brkOpen EpaLocation
brkClose []
annsKeyword :: [AddEpAnn]
annsKeyword = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenS EpaLocation
brkOpen, AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseS EpaLocation
brkClose]
fullLoc :: EpaLocation
fullLoc = SrcSpan -> EpaLocation
forall a. SrcSpan -> EpaLocation' a
EpaSpan SrcSpan
span
mkListSyntaxTy1 :: EpaLocation
-> LocatedA (HsType GhcPs)
-> EpaLocation
-> P (HsType GhcPs)
mkListSyntaxTy1 :: EpaLocation
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> EpaLocation
-> P (HsType GhcPs)
mkListSyntaxTy1 EpaLocation
brkOpen GenLocated SrcSpanAnnA (HsType GhcPs)
t EpaLocation
brkClose =
HsType GhcPs -> HsType GhcPs -> P (HsType GhcPs)
forall a. a -> a -> P a
punsIfElse HsType GhcPs
enabled HsType GhcPs
disabled
where
enabled :: HsType GhcPs
enabled = XListTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy GhcPs
AnnParen
annParen LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
disabled :: HsType GhcPs
disabled =
XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy [AddEpAnn]
XExplicitListTy GhcPs
annsKeyword PromotionFlag
NotPromoted [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t]
annsKeyword :: [AddEpAnn]
annsKeyword = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenS EpaLocation
brkOpen, AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseS EpaLocation
brkClose]
annParen :: AnnParen
annParen = ParenType -> EpaLocation -> EpaLocation -> AnnParen
AnnParen ParenType
AnnParensSquare EpaLocation
brkOpen EpaLocation
brkClose