{-# LANGUAGE CPP               #-}
{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE LambdaCase        #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

--
--  (c) The University of Glasgow 2002-2006
--

-- Functions over HsSyn specialised to RdrName.

module GHC.Parser.PostProcess (
        mkRdrGetField, mkRdrProjection, Fbind, -- RecordDot
        mkHsOpApp,
        mkHsIntegral, mkHsFractional, mkHsIsString,
        mkHsDo, mkSpliceDecl,
        mkRoleAnnotDecl,
        mkClassDecl,
        mkTyData, mkDataFamInst,
        mkTySynonym, mkTyFamInstEqn,
        mkStandaloneKindSig,
        mkTyFamInst,
        mkFamDecl,
        mkInlinePragma,
        mkPatSynMatchGroup,
        mkRecConstrOrUpdate,
        mkTyClD, mkInstD,
        mkRdrRecordCon, mkRdrRecordUpd,
        setRdrNameSpace,
        fromSpecTyVarBndr, fromSpecTyVarBndrs,
        annBinds,

        cvBindGroup,
        cvBindsAndSigs,
        cvTopDecls,
        placeHolderPunRhs,

        -- Stuff to do with Foreign declarations
        mkImport,
        parseCImport,
        mkExport,
        mkExtName,    -- RdrName -> CLabelString
        mkGadtDecl,   -- [LocatedA RdrName] -> LHsType RdrName -> ConDecl RdrName
        mkConDeclH98,

        -- Bunch of functions in the parser monad for
        -- checking and constructing values
        checkImportDecl,
        checkExpBlockArguments, checkCmdBlockArguments,
        checkPrecP,           -- Int -> P Int
        checkContext,         -- HsType -> P HsContext
        checkPattern,         -- HsExp -> P HsPat
        checkPattern_hints,
        checkMonadComp,       -- P (HsStmtContext GhcPs)
        checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
        checkValSigLhs,
        LRuleTyTmVar, RuleTyTmVar(..),
        mkRuleBndrs, mkRuleTyVarBndrs,
        checkRuleTyVarBndrNames,
        checkRecordSyntax,
        checkEmptyGADTs,
        addFatalError, hintBangPat,
        mkBangTy,
        UnpackednessPragma(..),
        mkMultTy,

        -- Help with processing exports
        ImpExpSubSpec(..),
        ImpExpQcSpec(..),
        mkModuleImpExp,
        mkTypeImpExp,
        mkImpExpSubSpec,
        checkImportSpec,

        -- Token symbols
        starSym,

        -- Warnings and errors
        warnStarIsType,
        warnPrepositiveQualifiedModule,
        failOpFewArgs,
        failOpNotEnabledImportQualifiedPost,
        failOpImportQualifiedTwice,

        SumOrTuple (..),

        -- Expression/command/pattern ambiguity resolution
        PV,
        runPV,
        ECP(ECP, unECP),
        DisambInfixOp(..),
        DisambECP(..),
        ecpFromExp,
        ecpFromCmd,
        PatBuilder,

        -- Type/datacon ambiguity resolution
        DisambTD(..),
        addUnpackednessP,
        dataConBuilderCon,
        dataConBuilderDetails,
    ) where

import GHC.Prelude
import GHC.Hs           -- Lots of it
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.Unit.Module (ModuleName)
import GHC.Types.Basic
import GHC.Types.Fixity
import GHC.Types.SourceText
import GHC.Parser.Types
import GHC.Parser.Lexer
import GHC.Parser.Errors
import GHC.Utils.Lexeme ( isLexCon )
import GHC.Types.TyThing
import GHC.Core.Type    ( unrestrictedFunTyCon, Specificity(..) )
import GHC.Builtin.Types( cTupleTyConName, tupleTyCon, tupleDataCon,
                          nilDataConName, nilDataConKey,
                          listTyConName, listTyConKey, eqTyCon_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.Data.Bag
import GHC.Utils.Misc
import Data.Either
import Data.List
import Data.Foldable
import GHC.Driver.Flags ( WarningFlag(..) )
import qualified Data.Semigroup as Semi
import GHC.Utils.Panic

import Control.Monad
import Text.ParserCombinators.ReadP as ReadP
import Data.Char
import Data.Data       ( dataTypeOf, fromConstr, dataTypeConstrs )
import Data.Kind       ( Type )

#include "HsVersions.h"

{- **********************************************************************

  Construction functions for Rdr stuff

  ********************************************************************* -}

-- | mkClassDecl builds a RdrClassDecl, filling in the names for tycon and
-- datacon by deriving them from the name of the class.  We fill in the names
-- for the tycon and datacon corresponding to the class, by deriving them
-- from the name of the class itself.  This saves recording the names in the
-- interface file (which would be equally good).

-- Similarly for mkConDecl, mkClassOpSig and default-method names.

--         *** See Note [The Naming story] in GHC.Hs.Decls ****

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 NoExtField
XTyClD (GhcPass p)
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 NoExtField
XInstD (GhcPass p)
noExtField InstDecl (GhcPass p)
d)

mkClassDecl :: SrcSpan
            -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
            -> Located (a,[LHsFunDep GhcPs])
            -> OrdList (LHsDecl GhcPs)
            -> LayoutInfo
            -> [AddEpAnn]
            -> P (LTyClDecl GhcPs)

mkClassDecl :: forall a.
SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a, [LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
-> LayoutInfo
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkClassDecl SrcSpan
loc' (L SrcSpan
_ (Maybe (LHsContext GhcPs)
mcxt, LHsType GhcPs
tycl_hdr)) Located (a, [LHsFunDep GhcPs])
fds OrdList (LHsDecl GhcPs)
where_cls LayoutInfo
layoutInfo [AddEpAnn]
annsIn
  = do { let loc :: SrcSpanAnnA
loc = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc'
       ; (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
binds, [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs, [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
ats, [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
at_defs, [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
_, [GenLocated SrcSpanAnnA DocDecl]
docs) <- OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
      [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
where_cls
       ; (GenLocated SrcSpanAnnN RdrName
cls, [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
True LHsType GhcPs
tycl_hdr
       ; (LHsQTyVars GhcPs
tyvars,[AddEpAnn]
annst) <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs, [AddEpAnn])
checkTyVars (String -> SDoc
text String
"class") SDoc
whereDots GenLocated SrcSpanAnnN RdrName
cls [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparams
       ; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) -- Get any remaining comments
       ; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) ([AddEpAnn]
ann[AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++[AddEpAnn]
annst) EpAnnComments
cs
       ; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (ClassDecl { tcdCExt :: XClassDecl GhcPs
tcdCExt = (EpAnn [AddEpAnn]
anns', AnnSortKey
NoAnnSortKey, LayoutInfo
layoutInfo)
                                  , tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt = Maybe (LHsContext GhcPs)
mcxt
                                  , tcdLName :: LIdP GhcPs
tcdLName = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
cls, tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tyvars
                                  , tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
fixity
                                  , tcdFDs :: [LHsFunDep GhcPs]
tcdFDs = (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
-> [GenLocated SrcSpanAnnA (FunDep GhcPs)]
forall a b. (a, b) -> b
snd (GenLocated SrcSpan (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
-> (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (a, [GenLocated SrcSpanAnnA (FunDep GhcPs)])
Located (a, [LHsFunDep GhcPs])
fds)
                                  , tcdSigs :: [LSig GhcPs]
tcdSigs = [LSig GhcPs] -> [LSig GhcPs]
mkClassOpSigs [GenLocated SrcSpanAnnA (Sig GhcPs)]
[LSig GhcPs]
sigs
                                  , tcdMeths :: LHsBinds GhcPs
tcdMeths = Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
LHsBinds GhcPs
binds
                                  , tcdATs :: [LFamilyDecl GhcPs]
tcdATs = [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
[LFamilyDecl GhcPs]
ats, tcdATDefs :: [LTyFamInstDecl GhcPs]
tcdATDefs = [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
[LTyFamInstDecl GhcPs]
at_defs
                                  , tcdDocs :: [LDocDecl GhcPs]
tcdDocs  = [GenLocated SrcSpanAnnA DocDecl]
[LDocDecl GhcPs]
docs })) }

mkTyData :: SrcSpan
         -> NewOrData
         -> Maybe (LocatedP CType)
         -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
         -> Maybe (LHsKind GhcPs)
         -> [LConDecl GhcPs]
         -> Located (HsDeriving GhcPs)
         -> [AddEpAnn]
         -> P (LTyClDecl GhcPs)
mkTyData :: SrcSpan
-> 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' NewOrData
new_or_data Maybe (LocatedP CType)
cType (L SrcSpan
_ (Maybe (LHsContext GhcPs)
mcxt, LHsType GhcPs
tycl_hdr))
         Maybe (LHsType GhcPs)
ksig [LConDecl GhcPs]
data_cons (L SrcSpan
_ HsDeriving GhcPs
maybe_deriv) [AddEpAnn]
annsIn
  = do { let loc :: SrcSpanAnnA
loc = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc'
       ; (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
       ; (LHsQTyVars GhcPs
tyvars, [AddEpAnn]
anns) <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs, [AddEpAnn])
checkTyVars (NewOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr NewOrData
new_or_data) SDoc
equalsDots GenLocated SrcSpanAnnN RdrName
tc [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparams
       ; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) -- Get any remaining comments
       ; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) ([AddEpAnn]
ann [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
anns) EpAnnComments
cs
       ; HsDataDefn GhcPs
defn <- NewOrData
-> Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsType GhcPs)
-> [LConDecl GhcPs]
-> HsDeriving GhcPs
-> P (HsDataDefn GhcPs)
mkDataDefn NewOrData
new_or_data Maybe (LocatedP CType)
cType Maybe (LHsContext GhcPs)
mcxt Maybe (LHsType GhcPs)
ksig [LConDecl GhcPs]
data_cons HsDeriving GhcPs
maybe_deriv
       ; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (DataDecl { tcdDExt :: XDataDecl GhcPs
tcdDExt = EpAnn [AddEpAnn]
XDataDecl GhcPs
anns',
                                   tcdLName :: LIdP GhcPs
tcdLName = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tc, tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tyvars,
                                   tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
fixity,
                                   tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn = HsDataDefn GhcPs
defn })) }

mkDataDefn :: NewOrData
           -> Maybe (LocatedP CType)
           -> Maybe (LHsContext GhcPs)
           -> Maybe (LHsKind GhcPs)
           -> [LConDecl GhcPs]
           -> HsDeriving GhcPs
           -> P (HsDataDefn GhcPs)
mkDataDefn :: NewOrData
-> Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsType GhcPs)
-> [LConDecl GhcPs]
-> HsDeriving GhcPs
-> P (HsDataDefn GhcPs)
mkDataDefn NewOrData
new_or_data Maybe (LocatedP CType)
cType Maybe (LHsContext GhcPs)
mcxt Maybe (LHsType GhcPs)
ksig [LConDecl GhcPs]
data_cons HsDeriving GhcPs
maybe_deriv
  = do { Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Maybe (LHsContext GhcPs)
mcxt
       ; HsDataDefn GhcPs -> P (HsDataDefn GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsDataDefn { dd_ext :: XCHsDataDefn GhcPs
dd_ext = NoExtField
XCHsDataDefn GhcPs
noExtField
                            , dd_ND :: NewOrData
dd_ND = NewOrData
new_or_data, dd_cType :: Maybe (XRec GhcPs CType)
dd_cType = Maybe (LocatedP CType)
Maybe (XRec GhcPs CType)
cType
                            , dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ctxt = Maybe (LHsContext GhcPs)
mcxt
                            , dd_cons :: [LConDecl GhcPs]
dd_cons = [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  -- LHS
            -> LHsType GhcPs  -- RHS
            -> [AddEpAnn]
            -> P (LTyClDecl GhcPs)
mkTySynonym :: SrcSpan
-> LHsType GhcPs
-> LHsType GhcPs
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkTySynonym SrcSpan
loc LHsType GhcPs
lhs LHsType GhcPs
rhs [AddEpAnn]
annsIn
  = do { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
       ; EpAnnComments
cs1 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc -- Add any API Annotations to the top SrcSpan [temp]
       ; (LHsQTyVars GhcPs
tyvars, [AddEpAnn]
anns) <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs, [AddEpAnn])
checkTyVars (String -> SDoc
text String
"type") SDoc
equalsDots GenLocated SrcSpanAnnN RdrName
tc [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparams
       ; EpAnnComments
cs2 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc -- Add any API Annotations to the top SrcSpan [temp]
       ; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) ([AddEpAnn]
ann [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
anns) (EpAnnComments
cs1 EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
       ; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (SynDecl
                                { tcdSExt :: XSynDecl GhcPs
tcdSExt = EpAnn [AddEpAnn]
XSynDecl GhcPs
anns'
                                , tcdLName :: LIdP GhcPs
tcdLName = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tc, tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tyvars
                                , tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
fixity
                                , tcdRhs :: LHsType GhcPs
tcdRhs = LHsType GhcPs
rhs })) }

mkStandaloneKindSig
  :: SrcSpan
  -> Located [LocatedN RdrName]   -- LHS
  -> LHsSigType GhcPs             -- RHS
  -> [AddEpAnn]
  -> P (LStandaloneKindSig GhcPs)
mkStandaloneKindSig :: SrcSpan
-> Located [GenLocated SrcSpanAnnN RdrName]
-> LHsSigType GhcPs
-> [AddEpAnn]
-> P (LStandaloneKindSig GhcPs)
mkStandaloneKindSig SrcSpan
loc Located [GenLocated SrcSpanAnnN RdrName]
lhs LHsSigType GhcPs
rhs [AddEpAnn]
anns =
  do { [GenLocated SrcSpanAnnN RdrName]
vs <- (GenLocated SrcSpanAnnN RdrName
 -> P (GenLocated SrcSpanAnnN RdrName))
-> [GenLocated SrcSpanAnnN RdrName]
-> P [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall {m :: * -> *} {a}.
MonadP m =>
GenLocated (SrcSpanAnn' a) RdrName
-> m (GenLocated (SrcSpanAnn' a) RdrName)
check_lhs_name (Located [GenLocated SrcSpanAnnN RdrName]
-> [GenLocated SrcSpanAnnN RdrName]
forall l e. GenLocated l e -> e
unLoc Located [GenLocated SrcSpanAnnN RdrName]
lhs)
     ; GenLocated SrcSpanAnnN RdrName
v <- [GenLocated SrcSpanAnnN RdrName]
-> P (GenLocated SrcSpanAnnN RdrName)
check_singular_lhs ([GenLocated SrcSpanAnnN RdrName]
-> [GenLocated SrcSpanAnnN RdrName]
forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnN RdrName]
vs)
     ; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
     ; GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
-> P (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
 -> P (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)))
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
-> P (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> StandaloneKindSig GhcPs
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc)
       (StandaloneKindSig GhcPs
 -> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
-> StandaloneKindSig GhcPs
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
forall a b. (a -> b) -> a -> b
$ XStandaloneKindSig GhcPs
-> LIdP GhcPs -> LHsSigType GhcPs -> StandaloneKindSig GhcPs
forall pass.
XStandaloneKindSig pass
-> LIdP pass -> LHsSigType pass -> StandaloneKindSig pass
StandaloneKindSig (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
anns EpAnnComments
cs) GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v LHsSigType GhcPs
rhs }
  where
    check_lhs_name :: GenLocated (SrcSpanAnn' a) RdrName
-> m (GenLocated (SrcSpanAnn' a) RdrName)
check_lhs_name v :: GenLocated (SrcSpanAnn' a) RdrName
v@(GenLocated (SrcSpanAnn' a) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc->RdrName
name) =
      if RdrName -> Bool
isUnqual RdrName
name Bool -> Bool -> Bool
&& OccName -> Bool
isTcOcc (RdrName -> OccName
rdrNameOcc RdrName
name)
      then GenLocated (SrcSpanAnn' a) RdrName
-> m (GenLocated (SrcSpanAnn' a) RdrName)
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated (SrcSpanAnn' a) RdrName
v
      else PsError -> m (GenLocated (SrcSpanAnn' a) RdrName)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> m (GenLocated (SrcSpanAnn' a) RdrName))
-> PsError -> m (GenLocated (SrcSpanAnn' a) RdrName)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (RdrName -> PsErrorDesc
PsErrUnexpectedQualifiedConstructor (GenLocated (SrcSpanAnn' a) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcSpanAnn' a) RdrName
v)) [] (GenLocated (SrcSpanAnn' a) RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated (SrcSpanAnn' a) RdrName
v)
    check_singular_lhs :: [GenLocated SrcSpanAnnN RdrName]
-> P (GenLocated SrcSpanAnnN RdrName)
check_singular_lhs [GenLocated SrcSpanAnnN RdrName]
vs =
      case [GenLocated SrcSpanAnnN RdrName]
vs of
        [] -> String -> P (GenLocated SrcSpanAnnN RdrName)
forall a. String -> a
panic String
"mkStandaloneKindSig: empty left-hand side"
        [GenLocated SrcSpanAnnN RdrName
v] -> GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnN RdrName
v
        [GenLocated SrcSpanAnnN RdrName]
_ -> PsError -> P (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P (GenLocated SrcSpanAnnN RdrName))
-> PsError -> P (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError ([LIdP GhcPs] -> PsErrorDesc
PsErrMultipleNamesInStandaloneKindSignature [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
vs) [] (Located [GenLocated SrcSpanAnnN RdrName] -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located [GenLocated SrcSpanAnnN RdrName]
lhs)

mkTyFamInstEqn :: SrcSpan
               -> HsOuterFamEqnTyVarBndrs GhcPs
               -> LHsType GhcPs
               -> LHsType GhcPs
               -> [AddEpAnn]
               -> P (LTyFamInstEqn GhcPs)
mkTyFamInstEqn :: SrcSpan
-> HsOuterFamEqnTyVarBndrs GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
-> [AddEpAnn]
-> P (LTyFamInstEqn GhcPs)
mkTyFamInstEqn SrcSpan
loc HsOuterFamEqnTyVarBndrs GhcPs
bndrs LHsType GhcPs
lhs LHsType GhcPs
rhs [AddEpAnn]
anns
  = do { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
       ; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
       ; GenLocated
  SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> P (GenLocated
        SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated
     SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> GenLocated
      SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
-> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated
     SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall a b. (a -> b) -> a -> b
$ FamEqn
                        { feqn_ext :: XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_ext    = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) ([AddEpAnn]
anns [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. Monoid a => a -> a -> a
`mappend` [AddEpAnn]
ann) EpAnnComments
cs
                        , feqn_tycon :: LIdP GhcPs
feqn_tycon  = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tc
                        , feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs  = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
                        , feqn_pats :: [LHsTypeArg GhcPs]
feqn_pats   = [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparams
                        , feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
fixity
                        , feqn_rhs :: GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_rhs    = GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
rhs })}

mkDataFamInst :: SrcSpan
              -> NewOrData
              -> Maybe (LocatedP CType)
              -> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs
                        , LHsType GhcPs)
              -> Maybe (LHsKind GhcPs)
              -> [LConDecl GhcPs]
              -> Located (HsDeriving GhcPs)
              -> [AddEpAnn]
              -> P (LInstDecl GhcPs)
mkDataFamInst :: SrcSpan
-> NewOrData
-> Maybe (LocatedP CType)
-> (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs,
    LHsType GhcPs)
-> Maybe (LHsType GhcPs)
-> [LConDecl GhcPs]
-> Located (HsDeriving GhcPs)
-> [AddEpAnn]
-> P (LInstDecl GhcPs)
mkDataFamInst SrcSpan
loc NewOrData
new_or_data Maybe (LocatedP CType)
cType (Maybe (LHsContext GhcPs)
mcxt, HsOuterFamEqnTyVarBndrs GhcPs
bndrs, LHsType GhcPs
tycl_hdr)
              Maybe (LHsType GhcPs)
ksig [LConDecl GhcPs]
data_cons (L SrcSpan
_ HsDeriving GhcPs
maybe_deriv) [AddEpAnn]
anns
  = do { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
tycl_hdr
       ; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc -- Add any API Annotations to the top SrcSpan
       ; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
ann EpAnnComments
cs) [AddEpAnn]
anns EpAnnComments
emptyComments
       ; HsDataDefn GhcPs
defn <- NewOrData
-> Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsType GhcPs)
-> [LConDecl GhcPs]
-> HsDeriving GhcPs
-> P (HsDataDefn GhcPs)
mkDataDefn NewOrData
new_or_data Maybe (LocatedP CType)
cType Maybe (LHsContext GhcPs)
mcxt Maybe (LHsType GhcPs)
ksig [LConDecl GhcPs]
data_cons HsDeriving GhcPs
maybe_deriv
       ; GenLocated SrcSpanAnnA (InstDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (InstDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> InstDecl GhcPs -> GenLocated SrcSpanAnnA (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (XDataFamInstD GhcPs -> DataFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XDataFamInstD pass -> DataFamInstDecl pass -> InstDecl pass
DataFamInstD EpAnn [AddEpAnn]
XDataFamInstD GhcPs
anns' (FamEqn GhcPs (HsDataDefn GhcPs) -> DataFamInstDecl GhcPs
forall pass. FamEqn pass (HsDataDefn pass) -> DataFamInstDecl pass
DataFamInstDecl
                  (FamEqn { feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext    = EpAnn [AddEpAnn]
XCFamEqn GhcPs (HsDataDefn GhcPs)
anns'
                          , feqn_tycon :: LIdP GhcPs
feqn_tycon  = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tc
                          , feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs  = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
                          , feqn_pats :: [LHsTypeArg GhcPs]
feqn_pats   = [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparams
                          , feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
fixity
                          , feqn_rhs :: HsDataDefn GhcPs
feqn_rhs    = HsDataDefn GhcPs
defn })))) }

mkTyFamInst :: SrcSpan
            -> TyFamInstEqn GhcPs
            -> [AddEpAnn]
            -> P (LInstDecl GhcPs)
mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs -> [AddEpAnn] -> P (LInstDecl GhcPs)
mkTyFamInst SrcSpan
loc TyFamInstEqn GhcPs
eqn [AddEpAnn]
anns = do
  EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
  GenLocated SrcSpanAnnA (InstDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (InstDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> InstDecl GhcPs -> GenLocated SrcSpanAnnA (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (XTyFamInstD GhcPs -> TyFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XTyFamInstD pass -> TyFamInstDecl pass -> InstDecl pass
TyFamInstD NoExtField
XTyFamInstD GhcPs
noExtField
              (XCTyFamInstDecl GhcPs -> TyFamInstEqn GhcPs -> TyFamInstDecl GhcPs
forall pass.
XCTyFamInstDecl pass -> TyFamInstEqn pass -> TyFamInstDecl pass
TyFamInstDecl (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
anns EpAnnComments
cs) TyFamInstEqn GhcPs
eqn)))

mkFamDecl :: SrcSpan
          -> FamilyInfo GhcPs
          -> TopLevelFlag
          -> LHsType GhcPs                   -- LHS
          -> Located (FamilyResultSig GhcPs) -- Optional result signature
          -> Maybe (LInjectivityAnn GhcPs)   -- Injectivity annotation
          -> [AddEpAnn]
          -> P (LTyClDecl GhcPs)
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LHsType GhcPs
-> Located (FamilyResultSig GhcPs)
-> Maybe (LInjectivityAnn GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
mkFamDecl SrcSpan
loc FamilyInfo GhcPs
info TopLevelFlag
topLevel LHsType GhcPs
lhs Located (FamilyResultSig GhcPs)
ksig Maybe (LInjectivityAnn GhcPs)
injAnn [AddEpAnn]
annsIn
  = do { (GenLocated SrcSpanAnnN RdrName
tc, [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
tparams, LexicalFixity
fixity, [AddEpAnn]
ann) <- Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
False LHsType GhcPs
lhs
       ; EpAnnComments
cs1 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc -- Add any API Annotations to the top SrcSpan [temp]
       ; (LHsQTyVars GhcPs
tyvars, [AddEpAnn]
anns) <- SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs, [AddEpAnn])
checkTyVars (FamilyInfo GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr FamilyInfo GhcPs
info) SDoc
equals_or_where GenLocated SrcSpanAnnN RdrName
tc [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparams
       ; EpAnnComments
cs2 <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc -- Add any API Annotations to the top SrcSpan [temp]
       ; let anns' :: EpAnn [AddEpAnn]
anns' = EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
annsIn EpAnnComments
emptyComments) ([AddEpAnn]
ann[AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++[AddEpAnn]
anns) (EpAnnComments
cs1 EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs2)
       ; GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (TyClDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> TyClDecl GhcPs -> GenLocated SrcSpanAnnA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (XFamDecl GhcPs -> FamilyDecl GhcPs -> TyClDecl GhcPs
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl NoExtField
XFamDecl GhcPs
noExtField
                                         (FamilyDecl
                                           { fdExt :: XCFamilyDecl GhcPs
fdExt       = EpAnn [AddEpAnn]
XCFamilyDecl GhcPs
anns'
                                           , fdTopLevel :: TopLevelFlag
fdTopLevel  = TopLevelFlag
topLevel
                                           , fdInfo :: FamilyInfo GhcPs
fdInfo      = FamilyInfo GhcPs
info, fdLName :: LIdP GhcPs
fdLName = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tc
                                           , fdTyVars :: LHsQTyVars GhcPs
fdTyVars    = LHsQTyVars GhcPs
tyvars
                                           , fdFixity :: LexicalFixity
fdFixity    = LexicalFixity
fixity
                                           , fdResultSig :: LFamilyResultSig GhcPs
fdResultSig = Located (FamilyResultSig GhcPs)
LFamilyResultSig GhcPs
ksig
                                           , fdInjectivityAnn :: Maybe (LInjectivityAnn GhcPs)
fdInjectivityAnn = Maybe (LInjectivityAnn GhcPs)
injAnn }))) }
  where
    equals_or_where :: SDoc
equals_or_where = case FamilyInfo GhcPs
info of
                        FamilyInfo GhcPs
DataFamily          -> SDoc
empty
                        FamilyInfo GhcPs
OpenTypeFamily      -> SDoc
empty
                        ClosedTypeFamily {} -> SDoc
whereDots

mkSpliceDecl :: LHsExpr GhcPs -> P (LHsDecl GhcPs)
-- If the user wrote
--      [pads| ... ]   then return a QuasiQuoteD
--      $(e)           then return a SpliceD
-- but if they wrote, say,
--      f x            then behave as if they'd written $(f x)
--                     ie a SpliceD
--
-- Typed splices are not allowed at the top level, thus we do not represent them
-- as spliced declaration.  See #10945
mkSpliceDecl :: LHsExpr GhcPs -> P (LHsDecl GhcPs)
mkSpliceDecl lexpr :: LHsExpr GhcPs
lexpr@(L SrcSpanAnnA
loc HsExpr GhcPs
expr)
  | HsSpliceE XSpliceE GhcPs
_ splice :: HsSplice GhcPs
splice@(HsUntypedSplice {}) <- HsExpr GhcPs
expr = do
    EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> P (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
loc EpAnnComments
cs) (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD NoExtField
XSpliceD GhcPs
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsSplice GhcPs)
-> SpliceExplicitFlag
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsSplice p) -> SpliceExplicitFlag -> SpliceDecl p
SpliceDecl NoExtField
XSpliceDecl GhcPs
noExtField (SrcSpanAnnA
-> HsSplice GhcPs -> GenLocated SrcSpanAnnA (HsSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsSplice GhcPs
splice) SpliceExplicitFlag
ExplicitSplice)

  | HsSpliceE XSpliceE GhcPs
_ splice :: HsSplice GhcPs
splice@(HsQuasiQuote {}) <- HsExpr GhcPs
expr = do
    EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> P (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
loc EpAnnComments
cs) (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD NoExtField
XSpliceD GhcPs
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsSplice GhcPs)
-> SpliceExplicitFlag
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsSplice p) -> SpliceExplicitFlag -> SpliceDecl p
SpliceDecl NoExtField
XSpliceDecl GhcPs
noExtField (SrcSpanAnnA
-> HsSplice GhcPs -> GenLocated SrcSpanAnnA (HsSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsSplice GhcPs
splice) SpliceExplicitFlag
ExplicitSplice)

  | Bool
otherwise = do
    EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> P (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
loc EpAnnComments
cs) (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD NoExtField
XSpliceD GhcPs
noExtField (XSpliceDecl GhcPs
-> XRec GhcPs (HsSplice GhcPs)
-> SpliceExplicitFlag
-> SpliceDecl GhcPs
forall p.
XSpliceDecl p
-> XRec p (HsSplice p) -> SpliceExplicitFlag -> SpliceDecl p
SpliceDecl NoExtField
XSpliceDecl GhcPs
noExtField
                                 (SrcSpanAnnA
-> HsSplice GhcPs -> GenLocated SrcSpanAnnA (HsSplice GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (EpAnn [AddEpAnn]
-> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn SpliceDecoration
BareSplice LHsExpr GhcPs
lexpr))
                                       SpliceExplicitFlag
ImplicitSplice)

mkRoleAnnotDecl :: SrcSpan
                -> LocatedN RdrName                -- type being annotated
                -> [Located (Maybe FastString)]    -- roles
                -> [AddEpAnn]
                -> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> [Located (Maybe FastString)]
-> [AddEpAnn]
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl SrcSpan
loc GenLocated SrcSpanAnnN RdrName
tycon [Located (Maybe FastString)]
roles [AddEpAnn]
anns
  = do { [GenLocated SrcSpan (Maybe Role)]
roles' <- (Located (Maybe FastString) -> P (GenLocated SrcSpan (Maybe Role)))
-> [Located (Maybe FastString)]
-> P [GenLocated SrcSpan (Maybe Role)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (Maybe FastString) -> P (GenLocated SrcSpan (Maybe Role))
parse_role [Located (Maybe FastString)]
roles
       ; EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
       ; GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
 -> P (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)))
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> RoleAnnotDecl GhcPs
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc)
         (RoleAnnotDecl GhcPs
 -> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
-> RoleAnnotDecl GhcPs
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XCRoleAnnotDecl GhcPs
-> LIdP GhcPs -> [XRec GhcPs (Maybe Role)] -> RoleAnnotDecl GhcPs
forall pass.
XCRoleAnnotDecl pass
-> LIdP pass -> [XRec pass (Maybe Role)] -> RoleAnnotDecl pass
RoleAnnotDecl (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
anns EpAnnComments
cs) GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tycon [GenLocated SrcSpan (Maybe Role)]
[XRec GhcPs (Maybe Role)]
roles' }
  where
    role_data_type :: DataType
role_data_type = Role -> DataType
forall a. Data a => a -> DataType
dataTypeOf (Role
forall a. HasCallStack => a
undefined :: Role)
    all_roles :: [Role]
all_roles = (Constr -> Role) -> [Constr] -> [Role]
forall a b. (a -> b) -> [a] -> [b]
map Constr -> Role
forall a. Data a => Constr -> a
fromConstr ([Constr] -> [Role]) -> [Constr] -> [Role]
forall a b. (a -> b) -> a -> b
$ DataType -> [Constr]
dataTypeConstrs DataType
role_data_type
    possible_roles :: [(FastString, Role)]
possible_roles = [(Role -> FastString
fsFromRole Role
role, Role
role) | Role
role <- [Role]
all_roles]

    parse_role :: Located (Maybe FastString) -> P (GenLocated SrcSpan (Maybe Role))
parse_role (L SrcSpan
loc_role Maybe FastString
Nothing) = GenLocated SrcSpan (Maybe Role)
-> P (GenLocated SrcSpan (Maybe Role))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpan (Maybe Role)
 -> P (GenLocated SrcSpan (Maybe Role)))
-> GenLocated SrcSpan (Maybe Role)
-> P (GenLocated SrcSpan (Maybe Role))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Role -> GenLocated SrcSpan (Maybe Role)
forall l e. l -> e -> GenLocated l e
L 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 SrcSpan (Maybe Role)
-> P (GenLocated SrcSpan (Maybe Role))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpan (Maybe Role)
 -> P (GenLocated SrcSpan (Maybe Role)))
-> GenLocated SrcSpan (Maybe Role)
-> P (GenLocated SrcSpan (Maybe Role))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Role -> GenLocated SrcSpan (Maybe Role)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc_role (Maybe Role -> GenLocated SrcSpan (Maybe Role))
-> Maybe Role -> GenLocated SrcSpan (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 a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFst FastString -> String
unpackFS [(FastString, Role)]
possible_roles)
            in
            PsError -> P (GenLocated SrcSpan (Maybe Role))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P (GenLocated SrcSpan (Maybe Role)))
-> PsError -> P (GenLocated SrcSpan (Maybe Role))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (FastString -> [Role] -> PsErrorDesc
PsErrIllegalRoleName FastString
role [Role]
nearby) [] SrcSpan
loc_role

-- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to
-- binders without annotations. Only accepts specified variables, and errors if
-- any of the provided binders has an 'InferredSpec' annotation.
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)
mapM GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)
fromSpecTyVarBndr

-- | Converts 'LHsTyVarBndr' annotated with its 'Specificity' to one without
-- annotations. Only accepts specified variables, and errors if the provided
-- binder has an 'InferredSpec' annotation.
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 LIdP GhcPs
idp))     -> (Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
flag SrcSpanAnnA
loc)
                                          P ()
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
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 -> () -> LIdP GhcPs -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar GhcPs
xtv () LIdP GhcPs
idp)
  (L SrcSpanAnnA
loc (KindedTyVar XKindedTyVar GhcPs
xtv Specificity
flag LIdP 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
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
-> () -> LIdP GhcPs -> LHsType GhcPs -> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar GhcPs
xtv () LIdP GhcPs
idp LHsType GhcPs
k)
  where
    check_spec :: Specificity -> SrcSpanAnnA -> P ()
    check_spec :: Specificity -> SrcSpanAnnA -> P ()
check_spec Specificity
SpecifiedSpec SrcSpanAnnA
_   = () -> P ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    check_spec Specificity
InferredSpec  SrcSpanAnnA
loc = PsError -> P ()
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrInferredTypeVarNotAllowed [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)

-- | Add the annotation for a 'where' keyword to existing @HsLocalBinds@
annBinds :: AddEpAnn -> HsLocalBinds GhcPs -> HsLocalBinds GhcPs
annBinds :: AddEpAnn -> HsLocalBinds GhcPs -> HsLocalBinds GhcPs
annBinds AddEpAnn
a (HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
bs)  = (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds (AddEpAnn -> EpAnn AnnList -> EpAnn AnnList
add_where AddEpAnn
a EpAnn AnnList
XHsValBinds GhcPs GhcPs
an) HsValBindsLR GhcPs GhcPs
bs)
annBinds AddEpAnn
a (HsIPBinds XHsIPBinds GhcPs GhcPs
an HsIPBinds GhcPs
bs)   = (XHsIPBinds GhcPs GhcPs -> HsIPBinds GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds (AddEpAnn -> EpAnn AnnList -> EpAnn AnnList
add_where AddEpAnn
a EpAnn AnnList
XHsIPBinds GhcPs GhcPs
an) HsIPBinds GhcPs
bs)
annBinds AddEpAnn
_ (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
x) = (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
x)

add_where :: AddEpAnn -> EpAnn AnnList -> EpAnn AnnList
add_where :: AddEpAnn -> EpAnn AnnList -> EpAnn AnnList
add_where an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
_ (EpaSpan RealSrcSpan
rs)) (EpAnn Anchor
a (AnnList Maybe Anchor
anc Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
  | RealSrcSpan -> Bool
valid_anchor (Anchor -> RealSrcSpan
anchor Anchor
a)
  = Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (Anchor -> [AddEpAnn] -> Anchor
widenAnchor Anchor
a [AddEpAnn
an]) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
anc Maybe AddEpAnn
o Maybe AddEpAnn
c (AddEpAnn
anAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
r) [TrailingAnn]
t) EpAnnComments
cs
  | Bool
otherwise
  = Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> Anchor -> Anchor
patch_anchor RealSrcSpan
rs Anchor
a) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList ((Anchor -> Anchor) -> Maybe Anchor -> Maybe Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcSpan -> Anchor -> Anchor
patch_anchor RealSrcSpan
rs) Maybe Anchor
anc) Maybe AddEpAnn
o Maybe AddEpAnn
c (AddEpAnn
anAddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
r) [TrailingAnn]
t) EpAnnComments
cs
add_where an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
_ (EpaSpan RealSrcSpan
rs)) EpAnn AnnList
EpAnnNotUsed
  = Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
rs AnchorOperation
UnchangedAnchor)
           (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (Anchor -> Maybe Anchor) -> Anchor -> Maybe Anchor
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
rs AnchorOperation
UnchangedAnchor) Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [AddEpAnn
an] []) EpAnnComments
emptyComments
add_where (AddEpAnn AnnKeywordId
_ (EpaDelta DeltaPos
_)) EpAnn AnnList
_ = String -> EpAnn AnnList
forall a. String -> a
panic String
"add_where"
 -- EpaDelta should only be used for transformations

valid_anchor :: RealSrcSpan -> Bool
valid_anchor :: RealSrcSpan -> Bool
valid_anchor RealSrcSpan
r = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0

-- If the decl list for where binds is empty, the anchor ends up
-- invalid. In this case, use the parent one
patch_anchor :: RealSrcSpan -> Anchor -> Anchor
patch_anchor :: RealSrcSpan -> Anchor -> Anchor
patch_anchor RealSrcSpan
r1 (Anchor RealSrcSpan
r0 AnchorOperation
op) = RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
r AnchorOperation
op
  where
    r :: RealSrcSpan
r = if RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then RealSrcSpan
r1 else RealSrcSpan
r0

{- **********************************************************************

  #cvBinds-etc# Converting to @HsBinds@, etc.

  ********************************************************************* -}

-- | Function definitions are restructured here. Each is assumed to be recursive
-- initially, and non recursive definitions are discovered by the dependency
-- analyser.


--  | Groups together bindings for a single function
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 (GenLocated SrcSpanAnnA (HsDecl GhcPs))
OrdList (LHsDecl GhcPs)
decls)

-- Declaration list may only contain value bindings and signatures.
cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)
cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBindsLR GhcPs GhcPs)
cvBindGroup OrdList (LHsDecl GhcPs)
binding
  = do { (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
mbs, [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs, [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fam_ds, [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
tfam_insts
         , [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
dfam_insts, [GenLocated SrcSpanAnnA DocDecl]
_) <- OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
      [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
binding
       ; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)
         HsValBindsLR GhcPs GhcPs -> P (HsValBindsLR GhcPs GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsValBindsLR GhcPs GhcPs -> P (HsValBindsLR GhcPs GhcPs))
-> HsValBindsLR GhcPs GhcPs -> P (HsValBindsLR GhcPs GhcPs)
forall a b. (a -> b) -> a -> b
$ XValBinds GhcPs GhcPs
-> LHsBinds GhcPs -> [LSig GhcPs] -> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds AnnSortKey
XValBinds GhcPs GhcPs
NoAnnSortKey Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
LHsBinds GhcPs
mbs [GenLocated SrcSpanAnnA (Sig GhcPs)]
[LSig GhcPs]
sigs }

cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
  -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]
          , [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
-- Input decls contain just value bindings and signatures
-- and in case of class or instance declarations also
-- associated type declarations. They might also contain Haddock comments.
cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
      [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
cvBindsAndSigs OrdList (LHsDecl GhcPs)
fb = do
  [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
fb' <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> P [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *} {a}.
MonadP m =>
[GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
drop_bad_decls (OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. OrdList a -> [a]
fromOL OrdList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
OrdList (LHsDecl GhcPs)
fb)
  (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
 [GenLocated SrcSpanAnnA (Sig GhcPs)],
 [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
 [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
 [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)],
 [GenLocated SrcSpanAnnA DocDecl])
-> P (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
      [GenLocated SrcSpanAnnA (Sig GhcPs)],
      [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
      [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
      [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)],
      [GenLocated SrcSpanAnnA DocDecl])
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs]
-> (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
    [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
partitionBindsAndSigs ([LHsDecl GhcPs] -> [LHsDecl GhcPs]
getMonoBindAll [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
fb'))
  where
    -- cvBindsAndSigs is called in several places in the parser,
    -- and its items can be produced by various productions:
    --
    --    * decl       (when parsing a where clause or a let-expression)
    --    * decl_inst  (when parsing an instance declaration)
    --    * decl_cls   (when parsing a class declaration)
    --
    -- partitionBindsAndSigs can handle almost all declaration forms produced
    -- by the aforementioned productions, except for SpliceD, which we filter
    -- out here (in drop_bad_decls).
    --
    -- We're not concerned with every declaration form possible, such as those
    -- produced by the topdecl parser production, because cvBindsAndSigs is not
    -- called on top-level declarations.
    drop_bad_decls :: [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
drop_bad_decls [] = [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    drop_bad_decls (L SrcSpanAnn' a
l (SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
d) : [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
ds) = do
      PsError -> m ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> m ()) -> PsError -> m ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (SpliceDecl GhcPs -> PsErrorDesc
PsErrDeclSpliceNotAtTopLevel SpliceDecl GhcPs
d) [] (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
l)
      [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
drop_bad_decls [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
ds
    drop_bad_decls (GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)
d:[GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
ds) = (GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)
dGenLocated (SrcSpanAnn' a) (HsDecl GhcPs)
-> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:) ([GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
 -> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)])
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
-> m [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
drop_bad_decls [GenLocated (SrcSpanAnn' a) (HsDecl GhcPs)]
ds

-----------------------------------------------------------------------------
-- Group function bindings into equation groups

getMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
  -> (LHsBind GhcPs, [LHsDecl GhcPs])
-- Suppose      (b',ds') = getMonoBind b ds
--      ds is a list of parsed bindings
--      b is a MonoBinds that has just been read off the front

-- Then b' is the result of grouping more equations from ds that
-- belong with b into a single MonoBinds, and ds' is the depleted
-- list of parsed bindings.
--
-- All Haddock comments between equations inside the group are
-- discarded.
--
-- No AndMonoBinds or EmptyMonoBinds here; just single equations

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 :: LIdP 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 [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
m1
  = [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnA
forall ann. SrcAnn ann -> SrcAnn ann
removeCommentsA SrcSpanAnnA
loc1) Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mtchs1] (SrcSpanAnnA -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> SrcAnn ann
commentsOnlyA SrcSpanAnnA
loc1) [LHsDecl GhcPs]
binds []
  where
    go :: [LMatch GhcPs (LHsExpr GhcPs)] -> SrcSpanAnnA
       -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
       -> (LHsBind GhcPs,[LHsDecl GhcPs]) -- AZ
    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]
: [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
mtchs)
                        (SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
combineSrcSpansA SrcSpanAnnA
loc SrcSpanAnnA
loc2') [LHsDecl GhcPs]
binds []
    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' = GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
doc_decl GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
doc_decls
          in [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanAnnA
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
-> (LHsBind GhcPs, [LHsDecl GhcPs])
go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs (SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
combineSrcSpansA SrcSpanAnnA
loc SrcSpanAnnA
loc2) [LHsDecl GhcPs]
binds [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
doc_decls'
    go [LMatch GhcPs (LHsExpr GhcPs)]
mtchs SrcSpanAnnA
loc [LHsDecl GhcPs]
binds [LHsDecl GhcPs]
doc_decls
        = ( SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (GenLocated SrcSpanAnnN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
fun_id1 ([GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a e2 an.
Semigroup a =>
[GenLocated (SrcAnn a) e2]
-> LocatedAn an [GenLocated (SrcAnn a) e2]
mkLocatedList ([GenLocated
    SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> GenLocated
      SrcSpanAnnL
      [GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (LHsExpr GhcPs)]
mtchs))
          , ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
doc_decls) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
binds)
        -- Reverse the final matches, to get it back in the right order
        -- Do the same thing with the trailing doc comments

getMonoBind LHsBind GhcPs
bind [LHsDecl GhcPs]
binds = (LHsBind GhcPs
bind, [LHsDecl GhcPs]
binds)

-- Group together adjacent FunBinds for every function.
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 NoExtField
XValD GhcPs
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) = GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl 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. 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
args)
        -- Don't group together FunBinds if they have
        -- no arguments.  This is necessary now that variable bindings
        -- with no arguments are now treated as FunBinds rather
        -- than pattern bindings (tests/rename/should_fail/rnfail002).

{- **********************************************************************

  #PrefixToHS-utils# Utilities for conversion

  ********************************************************************* -}

{- Note [Parsing data constructors is hard]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

The problem with parsing data constructors is that they look a lot like types.
Compare:

  (s1)   data T = C t1 t2
  (s2)   type T = C t1 t2

Syntactically, there's little difference between these declarations, except in
(s1) 'C' is a data constructor, but in (s2) 'C' is a type constructor.

This similarity would pose no problem if we knew ahead of time if we are
parsing a type or a constructor declaration. Looking at (s1) and (s2), a simple
(but wrong!) rule comes to mind: in 'data' declarations assume we are parsing
data constructors, and in other contexts (e.g. 'type' declarations) assume we
are parsing type constructors.

This simple rule does not work because of two problematic cases:

  (p1)   data T = C t1 t2 :+ t3
  (p2)   data T = C t1 t2 => t3

In (p1) we encounter (:+) and it turns out we are parsing an infix data
declaration, so (C t1 t2) is a type and 'C' is a type constructor.
In (p2) we encounter (=>) and it turns out we are parsing an existential
context, so (C t1 t2) is a constraint and 'C' is a type constructor.

As the result, in order to determine whether (C t1 t2) declares a data
constructor, a type, or a context, we would need unlimited lookahead which
'happy' is not so happy with.
-}

-- | Reinterpret a type constructor, including type operators, as a data
--   constructor.
-- See Note [Parsing data constructors is hard]
tyConToDataCon :: LocatedN RdrName -> Either PsError (LocatedN RdrName)
tyConToDataCon :: GenLocated SrcSpanAnnN RdrName
-> Either PsError (GenLocated SrcSpanAnnN RdrName)
tyConToDataCon (L SrcSpanAnnN
loc RdrName
tc)
  | OccName -> Bool
isTcOcc OccName
occ Bool -> Bool -> Bool
|| OccName -> Bool
isDataOcc OccName
occ
  , FastString -> Bool
isLexCon (OccName -> FastString
occNameFS OccName
occ)
  = GenLocated SrcSpanAnnN RdrName
-> Either PsError (GenLocated SrcSpanAnnN RdrName)
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
  = PsError -> Either PsError (GenLocated SrcSpanAnnN RdrName)
forall a b. a -> Either a b
Left (PsError -> Either PsError (GenLocated SrcSpanAnnN RdrName))
-> PsError -> Either PsError (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (RdrName -> PsErrorDesc
PsErrNotADataCon RdrName
tc) [] (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc)
  where
    occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
tc

mkPatSynMatchGroup :: LocatedN RdrName
                   -> LocatedL (OrdList (LHsDecl GhcPs))
                   -> P (MatchGroup GhcPs (LHsExpr GhcPs))
mkPatSynMatchGroup :: GenLocated SrcSpanAnnN RdrName
-> LocatedL (OrdList (LHsDecl GhcPs))
-> P (MatchGroup GhcPs (LHsExpr GhcPs))
mkPatSynMatchGroup (L SrcSpanAnnN
loc RdrName
patsyn_name) (L SrcSpanAnnL
ld OrdList (LHsDecl GhcPs)
decls) =
    do { [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches <- (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> P (GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> P [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
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 (GenLocated SrcSpanAnnA (HsDecl GhcPs))
OrdList (LHsDecl GhcPs)
decls)
       ; Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches) (SrcSpan -> P ()
wrongNumberErr (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc))
       ; MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> P (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ Origin
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
FromSource (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
ld [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches) }
  where
    fromDecl :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> P (GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
fromDecl (L SrcSpanAnnA
loc decl :: HsDecl GhcPs
decl@(ValD XValD GhcPs
_ (PatBind XPatBind GhcPs GhcPs
_
                                 -- AZ: where should these anns come from?
                         pat :: LPat GhcPs
pat@(L SrcSpanAnnA
_ (ConPat XConPat GhcPs
noAnn ln :: XRec GhcPs (ConLikeP GhcPs)
ln@(L SrcSpanAnnN
_ RdrName
name) HsConPatDetails GhcPs
details))
                               GRHSs GhcPs (LHsExpr GhcPs)
rhs ([CoreTickish], [[CoreTickish]])
_))) =
        do { Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RdrName
name RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
patsyn_name) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
               SrcSpan -> HsDecl GhcPs -> P ()
wrongNameBindingErr (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) HsDecl GhcPs
decl
           ; Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
match <- case HsConPatDetails GhcPs
details of
               PrefixCon [HsPatSigType (NoGhcTc GhcPs)]
_ [LPat GhcPs]
pats -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
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 = XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
XConPat GhcPs
noAnn
                                                  , m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ctxt = HsMatchContext (NoGhcTc GhcPs)
HsMatchContext GhcPs
ctxt, m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs]
pats
                                                  , m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (LHsExpr GhcPs)
rhs }
                   where
                     ctxt :: HsMatchContext GhcPs
ctxt = FunRhs { mc_fun :: LIdP GhcPs
mc_fun = LIdP GhcPs
XRec GhcPs (ConLikeP GhcPs)
ln
                                   , mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Prefix
                                   , mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
NoSrcStrict }

               InfixCon LPat GhcPs
p1 LPat GhcPs
p2 -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (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 = XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
XConPat GhcPs
noAnn
                                                , m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ctxt = HsMatchContext (NoGhcTc GhcPs)
HsMatchContext GhcPs
ctxt
                                                , m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs
p1, LPat GhcPs
p2]
                                                , m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (LHsExpr GhcPs)
rhs }
                   where
                     ctxt :: HsMatchContext GhcPs
ctxt = FunRhs { mc_fun :: LIdP GhcPs
mc_fun = LIdP GhcPs
XRec GhcPs (ConLikeP GhcPs)
ln
                                   , mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Infix
                                   , mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
NoSrcStrict }

               RecCon{} -> SrcSpan
-> LPat GhcPs
-> P (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. SrcSpan -> LPat GhcPs -> P a
recordPatSynErr (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) LPat GhcPs
pat
           ; GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> P (GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> P (GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> P (GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
match }
    fromDecl (L SrcSpanAnnA
loc HsDecl GhcPs
decl) = SrcSpan
-> HsDecl GhcPs
-> P (GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
extraDeclErr (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) HsDecl GhcPs
decl

    extraDeclErr :: SrcSpan
-> HsDecl GhcPs
-> P (GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
extraDeclErr SrcSpan
loc HsDecl GhcPs
decl =
        PsError
-> P (GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError
 -> P (GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> PsError
-> P (GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (RdrName -> HsDecl GhcPs -> PsErrorDesc
PsErrNoSingleWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl) [] SrcSpan
loc

    wrongNameBindingErr :: SrcSpan -> HsDecl GhcPs -> P ()
wrongNameBindingErr SrcSpan
loc HsDecl GhcPs
decl =
      PsError -> P ()
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (RdrName -> HsDecl GhcPs -> PsErrorDesc
PsErrInvalidWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl) [] SrcSpan
loc

    wrongNumberErr :: SrcSpan -> P ()
wrongNumberErr SrcSpan
loc =
      PsError -> P ()
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (RdrName -> PsErrorDesc
PsErrEmptyWhereInPatSynDecl RdrName
patsyn_name) [] SrcSpan
loc

recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a
recordPatSynErr :: forall a. SrcSpan -> LPat GhcPs -> P a
recordPatSynErr SrcSpan
loc LPat GhcPs
pat =
    PsError -> P a
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P a) -> PsError -> P a
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LPat GhcPs -> PsErrorDesc
PsErrRecordSyntaxInPatSynDecl LPat GhcPs
pat) [] SrcSpan
loc

mkConDeclH98 :: EpAnn [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
                -> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
                -> ConDecl GhcPs

mkConDeclH98 :: EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs)
-> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
name Maybe [LHsTyVarBndr Specificity GhcPs]
mb_forall Maybe (LHsContext GhcPs)
mb_cxt HsConDeclH98Details GhcPs
args
  = ConDeclH98 { con_ext :: XConDeclH98 GhcPs
con_ext    = EpAnn [AddEpAnn]
XConDeclH98 GhcPs
ann
               , con_name :: LIdP GhcPs
con_name   = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name
               , con_forall :: Bool
con_forall = Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> Bool
forall a. Maybe a -> Bool
isJust Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
Maybe [LHsTyVarBndr Specificity GhcPs]
mb_forall
               , con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs = Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
Maybe [LHsTyVarBndr 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 LHsDocString
con_doc    = Maybe LHsDocString
forall a. Maybe a
Nothing }

-- | Construct a GADT-style data constructor from the constructor names and
-- their type. Some interesting aspects of this function:
--
-- * This splits up the constructor type into its quantified type variables (if
--   provided), context (if provided), argument types, and result type, and
--   records whether this is a prefix or record GADT constructor. See
--   Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details.
mkGadtDecl :: SrcSpan
           -> [LocatedN RdrName]
           -> LHsSigType GhcPs
           -> [AddEpAnn]
           -> P (LConDecl GhcPs)
mkGadtDecl :: SrcSpan
-> [GenLocated SrcSpanAnnN RdrName]
-> LHsSigType GhcPs
-> [AddEpAnn]
-> P (LConDecl GhcPs)
mkGadtDecl SrcSpan
loc [GenLocated SrcSpanAnnN RdrName]
names LHsSigType GhcPs
ty [AddEpAnn]
annsIn = do
  EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
  let l :: SrcSpanAnnA
l = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc

  let (HsConDeclGADTDetails GhcPs
args, GenLocated SrcSpanAnnA (HsType GhcPs)
res_ty, [AddEpAnn]
annsa, EpAnnComments
csa)
        | L SrcSpanAnnA
ll (HsFunTy XFunTy GhcPs
af HsArrow GhcPs
_w (L SrcSpanAnnA
loc' (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
rf)) LHsType GhcPs
res_ty) <- LHsType GhcPs
body_ty
        = let
            an' :: EpAnn AnnList
an' = SrcSpan
-> TrailingAnn -> EpAnnComments -> EpAnn AnnList -> EpAnn AnnList
addTrailingAnnToL (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc') (EpAnn TrailingAnn -> TrailingAnn
forall ann. EpAnn ann -> ann
anns EpAnn TrailingAnn
XFunTy GhcPs
af) (EpAnn TrailingAnn -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments EpAnn TrailingAnn
XFunTy GhcPs
af) EpAnn AnnList
XRecTy GhcPs
an
          in ( XRec GhcPs [LConDeclField GhcPs] -> HsConDeclGADTDetails GhcPs
forall pass.
XRec pass [LConDeclField pass] -> HsConDeclGADTDetails pass
RecConGADT (SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnList -> SrcSpan -> SrcSpanAnnL
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnList
an' (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc')) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
[LConDeclField GhcPs]
rf), GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
res_ty
             , [], EpAnn AnnListItem -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
epAnnComments (SrcSpanAnnA -> EpAnn AnnListItem
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnA
ll))
        | Bool
otherwise
        = 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
          in ([HsScaled GhcPs (LHsType GhcPs)] -> HsConDeclGADTDetails GhcPs
forall pass.
[HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
arg_types, GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
res_type, [AddEpAnn]
anns, EpAnnComments
cs)

      an :: EpAnn [AddEpAnn]
an = case HsOuterSigTyVarBndrs GhcPs
outer_bndrs of
        HsOuterSigTyVarBndrs GhcPs
_                -> Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) ([AddEpAnn]
annsIn [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
annsa) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
csa)

  GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (ConDecl GhcPs)
 -> P (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> P (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> ConDecl GhcPs -> GenLocated SrcSpanAnnA (ConDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ConDeclGADT
                     { con_g_ext :: XConDeclGADT GhcPs
con_g_ext  = EpAnn [AddEpAnn]
XConDeclGADT GhcPs
an
                     , con_names :: [LIdP GhcPs]
con_names  = [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
names
                     , con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs  = SrcSpanAnnA
-> HsOuterSigTyVarBndrs GhcPs
-> GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
ty) HsOuterSigTyVarBndrs GhcPs
outer_bndrs
                     , con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt = Maybe (LHsContext GhcPs)
mcxt
                     , con_g_args :: HsConDeclGADTDetails GhcPs
con_g_args = HsConDeclGADTDetails GhcPs
args
                     , con_res_ty :: LHsType GhcPs
con_res_ty = GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
res_ty
                     , con_doc :: Maybe LHsDocString
con_doc    = Maybe LHsDocString
forall a. Maybe a
Nothing }
  where
    (HsOuterSigTyVarBndrs GhcPs
outer_bndrs, Maybe (LHsContext GhcPs)
mcxt, LHsType GhcPs
body_ty) = LHsSigType GhcPs
-> (HsOuterSigTyVarBndrs GhcPs, Maybe (LHsContext GhcPs),
    LHsType GhcPs)
splitLHsGadtTy LHsSigType GhcPs
ty

setRdrNameSpace :: RdrName -> NameSpace -> RdrName
-- ^ This rather gruesome function is used mainly by the parser.
-- When parsing:
--
-- > data T a = T | T1 Int
--
-- we parse the data constructors as /types/ because of parser ambiguities,
-- so then we need to change the /type constr/ to a /data constr/
--
-- The exact-name case /can/ occur when parsing:
--
-- > data [] a = [] | a : [a]
--
-- For the exact-name case we return an original name.
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
    -- Preserve Exact Names for wired-in things,
    -- notably tuples and lists

  | Name -> Bool
isExternalName Name
n
  = Module -> OccName -> RdrName
Orig (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
n) OccName
occ

  | Bool
otherwise   -- This can happen when quoting and then
                -- splicing a fixity declaration for a type
  = 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)      -- No-op

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)      -- No-op

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
<+> 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  -- See Note [setRdrNameSpace for wired-in names]
  = 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  -- See Note [setRdrNameSpace for wired-in names]
  = OccName -> RdrName
Unqual (NameSpace -> OccName -> OccName
setOccNameSpace NameSpace
tcClsName (DataCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName DataCon
dc))



{- Note [setRdrNameSpace for wired-in names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In GHC.Types, which declares (:), we have
  infixr 5 :
The ambiguity about which ":" is meant is resolved by parsing it as a
data constructor, but then using dataTcOccs to try the type constructor too;
and that in turn calls setRdrNameSpace to change the name-space of ":" to
tcClsName.  There isn't a corresponding ":" type constructor, but it's painful
to make setRdrNameSpace partial, so we just make an Unqual name instead. It
really doesn't matter!
-}

eitherToP :: MonadP m => Either PsError a -> m a
-- Adapts the Either monad to the P monad
eitherToP :: forall (m :: * -> *) a. MonadP m => Either PsError a -> m a
eitherToP (Left PsError
err)    = PsError -> m a
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError PsError
err
eitherToP (Right a
thing) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
thing

checkTyVars :: SDoc -> SDoc -> LocatedN RdrName -> [LHsTypeArg GhcPs]
            -> P ( LHsQTyVars GhcPs  -- the synthesized type variables
                 , [AddEpAnn] )      -- action which adds annotations
-- ^ Check whether the given list of type parameters are all type variables
-- (possibly with a kind signature).
checkTyVars :: SDoc
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> [LHsTypeArg GhcPs]
-> P (LHsQTyVars GhcPs, [AddEpAnn])
checkTyVars SDoc
pp_what SDoc
equals_or_where GenLocated SrcSpanAnnN RdrName
tc [LHsTypeArg GhcPs]
tparms
  = do { ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
tvs, [[AddEpAnn]]
anns) <- ([(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])]
 -> ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)], [[AddEpAnn]]))
-> P [(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])]
-> P ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)],
      [[AddEpAnn]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])]
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)], [[AddEpAnn]])
forall a b. [(a, b)] -> ([a], [b])
unzip (P [(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])]
 -> P ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)],
       [[AddEpAnn]]))
-> P [(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])]
-> P ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)],
      [[AddEpAnn]])
forall a b. (a -> b) -> a -> b
$ (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn]))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> P [(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
check [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparms
       ; (LHsQTyVars GhcPs, [AddEpAnn]) -> P (LHsQTyVars GhcPs, [AddEpAnn])
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsTyVarBndr () GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
[LHsTyVarBndr () GhcPs]
tvs, [[AddEpAnn]] -> [AddEpAnn]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AddEpAnn]]
anns) }
  where
    check :: HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
check (HsTypeArg SrcSpan
_ ki :: GenLocated SrcSpanAnnA (HsType GhcPs)
ki@(L SrcSpanAnnA
loc HsType GhcPs
_)) = PsError
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError
 -> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn]))
-> PsError
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsType GhcPs -> SDoc -> RdrName -> PsErrorDesc
PsErrUnexpectedTypeAppInDecl GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ki SDoc
pp_what (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tc)) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
    check (HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
ty) = [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs, [AddEpAnn])
chkParens [] EpAnnComments
emptyComments GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty
    check (HsArgPar SrcSpan
sp) = PsError
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError
 -> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn]))
-> PsError
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (SDoc -> RdrName -> PsErrorDesc
PsErrMalformedDecl SDoc
pp_what (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tc)) [] SrcSpan
sp
        -- Keep around an action for adjusting the annotations of extra parens
    chkParens :: [AddEpAnn] -> EpAnnComments -> LHsType GhcPs
              -> P (LHsTyVarBndr () GhcPs, [AddEpAnn])
    chkParens :: [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs, [AddEpAnn])
chkParens [AddEpAnn]
acc EpAnnComments
cs (L SrcSpanAnnA
l (HsParTy XParTy GhcPs
an LHsType GhcPs
ty))
      = [AddEpAnn]
-> EpAnnComments
-> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs, [AddEpAnn])
chkParens (SrcSpan -> [AddEpAnn]
mkParensEpAnn (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
acc) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnn AnnParen -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
epAnnComments EpAnn AnnParen
XParTy GhcPs
an) LHsType GhcPs
ty
    chkParens [AddEpAnn]
acc EpAnnComments
cs LHsType GhcPs
ty = do
      GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
tv <- [AddEpAnn]
-> EpAnnComments -> LHsType GhcPs -> P (LHsTyVarBndr () GhcPs)
chk [AddEpAnn]
acc EpAnnComments
cs LHsType GhcPs
ty
      (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs), [AddEpAnn])
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
tv, [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
acc)

        -- Check that the name space is correct!
    chk :: [AddEpAnn] -> EpAnnComments -> LHsType GhcPs -> P (LHsTyVarBndr () GhcPs)
    chk :: [AddEpAnn]
-> EpAnnComments -> LHsType GhcPs -> P (LHsTyVarBndr () GhcPs)
chk [AddEpAnn]
an EpAnnComments
cs (L SrcSpanAnnA
l (HsKindSig XKindSig GhcPs
annk (L SrcSpanAnnA
annt (HsTyVar XTyVar GhcPs
ann PromotionFlag
_ (L SrcSpanAnnN
lv RdrName
tv))) LHsType GhcPs
k))
        | RdrName -> Bool
isRdrTyVar RdrName
tv
            = GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> [AddEpAnn] -> SrcSpanAnnA
forall an. SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an
widenLocatedAn (SrcSpanAnnA
l SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => a -> a -> a
Semi.<> SrcSpanAnnA
annt) [AddEpAnn]
an)
                      (XKindedTyVar GhcPs
-> () -> LIdP GhcPs -> LHsType GhcPs -> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar (EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (EpAnn [AddEpAnn]
XKindSig GhcPs
annk EpAnn [AddEpAnn] -> EpAnn [AddEpAnn] -> EpAnn [AddEpAnn]
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnn [AddEpAnn]
XTyVar GhcPs
ann) [AddEpAnn]
an EpAnnComments
cs) () (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lv RdrName
tv) LHsType GhcPs
k))
    chk [AddEpAnn]
an EpAnnComments
cs (L SrcSpanAnnA
l (HsTyVar XTyVar GhcPs
ann PromotionFlag
_ (L SrcSpanAnnN
ltv RdrName
tv)))
        | RdrName -> Bool
isRdrTyVar RdrName
tv    = GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> P (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsTyVarBndr () GhcPs
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> [AddEpAnn] -> SrcSpanAnnA
forall an. SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an
widenLocatedAn SrcSpanAnnA
l [AddEpAnn]
an)
                                     (XUserTyVar GhcPs -> () -> LIdP GhcPs -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar (EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns EpAnn [AddEpAnn]
XTyVar GhcPs
ann [AddEpAnn]
an EpAnnComments
cs) () (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
ltv RdrName
tv)))
    chk [AddEpAnn]
_ EpAnnComments
_ t :: LHsType GhcPs
t@(L SrcSpanAnnA
loc HsType GhcPs
_)
        = PsError -> P (LHsTyVarBndr () GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P (LHsTyVarBndr () GhcPs))
-> PsError -> P (LHsTyVarBndr () GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsType GhcPs
-> SDoc -> RdrName -> [LHsTypeArg GhcPs] -> SDoc -> PsErrorDesc
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) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)


whereDots, equalsDots :: SDoc
-- Second argument to checkTyVars
whereDots :: SDoc
whereDots  = String -> SDoc
text String
"where ..."
equalsDots :: SDoc
equalsDots = String -> SDoc
text String
"= ..."

checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Maybe (LHsContext GhcPs)
Nothing = () -> P ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkDatatypeContext (Just LHsContext GhcPs
c)
    = do Bool
allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
DatatypeContextsBit
         Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowed (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ PsError -> P ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsContext GhcPs -> PsErrorDesc
PsErrIllegalDataTypeContext LHsContext GhcPs
c) [] (GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
c)

type LRuleTyTmVar = Located RuleTyTmVar
data RuleTyTmVar = RuleTyTmVar (EpAnn [AddEpAnn]) (LocatedN RdrName) (Maybe (LHsType GhcPs))
-- ^ Essentially a wrapper for a @RuleBndr GhcPs@

-- turns RuleTyTmVars into RuleBnrs - this is straightforward
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs = (LRuleTyTmVar -> GenLocated SrcSpan (RuleBndr GhcPs))
-> [LRuleTyTmVar] -> [GenLocated SrcSpan (RuleBndr GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RuleTyTmVar -> RuleBndr GhcPs)
-> LRuleTyTmVar -> GenLocated SrcSpan (RuleBndr GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleTyTmVar -> RuleBndr GhcPs
cvt_one)
  where cvt_one :: RuleTyTmVar -> RuleBndr GhcPs
cvt_one (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v Maybe (LHsType GhcPs)
Nothing) = XCRuleBndr GhcPs -> LIdP GhcPs -> RuleBndr GhcPs
forall pass. XCRuleBndr pass -> LIdP pass -> RuleBndr pass
RuleBndr EpAnn [AddEpAnn]
XCRuleBndr GhcPs
ann GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v
        cvt_one (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v (Just LHsType GhcPs
sig)) =
          XRuleBndrSig GhcPs
-> LIdP GhcPs -> HsPatSigType GhcPs -> RuleBndr GhcPs
forall pass.
XRuleBndrSig pass
-> LIdP pass -> HsPatSigType pass -> RuleBndr pass
RuleBndrSig EpAnn [AddEpAnn]
XRuleBndrSig GhcPs
ann GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v (EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnn EpaLocation
forall a. EpAnn a
noAnn LHsType GhcPs
sig)

-- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs]
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs]
mkRuleTyVarBndrs = (LRuleTyTmVar -> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
-> [LRuleTyTmVar]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LRuleTyTmVar -> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall {ann}.
LRuleTyTmVar -> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
cvt_one
  where cvt_one :: LRuleTyTmVar -> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
cvt_one (L SrcSpan
l (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v Maybe (LHsType GhcPs)
Nothing))
          = SrcAnn ann
-> HsTyVarBndr () GhcPs
-> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XUserTyVar GhcPs -> () -> LIdP GhcPs -> HsTyVarBndr () GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar EpAnn [AddEpAnn]
XUserTyVar GhcPs
ann () ((RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
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 SrcSpan
l (RuleTyTmVar EpAnn [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
v (Just LHsType GhcPs
sig)))
          = SrcAnn ann
-> HsTyVarBndr () GhcPs
-> GenLocated (SrcAnn ann) (HsTyVarBndr () GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XKindedTyVar GhcPs
-> () -> LIdP GhcPs -> LHsType GhcPs -> HsTyVarBndr () GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar EpAnn [AddEpAnn]
XKindedTyVar GhcPs
ann () ((RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
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)
    -- takes something in namespace 'varName' to something in namespace 'tvName'
        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. String -> a
panic String
"mkRuleTyVarBndrs"

-- See note [Parsing explicit foralls in Rules] in Parser.y
checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P ()
checkRuleTyVarBndrNames :: forall flag. [LHsTyVarBndr flag GhcPs] -> P ()
checkRuleTyVarBndrNames = (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs) -> P ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)] -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GenLocated SrcSpanAnnA RdrName -> P ()
forall {f :: * -> *} {a}.
MonadP f =>
GenLocated (SrcSpanAnn' a) RdrName -> f ()
check (GenLocated SrcSpanAnnA RdrName -> P ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
    -> GenLocated SrcSpanAnnA RdrName)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr flag GhcPs -> RdrName)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnA RdrName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr flag GhcPs -> RdrName
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName)
  where check :: GenLocated (SrcSpanAnn' a) RdrName -> f ()
check (L SrcSpanAnn' a
loc (Unqual OccName
occ)) =
          -- TODO: don't use string here, OccName has a Unique/FastString
          Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((OccName -> String
occNameString OccName
occ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` [String
"forall",String
"family",String
"role"])
            (PsError -> f ()
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> f ()) -> PsError -> f ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (OccName -> PsErrorDesc
PsErrParseErrorOnInput OccName
occ) [] (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc))
        check GenLocated (SrcSpanAnn' a) RdrName
_ = String -> f ()
forall a. String -> a
panic String
"checkRuleTyVarBndrNames"

checkRecordSyntax :: (MonadP m, Outputable a) => LocatedA a -> m (LocatedA a)
checkRecordSyntax :: forall (m :: * -> *) a.
(MonadP m, Outputable a) =>
LocatedA a -> m (LocatedA a)
checkRecordSyntax lr :: LocatedA a
lr@(L SrcSpanAnnA
loc a
r)
    = do Bool
allowed <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
TraditionalRecordSyntaxBit
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PsError -> m ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> m ()) -> PsError -> m ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (SDoc -> PsErrorDesc
PsErrIllegalTraditionalRecordSyntax (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
r)) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
         LocatedA a -> m (LocatedA a)
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA a
lr

-- | Check if the gadt_constrlist is empty. Only raise parse error for
-- `data T where` to avoid affecting existing error message, see #8258.
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]
_, []))           -- Empty GADT declaration.
    = do Bool
gadtSyntax <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
GadtSyntaxBit   -- GADTs implies GADTSyntax
         Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
gadtSyntax (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ PsError -> P ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrIllegalWhereInDataDecl [] SrcSpan
span
         Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
-> P (Located
        ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)]))
forall (m :: * -> *) a. Monad m => a -> m a
return Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
Located ([AddEpAnn], [LConDecl GhcPs])
gadts
checkEmptyGADTs Located ([AddEpAnn], [LConDecl GhcPs])
gadts = Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
-> P (Located
        ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)]))
forall (m :: * -> *) a. Monad m => a -> m a
return Located ([AddEpAnn], [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
Located ([AddEpAnn], [LConDecl GhcPs])
gadts              -- Ordinary GADT declaration.

checkTyClHdr :: Bool               -- True  <=> class header
                                   -- False <=> type header
             -> LHsType GhcPs
             -> P (LocatedN RdrName,     -- the head symbol (type or class name)
                   [LHsTypeArg GhcPs],   -- parameters of head symbol
                   LexicalFixity,        -- the declaration is in infix format
                   [AddEpAnn])           -- API Annotation for HsParTy
                                         -- when stripping parens
-- Well-formedness check and decomposition of type and class heads.
-- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])
--              Int :*: Bool   into    (:*:, [Int, Bool])
-- returning the pieces
checkTyClHdr :: Bool
-> LHsType GhcPs
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
checkTyClHdr Bool
is_cls LHsType GhcPs
ty
  = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [LHsTypeArg GhcPs]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
goL GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty [] [] LexicalFixity
Prefix
  where
    goL :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> [LHsTypeArg GhcPs]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
goL (L SrcSpanAnnA
l HsType GhcPs
ty) [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann LexicalFixity
fix = SrcSpan
-> HsType GhcPs
-> [LHsTypeArg GhcPs]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
go (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) HsType GhcPs
ty [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann LexicalFixity
fix

    -- workaround to define '*' despite StarIsType
    go :: SrcSpan
-> HsType GhcPs
-> [LHsTypeArg GhcPs]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
go SrcSpan
_ (HsParTy XParTy GhcPs
an (L SrcSpanAnnA
l (HsStarTy XStarTy GhcPs
_ Bool
isUni))) [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann' LexicalFixity
fix
      = do { WarningFlag -> PsWarning -> P ()
forall (m :: * -> *). MonadP m => WarningFlag -> PsWarning -> m ()
addWarning WarningFlag
Opt_WarnStarBinder (SrcSpan -> PsWarning
PsWarnStarBinder (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l))
           ; let name :: OccName
name = NameSpace -> String -> OccName
mkOccName NameSpace
tcClsName (Bool -> String
starSym Bool
isUni)
           ; let a' :: SrcSpanAnnN
a' = SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN
newAnns SrcSpanAnnA
l EpAnn AnnParen
XParTy GhcPs
an
           ; (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
 [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
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), [LHsTypeArg GhcPs]
acc, LexicalFixity
fix
                    , [AddEpAnn]
ann') }

    go SrcSpan
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ ltc :: LIdP GhcPs
ltc@(L SrcSpanAnnN
_ RdrName
tc)) [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann LexicalFixity
fix
      | RdrName -> Bool
isRdrTc RdrName
tc               = (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
 [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
ltc, [LHsTypeArg GhcPs]
acc, LexicalFixity
fix, [AddEpAnn]
ann)
    go SrcSpan
_ (HsOpTy XOpTy GhcPs
_ LHsType GhcPs
t1 ltc :: LIdP GhcPs
ltc@(L SrcSpanAnnN
_ RdrName
tc) LHsType GhcPs
t2) [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann LexicalFixity
_fix
      | RdrName -> Bool
isRdrTc RdrName
tc               = (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
 [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
ltc, LHsType GhcPs -> LHsTypeArg GhcPs
forall tm ty. tm -> HsArg tm ty
HsValArg LHsType GhcPs
t1LHsTypeArg GhcPs -> [LHsTypeArg GhcPs] -> [LHsTypeArg GhcPs]
forall a. a -> [a] -> [a]
:LHsType GhcPs -> LHsTypeArg GhcPs
forall tm ty. tm -> HsArg tm ty
HsValArg LHsType GhcPs
t2LHsTypeArg GhcPs -> [LHsTypeArg GhcPs] -> [LHsTypeArg GhcPs]
forall a. a -> [a] -> [a]
:[LHsTypeArg GhcPs]
acc, LexicalFixity
Infix, [AddEpAnn]
ann)
    go SrcSpan
l (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)    [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [LHsTypeArg GhcPs]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
goL GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty [LHsTypeArg GhcPs]
acc ([AddEpAnn]
ann [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++SrcSpan -> [AddEpAnn]
mkParensEpAnn SrcSpan
l) LexicalFixity
fix
    go SrcSpan
_ (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
t1 LHsType GhcPs
t2) [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [LHsTypeArg GhcPs]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
goL GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t1 (LHsType GhcPs -> LHsTypeArg GhcPs
forall tm ty. tm -> HsArg tm ty
HsValArg LHsType GhcPs
t2LHsTypeArg GhcPs -> [LHsTypeArg GhcPs] -> [LHsTypeArg GhcPs]
forall a. a -> [a] -> [a]
:[LHsTypeArg GhcPs]
acc) [AddEpAnn]
ann LexicalFixity
fix
    go SrcSpan
_ (HsAppKindTy XAppKindTy GhcPs
l LHsType GhcPs
ty LHsType GhcPs
ki) [LHsTypeArg GhcPs]
acc [AddEpAnn]
ann LexicalFixity
fix = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [LHsTypeArg GhcPs]
-> [AddEpAnn]
-> LexicalFixity
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
goL GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty (SrcSpan -> LHsType GhcPs -> LHsTypeArg GhcPs
forall tm ty. SrcSpan -> ty -> HsArg tm ty
HsTypeArg SrcSpan
XAppKindTy GhcPs
l LHsType GhcPs
kiLHsTypeArg GhcPs -> [LHsTypeArg GhcPs] -> [LHsTypeArg GhcPs]
forall a. a -> [a] -> [a]
:[LHsTypeArg GhcPs]
acc) [AddEpAnn]
ann LexicalFixity
fix
    go SrcSpan
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts) [] [AddEpAnn]
ann LexicalFixity
fix
      = (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs], LexicalFixity,
 [AddEpAnn])
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Name -> RdrName
nameRdrName Name
tup_name)
               , (LHsType GhcPs -> LHsTypeArg GhcPs)
-> [LHsType GhcPs] -> [LHsTypeArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LHsType GhcPs -> LHsTypeArg GhcPs
forall tm ty. tm -> HsArg tm ty
HsValArg [LHsType GhcPs]
ts, LexicalFixity
fix, [AddEpAnn]
ann)
      where
        arity :: Int
arity = [LHsType GhcPs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsType 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)
          -- See Note [Unit tuples] in GHC.Hs.Type  (TODO: is this still relevant?)
    go SrcSpan
l HsType GhcPs
_ [LHsTypeArg GhcPs]
_ [AddEpAnn]
_ LexicalFixity
_
      = PsError
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError
 -> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
       LexicalFixity, [AddEpAnn]))
-> PsError
-> P (GenLocated SrcSpanAnnN RdrName, [LHsTypeArg GhcPs],
      LexicalFixity, [AddEpAnn])
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsType GhcPs -> PsErrorDesc
PsErrMalformedTyOrClDecl LHsType GhcPs
ty) [] SrcSpan
l

    -- Combine the annotations from the HsParTy and HsStarTy into a
    -- new one for the LocatedN RdrName
    newAnns :: SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN
    newAnns :: SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN
newAnns (SrcSpanAnn EpAnn AnnListItem
EpAnnNotUsed SrcSpan
l) (EpAnn Anchor
as (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) EpAnnComments
cs) =
      let
        lr :: RealSrcSpan
lr = RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (Anchor -> RealSrcSpan
anchor Anchor
as)
        -- lr = widenAnchorR as (realSrcSpan l)
        an :: EpAnn NameAnn
an = (Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
lr AnchorOperation
UnchangedAnchor) (NameAdornment
-> EpaLocation
-> EpaLocation
-> EpaLocation
-> [TrailingAnn]
-> NameAnn
NameAnn NameAdornment
NameParens EpaLocation
o (RealSrcSpan -> EpaLocation
EpaSpan (RealSrcSpan -> EpaLocation) -> RealSrcSpan -> EpaLocation
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) EpaLocation
c []) EpAnnComments
cs)
      in EpAnn NameAnn -> SrcSpan -> SrcSpanAnnN
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NameAnn
an (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
lr Maybe BufSpan
forall a. Maybe a
Nothing)
    newAnns SrcSpanAnnA
_ EpAnn AnnParen
EpAnnNotUsed = String -> SrcSpanAnnN
forall a. String -> a
panic String
"missing AnnParen"
    newAnns (SrcSpanAnn (EpAnn Anchor
ap (AnnListItem [TrailingAnn]
ta) EpAnnComments
csp) SrcSpan
l) (EpAnn Anchor
as (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) EpAnnComments
cs) =
      let
        lr :: RealSrcSpan
lr = RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans (Anchor -> RealSrcSpan
anchor Anchor
ap) (Anchor -> RealSrcSpan
anchor Anchor
as)
        an :: EpAnn NameAnn
an = (Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
lr AnchorOperation
UnchangedAnchor) (NameAdornment
-> EpaLocation
-> EpaLocation
-> EpaLocation
-> [TrailingAnn]
-> NameAnn
NameAnn NameAdornment
NameParens EpaLocation
o (RealSrcSpan -> EpaLocation
EpaSpan (RealSrcSpan -> EpaLocation) -> RealSrcSpan -> EpaLocation
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) EpaLocation
c [TrailingAnn]
ta) (EpAnnComments
csp EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs))
      in EpAnn NameAnn -> SrcSpan -> SrcSpanAnnN
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NameAnn
an (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
lr Maybe BufSpan
forall a. Maybe a
Nothing)

-- | Yield a parse error if we have a function applied directly to a do block
-- etc. and BlockArguments is not enabled.
checkExpBlockArguments :: LHsExpr GhcPs -> PV ()
checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
(GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
LHsExpr GhcPs -> PV ()
checkExpBlockArguments, GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
LHsCmd GhcPs -> PV ()
checkCmdBlockArguments) = (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
LHsExpr GhcPs -> PV ()
checkExpr, GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
LHsCmd 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 GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr of
      HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
_  -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check (Maybe ModuleName -> LHsExpr GhcPs -> PsErrorDesc
PsErrDoInFunAppExpr Maybe ModuleName
m)     GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
_ -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check (Maybe ModuleName -> LHsExpr GhcPs -> PsErrorDesc
PsErrMDoInFunAppExpr Maybe ModuleName
m)    GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsLam {}             -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc
LHsExpr GhcPs -> PsErrorDesc
PsErrLambdaInFunAppExpr     GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsCase {}            -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc
LHsExpr GhcPs -> PsErrorDesc
PsErrCaseInFunAppExpr       GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsLamCase {}         -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc
LHsExpr GhcPs -> PsErrorDesc
PsErrLambdaCaseInFunAppExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsLet {}             -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc
LHsExpr GhcPs -> PsErrorDesc
PsErrLetInFunAppExpr        GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsIf {}              -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc
LHsExpr GhcPs -> PsErrorDesc
PsErrIfInFunAppExpr         GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsProc {}            -> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PsErrorDesc
LHsExpr GhcPs -> PsErrorDesc
PsErrProcInFunAppExpr       GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
      HsExpr GhcPs
_                    -> () -> PV ()
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 GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
cmd of
      HsCmdLam {}  -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc
LHsCmd GhcPs -> PsErrorDesc
PsErrLambdaCmdInFunAppCmd GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
cmd
      HsCmdCase {} -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc
LHsCmd GhcPs -> PsErrorDesc
PsErrCaseCmdInFunAppCmd   GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
cmd
      HsCmdIf {}   -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc
LHsCmd GhcPs -> PsErrorDesc
PsErrIfCmdInFunAppCmd     GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
cmd
      HsCmdLet {}  -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc
LHsCmd GhcPs -> PsErrorDesc
PsErrLetCmdInFunAppCmd    GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
cmd
      HsCmdDo {}   -> (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
forall {m :: * -> *} {a} {e}.
MonadP m =>
(GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PsErrorDesc
LHsCmd GhcPs -> PsErrorDesc
PsErrDoCmdInFunAppCmd     GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
cmd
      HsCmd GhcPs
_            -> () -> PV ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    check :: (GenLocated (SrcSpanAnn' a) e -> PsErrorDesc)
-> GenLocated (SrcSpanAnn' a) e -> m ()
check GenLocated (SrcSpanAnn' a) e -> PsErrorDesc
err GenLocated (SrcSpanAnn' a) e
a = do
      Bool
blockArguments <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
BlockArgumentsBit
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
blockArguments (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        PsError -> m ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> m ()) -> PsError -> m ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (GenLocated (SrcSpanAnn' a) e -> PsErrorDesc
err GenLocated (SrcSpanAnn' a) e
a) [] (GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated (SrcSpanAnn' a) e
a)

-- | Validate the context constraints and break up a context into a list
-- of predicates.
--
-- @
--     (Eq a, Ord b)        -->  [Eq a, Ord b]
--     Eq a                 -->  [Eq a]
--     (Eq a)               -->  [Eq a]
--     (((Eq a)))           -->  [Eq a]
-- @
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext orig_t :: LHsType GhcPs
orig_t@(L (SrcSpanAnn EpAnn AnnListItem
_ SrcSpan
l) HsType GhcPs
_orig_t) =
  ([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([],[],EpAnnComments
emptyComments) LHsType GhcPs
orig_t
 where
  check :: ([EpaLocation],[EpaLocation],EpAnnComments)
        -> LHsType GhcPs -> P (LHsContext GhcPs)
  check :: ([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([EpaLocation]
oparens,[EpaLocation]
cparens,EpAnnComments
cs) (L SrcSpanAnnA
_l (HsTupleTy XTupleTy GhcPs
ann' HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts))
    -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can
    -- be used as context constraints.
    -- Ditto ()
    = do
        let ([EpaLocation]
op,[EpaLocation]
cp,EpAnnComments
cs') = case XTupleTy GhcPs
ann' of
              EpAnn AnnParen
XTupleTy GhcPs
EpAnnNotUsed -> ([],[],EpAnnComments
emptyComments)
              EpAnn Anchor
_ (AnnParen ParenType
_ EpaLocation
o EpaLocation
c) EpAnnComments
cs -> ([EpaLocation
o],[EpaLocation
c],EpAnnComments
cs)
        GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
        (SrcSpanAnn' (EpAnn AnnContext))
        [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnn' (EpAnn AnnContext)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated
     (SrcSpanAnn' (EpAnn AnnContext))
     [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnContext -> SrcSpan -> SrcSpanAnn' (EpAnn AnnContext)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnContext -> EpAnnComments -> EpAnn AnnContext
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l)
                               (Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing ([EpaLocation]
op [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. Semigroup a => a -> a -> a
Semi.<> [EpaLocation]
oparens) ([EpaLocation]
cp [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. Semigroup a => a -> a -> a
Semi.<> [EpaLocation]
cparens)) (EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
cs')) SrcSpan
l) [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
ts)

  check ([EpaLocation]
opi,[EpaLocation]
cpi,EpAnnComments
csi) (L SrcSpanAnnA
_lp1 (HsParTy XParTy GhcPs
ann' LHsType GhcPs
ty))
                                  -- to be sure HsParTy doesn't get into the way
    = do
        let ([EpaLocation]
op,[EpaLocation]
cp,EpAnnComments
cs') = case XParTy GhcPs
ann' of
                    EpAnn AnnParen
XParTy GhcPs
EpAnnNotUsed -> ([],[],EpAnnComments
emptyComments)
                    EpAnn Anchor
_ (AnnParen ParenType
_ EpaLocation
open EpaLocation
close ) EpAnnComments
cs -> ([EpaLocation
open],[EpaLocation
close],EpAnnComments
cs)
        ([EpaLocation], [EpaLocation], EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check ([EpaLocation]
op[EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++[EpaLocation]
opi,[EpaLocation]
cp[EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. [a] -> [a] -> [a]
++[EpaLocation]
cpi,EpAnnComments
cs' EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
Semi.<> EpAnnComments
csi) LHsType GhcPs
ty

  -- No need for anns, returning original
  check ([EpaLocation]
_opi,[EpaLocation]
_cpi,EpAnnComments
_csi) LHsType GhcPs
_t =
                 GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> P (GenLocated
        (SrcSpanAnn' (EpAnn AnnContext))
        [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnn' (EpAnn AnnContext)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated
     (SrcSpanAnn' (EpAnn AnnContext))
     [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnContext -> SrcSpan -> SrcSpanAnn' (EpAnn AnnContext)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnContext -> EpAnnComments -> EpAnn AnnContext
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) (Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing [] []) EpAnnComments
emptyComments) SrcSpan
l) [GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
orig_t])

checkImportDecl :: Maybe EpaLocation
                -> Maybe EpaLocation
                -> P ()
checkImportDecl :: Maybe EpaLocation -> Maybe EpaLocation -> P ()
checkImportDecl Maybe EpaLocation
mPre Maybe EpaLocation
mPost = do
  let whenJust :: Maybe a -> (a -> f ()) -> f ()
whenJust Maybe a
mg a -> f ()
f = f () -> (a -> f ()) -> Maybe a -> f ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> f ()
f Maybe a
mg

  Bool
importQualifiedPostEnabled <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ImportQualifiedPostBit

  -- Error if 'qualified' found in postpositive position and
  -- 'ImportQualifiedPost' is not in effect.
  Maybe EpaLocation -> (EpaLocation -> P ()) -> P ()
forall {f :: * -> *} {a}.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe EpaLocation
mPost ((EpaLocation -> P ()) -> P ()) -> (EpaLocation -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \EpaLocation
post ->
    Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
importQualifiedPostEnabled) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
      SrcSpan -> P ()
failOpNotEnabledImportQualifiedPost (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
post) Maybe BufSpan
forall a. Maybe a
Nothing)

  -- Error if 'qualified' occurs in both pre and postpositive
  -- positions.
  Maybe EpaLocation -> (EpaLocation -> P ()) -> P ()
forall {f :: * -> *} {a}.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe EpaLocation
mPost ((EpaLocation -> P ()) -> P ()) -> (EpaLocation -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \EpaLocation
post ->
    Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe EpaLocation -> Bool
forall a. Maybe a -> Bool
isJust Maybe EpaLocation
mPre) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
      SrcSpan -> P ()
failOpImportQualifiedTwice (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
post) Maybe BufSpan
forall a. Maybe a
Nothing)

  -- Warn if 'qualified' found in prepositive position and
  -- 'Opt_WarnPrepositiveQualifiedModule' is enabled.
  Maybe EpaLocation -> (EpaLocation -> P ()) -> P ()
forall {f :: * -> *} {a}.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe EpaLocation
mPre ((EpaLocation -> P ()) -> P ()) -> (EpaLocation -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \EpaLocation
pre ->
    SrcSpan -> P ()
warnPrepositiveQualifiedModule (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
pre) Maybe BufSpan
forall a. Maybe a
Nothing)

-- -------------------------------------------------------------------------
-- Checking Patterns.

-- We parse patterns as expressions and check for valid patterns below,
-- converting the expression into a pattern at the same time.

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 (GenLocated SrcSpanAnnA (Pat GhcPs))
LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat

checkPattern_hints :: [Hint] -> PV (LocatedA (PatBuilder GhcPs)) -> P (LPat GhcPs)
checkPattern_hints :: [Hint] -> PV (LocatedA (PatBuilder GhcPs)) -> P (LPat GhcPs)
checkPattern_hints [Hint]
hints PV (LocatedA (PatBuilder GhcPs))
pp = [Hint]
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. [Hint] -> PV a -> P a
runPV_hints [Hint]
hints (PV (LocatedA (PatBuilder GhcPs))
pp PV (LocatedA (PatBuilder GhcPs))
-> (LocatedA (PatBuilder GhcPs)
    -> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat)

checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat e :: LocatedA (PatBuilder GhcPs)
e@(L SrcSpanAnnA
l PatBuilder GhcPs
_) = SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsPatSigType GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
e [] []

checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsPatSigType GhcPs] -> [LPat GhcPs]
         -> PV (LPat GhcPs)
checkPat :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsPatSigType GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
l e :: PatBuilder GhcPs
e@(PatBuilderVar (L SrcSpanAnnN
ln RdrName
c))) [HsPatSigType GhcPs]
tyargs [LPat GhcPs]
args
  | RdrName -> Bool
isRdrDataCon RdrName
c = GenLocated SrcSpanAnnA (Pat GhcPs) -> PV (LPat GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (Pat GhcPs) -> PV (LPat GhcPs))
-> (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs
-> PV (LPat GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (Pat GhcPs -> PV (LPat GhcPs)) -> Pat GhcPs -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
      { pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
forall a. EpAnn a
noAnn -- AZ: where should this come from?
      , 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 = [HsPatSigType GhcPs]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> HsConDetails
     (HsPatSigType GhcPs)
     (GenLocated SrcSpanAnnA (Pat GhcPs))
     (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [HsPatSigType GhcPs]
tyargs [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
args
      }
  | Bool -> Bool
not ([HsPatSigType GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsPatSigType GhcPs]
tyargs) =
      Hint -> PV (LPat GhcPs) -> PV (LPat GhcPs)
forall a. Hint -> PV a -> PV a
add_hint Hint
TypeApplicationsInPatternsOnlyDataCons (PV (LPat GhcPs) -> PV (LPat GhcPs))
-> PV (LPat GhcPs) -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$
      SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. SrcSpan -> SDoc -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
e SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep [String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> HsPatSigType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType GhcPs
t | HsPatSigType GhcPs
t <- [HsPatSigType GhcPs]
tyargs])
  | Bool -> Bool
not ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
args) Bool -> Bool -> Bool
&& RdrName -> Bool
patIsRec RdrName
c =
      Hint -> PV (LPat GhcPs) -> PV (LPat GhcPs)
forall a. Hint -> PV a -> PV a
add_hint Hint
SuggestRecursiveDo (PV (LPat GhcPs) -> PV (LPat GhcPs))
-> PV (LPat GhcPs) -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$
      SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. SrcSpan -> SDoc -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
e)
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
_ (PatBuilderAppType LocatedA (PatBuilder GhcPs)
f HsPatSigType GhcPs
t)) [HsPatSigType GhcPs]
tyargs [LPat GhcPs]
args =
  SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsPatSigType GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
loc LocatedA (PatBuilder GhcPs)
f (HsPatSigType GhcPs
t HsPatSigType GhcPs -> [HsPatSigType GhcPs] -> [HsPatSigType GhcPs]
forall a. a -> [a] -> [a]
: [HsPatSigType GhcPs]
tyargs) [LPat GhcPs]
args
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
_ (PatBuilderApp LocatedA (PatBuilder GhcPs)
f LocatedA (PatBuilder GhcPs)
e)) [] [LPat GhcPs]
args = do
  GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
  SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> [HsPatSigType GhcPs]
-> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat SrcSpanAnnA
loc LocatedA (PatBuilder GhcPs)
f [] (GenLocated SrcSpanAnnA (Pat GhcPs)
p GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
args)
checkPat SrcSpanAnnA
loc (L SrcSpanAnnA
l PatBuilder GhcPs
e) [] [] = do
  Pat GhcPs
p <- SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat SrcSpanAnnA
loc PatBuilder GhcPs
e
  GenLocated SrcSpanAnnA (Pat GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Pat GhcPs
p)
checkPat SrcSpanAnnA
loc LocatedA (PatBuilder GhcPs)
e [HsPatSigType GhcPs]
_ [LPat GhcPs]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. SrcSpan -> SDoc -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) (LocatedA (PatBuilder GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedA (PatBuilder GhcPs)
e)

checkAPat :: SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat :: SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs)
checkAPat SrcSpanAnnA
loc PatBuilder GhcPs
e0 = do
 Bool
nPlusKPatterns <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
NPlusKPatternsBit
 case PatBuilder GhcPs
e0 of
   PatBuilderPat Pat GhcPs
p -> Pat GhcPs -> PV (Pat GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return Pat GhcPs
p
   PatBuilderVar GenLocated SrcSpanAnnN RdrName
x -> Pat GhcPs -> PV (Pat GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
x)

   -- Overloaded numeric patterns (e.g. f 0 x = x)
   -- Negation is recorded separately, so that the literal is zero or +ve
   -- NB. Negative *primitive* literals are already handled by the lexer
   PatBuilderOverLit HsOverLit GhcPs
pos_lit -> Pat GhcPs -> PV (Pat GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs) -> EpAnn [AddEpAnn] -> Pat GhcPs
mkNPat (SrcSpan -> HsOverLit GhcPs -> Located (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) HsOverLit GhcPs
pos_lit) Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn)

   -- n+k patterns
   PatBuilderOpApp
           (L SrcSpanAnnA
_ (PatBuilderVar (L SrcSpanAnnN
nloc RdrName
n)))
           (L SrcSpanAnnN
_ RdrName
plus)
           (L SrcSpanAnnA
lloc (PatBuilderOverLit lit :: HsOverLit GhcPs
lit@(OverLit {ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = HsIntegral {}})))
           EpAnn [AddEpAnn]
anns
                     | 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 (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> Located (HsOverLit GhcPs) -> EpAnn [AddEpAnn] -> Pat GhcPs
mkNPlusKPat (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
nloc RdrName
n) (SrcSpan -> HsOverLit GhcPs -> Located (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
lloc) HsOverLit GhcPs
lit) EpAnn [AddEpAnn]
anns)

   -- Improve error messages for the @-operator when the user meant an @-pattern
   PatBuilderOpApp LocatedA (PatBuilder GhcPs)
_ GenLocated SrcSpanAnnN RdrName
op LocatedA (PatBuilder GhcPs)
_ EpAnn [AddEpAnn]
_ | RdrName -> Bool
opIsAt (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
op) -> do
     PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> PV ()) -> PsError -> PV ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrAtInPatPos [] (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
op)
     Pat GhcPs -> PV (Pat GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat NoExtField
XWildPat GhcPs
noExtField)

   PatBuilderOpApp LocatedA (PatBuilder GhcPs)
l (L SrcSpanAnnN
cl RdrName
c) LocatedA (PatBuilder GhcPs)
r EpAnn [AddEpAnn]
anns
     | RdrName -> Bool
isRdrDataCon RdrName
c -> do
         GenLocated SrcSpanAnnA (Pat GhcPs)
l <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
l
         GenLocated SrcSpanAnnA (Pat GhcPs)
r <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
r
         Pat GhcPs -> PV (Pat GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> PV (Pat GhcPs)) -> Pat GhcPs -> PV (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
           { pat_con_ext :: XConPat GhcPs
pat_con_ext = EpAnn [AddEpAnn]
XConPat GhcPs
anns
           , pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
cl RdrName
c
           , pat_args :: HsConPatDetails GhcPs
pat_args = GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> HsConDetails
     (HsPatSigType GhcPs)
     (GenLocated SrcSpanAnnA (Pat GhcPs))
     (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon GenLocated SrcSpanAnnA (Pat GhcPs)
l GenLocated SrcSpanAnnA (Pat GhcPs)
r
           }

   PatBuilderPar LocatedA (PatBuilder GhcPs)
e an :: AnnParen
an@(AnnParen ParenType
pt EpaLocation
o EpaLocation
c) -> do
     (L SrcSpanAnnA
l Pat GhcPs
p) <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
     let aa :: [AddEpAnn]
aa = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
ai EpaLocation
o, AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
ac EpaLocation
c]
         (AnnKeywordId
ai,AnnKeywordId
ac) = ParenType -> (AnnKeywordId, AnnKeywordId)
parenTypeKws ParenType
pt
     Pat GhcPs -> PV (Pat GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (XParPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XParPat p -> LPat p -> Pat p
ParPat (Anchor -> AnnParen -> EpAnnComments -> EpAnn AnnParen
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> [AddEpAnn] -> SrcSpan
widenSpan (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
aa)) AnnParen
an EpAnnComments
emptyComments) (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Pat GhcPs
p))
   PatBuilder GhcPs
_           -> SrcSpan -> SDoc -> PV (Pat GhcPs)
forall a. SrcSpan -> SDoc -> PV a
patFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) (PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
e0)

placeHolderPunRhs :: DisambECP b => PV (LocatedA b)
-- The RHS of a punned record field will be filled in by the renamer
-- It's better not to make it an error, in case we want to print it when
-- debugging
placeHolderPunRhs :: forall b. DisambECP b => PV (LocatedA b)
placeHolderPunRhs = GenLocated SrcSpanAnnN RdrName -> PV (LocatedA b)
forall b.
DisambECP b =>
GenLocated SrcSpanAnnN RdrName -> PV (LocatedA b)
mkHsVarPV (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
pun_RDR)

plus_RDR, pun_RDR :: RdrName
plus_RDR :: RdrName
plus_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"+") -- Hack
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 HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs))
fld) = do GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs))
fld)
                             GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV
     (GenLocated
        SrcSpanAnnA
        (HsRecField'
           (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsRecField'
     (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated
     SrcSpanAnnA
     (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs))
fld { hsRecFieldArg :: GenLocated SrcSpanAnnA (Pat GhcPs)
hsRecFieldArg = GenLocated SrcSpanAnnA (Pat GhcPs)
p }))

patFail :: SrcSpan -> SDoc -> PV a
patFail :: forall a. SrcSpan -> SDoc -> PV a
patFail SrcSpan
loc SDoc
e = PsError -> PV a
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV a) -> PsError -> PV a
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (SDoc -> PsErrorDesc
PsErrParseErrorInPat SDoc
e) [] SrcSpan
loc

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")

---------------------------------------------------------------------------
-- Check Equation Syntax

checkValDef :: SrcSpan
            -> LocatedA (PatBuilder GhcPs)
            -> Maybe (AddEpAnn, LHsType GhcPs)
            -> Located (GRHSs GhcPs (LHsExpr GhcPs))
            -> P (HsBind GhcPs)

checkValDef :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> Maybe (AddEpAnn, LHsType GhcPs)
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs (Just (AddEpAnn
sigAnn, LHsType GhcPs
sig)) Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss
        -- x :: ty = rhs  parses as a *pattern* binding
  = do GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' <- PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. PV a -> P a
runPV (PV (GenLocated SrcSpanAnnA (Pat GhcPs))
 -> P (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
-> P (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
forall b.
DisambECP b =>
SrcSpanAnnA
-> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
mkHsTySigPV (LocatedA (PatBuilder GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
combineLocsA LocatedA (PatBuilder GhcPs)
lhs GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat
       SrcSpan
-> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc [] GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
lhs' Located (GRHSs GhcPs (LHsExpr GhcPs))
grhss

checkValDef SrcSpan
loc LocatedA (PatBuilder GhcPs)
lhs Maybe (AddEpAnn, LHsType GhcPs)
Nothing Located (GRHSs GhcPs (LHsExpr GhcPs))
g
  = do  { Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder GhcPs)], [AddEpAnn])
mb_fun <- LocatedA (PatBuilder GhcPs)
-> P (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder GhcPs)], [AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
lhs
        ; case Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder GhcPs)], [AddEpAnn])
mb_fun of
            Just (GenLocated SrcSpanAnnN RdrName
fun, LexicalFixity
is_infix, [LocatedA (PatBuilder GhcPs)]
pats, [AddEpAnn]
ann) ->
              SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> LexicalFixity
-> [LocatedA (PatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkFunBind SrcStrictness
NoSrcStrict SrcSpan
loc [AddEpAnn]
ann
                           GenLocated SrcSpanAnnN RdrName
fun LexicalFixity
is_infix [LocatedA (PatBuilder GhcPs)]
pats Located (GRHSs GhcPs (LHsExpr GhcPs))
g
            Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder GhcPs)], [AddEpAnn])
Nothing -> do
              GenLocated SrcSpanAnnA (Pat GhcPs)
lhs' <- LocatedA (PatBuilder GhcPs) -> P (LPat GhcPs)
checkPattern LocatedA (PatBuilder GhcPs)
lhs
              SrcSpan
-> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc [] GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
lhs' Located (GRHSs GhcPs (LHsExpr GhcPs))
g }

checkFunBind :: SrcStrictness
             -> SrcSpan
             -> [AddEpAnn]
             -> LocatedN RdrName
             -> LexicalFixity
             -> [LocatedA (PatBuilder GhcPs)]
             -> Located (GRHSs GhcPs (LHsExpr GhcPs))
             -> P (HsBind GhcPs)
checkFunBind :: SrcStrictness
-> SrcSpan
-> [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> LexicalFixity
-> [LocatedA (PatBuilder GhcPs)]
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkFunBind SrcStrictness
strictness SrcSpan
locF [AddEpAnn]
ann GenLocated SrcSpanAnnN RdrName
fun LexicalFixity
is_infix [LocatedA (PatBuilder GhcPs)]
pats (L SrcSpan
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss)
  = do  [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps <- [Hint]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> P [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. [Hint] -> PV a -> P a
runPV_hints [Hint]
param_hints ((LocatedA (PatBuilder GhcPs)
 -> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [LocatedA (PatBuilder GhcPs)]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat [LocatedA (PatBuilder GhcPs)]
pats)
        let match_span :: SrcSpanAnnA
match_span = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan
locF
        EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
locF
        HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind GenLocated SrcSpanAnnN RdrName
fun (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnL
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnL) -> SrcSpan -> SrcSpanAnnL
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
match_span)
                 [SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
match_span (Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
locF) [AddEpAnn]
ann EpAnnComments
cs
                                      , m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ctxt = FunRhs
                                          { mc_fun :: LIdP GhcPs
mc_fun    = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
fun
                                          , mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
is_infix
                                          , mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
strictness }
                                      , m_pats :: [LPat GhcPs]
m_pats = [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
ps
                                      , m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss = GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (LHsExpr GhcPs)
grhss })]))
        -- The span of the match covers the entire equation.
        -- That isn't quite right, but it'll do for now.
  where
    param_hints :: [Hint]
param_hints
      | LexicalFixity
Infix <- LexicalFixity
is_infix = [RdrName -> Hint
SuggestInfixBindMaybeAtPat (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
fun)]
      | Bool
otherwise         = []

makeFunBind :: LocatedN RdrName -> LocatedL [LMatch GhcPs (LHsExpr GhcPs)]
            -> HsBind GhcPs
-- Like GHC.Hs.Utils.mkFunBind, but we need to be able to set the fixity too
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 = NoExtField
XFunBind GhcPs GhcPs
noExtField,
              fun_id :: LIdP GhcPs
fun_id = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
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 GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
LocatedL [LMatch GhcPs (LHsExpr GhcPs)]
ms,
              fun_tick :: [CoreTickish]
fun_tick = [] }

-- See Note [FunBind vs PatBind]
checkPatBind :: SrcSpan
             -> [AddEpAnn]
             -> LPat GhcPs
             -> Located (GRHSs GhcPs (LHsExpr GhcPs))
             -> P (HsBind GhcPs)
checkPatBind :: SrcSpan
-> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBindLR GhcPs GhcPs)
checkPatBind SrcSpan
loc [AddEpAnn]
annsIn (L SrcSpanAnnA
_ (BangPat (EpAnn Anchor
_ [AddEpAnn]
ans EpAnnComments
cs) (L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ LIdP GhcPs
v))))
                        (L SrcSpan
_match_span GRHSs GhcPs (LHsExpr GhcPs)
grhss)
      = HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBindLR GhcPs GhcPs
makeFunBind GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnL
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc)
                [SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (EpAnn [AddEpAnn]
-> LIdP GhcPs
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) ([AddEpAnn]
ans[AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++[AddEpAnn]
annsIn) EpAnnComments
cs) LIdP GhcPs
v)]))
  where
    m :: EpAnn [AddEpAnn]
-> LIdP GhcPs
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m EpAnn [AddEpAnn]
a LIdP GhcPs
v = Match { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = EpAnn [AddEpAnn]
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a
                  , m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ctxt = FunRhs { mc_fun :: LIdP GhcPs
mc_fun    = LIdP GhcPs
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 (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (LHsExpr GhcPs)
grhss }

checkPatBind SrcSpan
loc [AddEpAnn]
annsIn LPat GhcPs
lhs (L SrcSpan
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss) = do
  EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
loc
  HsBindLR GhcPs GhcPs -> P (HsBindLR GhcPs GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPatBind GhcPs GhcPs
-> LPat GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
-> ([CoreTickish], [[CoreTickish]])
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL
-> GRHSs idR (LHsExpr idR)
-> ([CoreTickish], [[CoreTickish]])
-> HsBindLR idL idR
PatBind (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
loc) [AddEpAnn]
annsIn EpAnnComments
cs) LPat GhcPs
lhs GRHSs GhcPs (LHsExpr GhcPs)
grhss ([],[]))

checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
checkValSigLhs :: LHsExpr GhcPs -> P (GenLocated SrcSpanAnnN RdrName)
checkValSigLhs (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ lrdr :: LIdP GhcPs
lrdr@(L SrcSpanAnnN
_ RdrName
v)))
  | RdrName -> Bool
isUnqual RdrName
v
  , Bool -> Bool
not (OccName -> Bool
isDataOcc (RdrName -> OccName
rdrNameOcc RdrName
v))
  = GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
lrdr

checkValSigLhs lhs :: LHsExpr GhcPs
lhs@(L SrcSpanAnnA
l HsExpr GhcPs
_)
  = PsError -> P (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P (GenLocated SrcSpanAnnN RdrName))
-> PsError -> P (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsExpr GhcPs -> PsErrorDesc
PsErrInvalidTypeSignature LHsExpr GhcPs
lhs) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)

checkDoAndIfThenElse
  :: (Outputable a, Outputable b, Outputable c)
  => (a -> Bool -> b -> Bool -> c -> PsErrorDesc)
  -> 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 -> PsErrorDesc)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse a -> Bool -> b -> Bool -> c -> PsErrorDesc
err LocatedA a
guardExpr Bool
semiThen LocatedA b
thenExpr Bool
semiElse LocatedA c
elseExpr
 | Bool
semiThen Bool -> Bool -> Bool
|| Bool
semiElse = do
      Bool
doAndIfThenElse <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
DoAndIfThenElseBit
      let e :: PsErrorDesc
e   = a -> Bool -> b -> Bool -> c -> PsErrorDesc
err (LocatedA a -> a
forall l e. GenLocated l e -> e
unLoc LocatedA a
guardExpr)
                    Bool
semiThen (LocatedA b -> b
forall l e. GenLocated l e -> e
unLoc LocatedA b
thenExpr)
                    Bool
semiElse (LocatedA c -> c
forall l e. GenLocated l e -> e
unLoc LocatedA c
elseExpr)
          loc :: SrcSpan
loc = Located a -> Located c -> SrcSpan
forall a b. Located a -> Located b -> SrcSpan
combineLocs (LocatedA a -> Located a
forall a e. LocatedAn a e -> Located e
reLoc LocatedA a
guardExpr) (LocatedA c -> Located c
forall a e. LocatedAn a e -> Located e
reLoc LocatedA c
elseExpr)

      Bool -> PV () -> PV ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doAndIfThenElse (PV () -> PV ()) -> PV () -> PV ()
forall a b. (a -> b) -> a -> b
$ PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
e [] SrcSpan
loc)
  | Bool
otherwise = () -> PV ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isFunLhs :: LocatedA (PatBuilder GhcPs)
      -> P (Maybe (LocatedN RdrName, LexicalFixity,
                   [LocatedA (PatBuilder GhcPs)],[AddEpAnn]))
-- A variable binding is parsed as a FunBind.
-- Just (fun, is_infix, arg_pats) if e is a function LHS
isFunLhs :: LocatedA (PatBuilder GhcPs)
-> P (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder GhcPs)], [AddEpAnn]))
isFunLhs LocatedA (PatBuilder GhcPs)
e = LocatedA (PatBuilder GhcPs)
-> [LocatedA (PatBuilder GhcPs)]
-> [AddEpAnn]
-> P (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder GhcPs)], [AddEpAnn]))
forall {m :: * -> *} {p}.
Monad m =>
LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder GhcPs)
e [] []
 where
   go :: LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
go (L SrcSpanAnnA
_ (PatBuilderVar (L SrcSpanAnnN
loc RdrName
f))) [LocatedA (PatBuilder p)]
es [AddEpAnn]
ann
       | Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
f)        = Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
 [LocatedA (PatBuilder p)], [AddEpAnn])
-> Maybe
     (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
      [LocatedA (PatBuilder p)], [AddEpAnn])
forall a. a -> Maybe a
Just (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc RdrName
f, LexicalFixity
Prefix, [LocatedA (PatBuilder p)]
es, [AddEpAnn]
ann))
   go (L SrcSpanAnnA
_ (PatBuilderApp LocatedA (PatBuilder p)
f LocatedA (PatBuilder p)
e)) [LocatedA (PatBuilder p)]
es       [AddEpAnn]
ann = LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder p)
f (LocatedA (PatBuilder p)
eLocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
:[LocatedA (PatBuilder p)]
es) [AddEpAnn]
ann
   go (L SrcSpanAnnA
l (PatBuilderPar LocatedA (PatBuilder p)
e AnnParen
_an)) es :: [LocatedA (PatBuilder p)]
es@(LocatedA (PatBuilder p)
_:[LocatedA (PatBuilder p)]
_) [AddEpAnn]
ann
                                      = LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder p)
e [LocatedA (PatBuilder p)]
es ([AddEpAnn]
ann [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ SrcSpan -> [AddEpAnn]
mkParensEpAnn (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l))
   go (L SrcSpanAnnA
loc (PatBuilderOpApp LocatedA (PatBuilder p)
l (L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder p)
r (EpAnn Anchor
loca [AddEpAnn]
anns EpAnnComments
cs))) [LocatedA (PatBuilder p)]
es [AddEpAnn]
ann
        | Bool -> Bool
not (RdrName -> Bool
isRdrDataCon RdrName
op)         -- We have found the function!
        = Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
 [LocatedA (PatBuilder p)], [AddEpAnn])
-> Maybe
     (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
      [LocatedA (PatBuilder p)], [AddEpAnn])
forall a. a -> Maybe a
Just (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
op, LexicalFixity
Infix, (LocatedA (PatBuilder p)
lLocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
:LocatedA (PatBuilder p)
rLocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
:[LocatedA (PatBuilder p)]
es), ([AddEpAnn]
anns [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ [AddEpAnn]
ann)))
        | Bool
otherwise                     -- Infix data con; keep going
        = do { Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
mb_l <- LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)]
-> [AddEpAnn]
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
go LocatedA (PatBuilder p)
l [LocatedA (PatBuilder p)]
es [AddEpAnn]
ann
             ; case Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
mb_l of
                 Just (GenLocated SrcSpanAnnN RdrName
op', LexicalFixity
Infix, LocatedA (PatBuilder p)
j : LocatedA (PatBuilder p)
k : [LocatedA (PatBuilder p)]
es', [AddEpAnn]
ann')
                   -> Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenLocated SrcSpanAnnN RdrName, LexicalFixity,
 [LocatedA (PatBuilder p)], [AddEpAnn])
-> Maybe
     (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
      [LocatedA (PatBuilder p)], [AddEpAnn])
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnN RdrName
op', LexicalFixity
Infix, LocatedA (PatBuilder p)
j LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
: LocatedA (PatBuilder p)
op_app LocatedA (PatBuilder p)
-> [LocatedA (PatBuilder p)] -> [LocatedA (PatBuilder p)]
forall a. a -> [a] -> [a]
: [LocatedA (PatBuilder p)]
es', [AddEpAnn]
ann'))
                   where
                     op_app :: LocatedA (PatBuilder p)
op_app = SrcSpanAnnA -> PatBuilder p -> LocatedA (PatBuilder p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LocatedA (PatBuilder p)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder p)
-> EpAnn [AddEpAnn]
-> PatBuilder p
forall p.
LocatedA (PatBuilder p)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder p)
-> EpAnn [AddEpAnn]
-> PatBuilder p
PatBuilderOpApp LocatedA (PatBuilder p)
k
                               (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' RdrName
op) LocatedA (PatBuilder p)
r (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
loca [AddEpAnn]
anns EpAnnComments
cs))
                 Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
_ -> Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
forall a. Maybe a
Nothing }
   go LocatedA (PatBuilder p)
_ [LocatedA (PatBuilder p)]
_ [AddEpAnn]
_ = Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
-> m (Maybe
        (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
         [LocatedA (PatBuilder p)], [AddEpAnn]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (GenLocated SrcSpanAnnN RdrName, LexicalFixity,
   [LocatedA (PatBuilder p)], [AddEpAnn])
forall a. Maybe a
Nothing

mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy EpAnn [AddEpAnn]
anns SrcStrictness
strictness =
  XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy EpAnn [AddEpAnn]
XBangTy GhcPs
anns (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
strictness)

-- | Result of parsing @{-\# UNPACK \#-}@ or @{-\# NOUNPACK \#-}@.
data UnpackednessPragma =
  UnpackednessPragma [AddEpAnn] SourceText SrcUnpackedness

-- | Annotate a type with either an @{-\# UNPACK \#-}@ or a @{-\# NOUNPACK \#-}@ pragma.
addUnpackednessP :: MonadP m => Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP :: forall (m :: * -> *).
MonadP m =>
Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP (L SrcSpan
lprag (UnpackednessPragma [AddEpAnn]
anns SourceText
prag SrcUnpackedness
unpk)) LHsType GhcPs
ty = do
    let l' :: SrcSpan
l' = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
lprag (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty)
    EpAnnComments
cs <- SrcSpan -> m EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l'
    let an :: EpAnn [AddEpAnn]
an = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l') [AddEpAnn]
anns EpAnnComments
cs
        t' :: HsType GhcPs
t' = EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness EpAnn [AddEpAnn]
an GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty
    GenLocated SrcSpanAnnA (HsType GhcPs)
-> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l') HsType GhcPs
t')
  where
    -- If we have a HsBangTy that only has a strictness annotation,
    -- such as ~T or !T, then add the pragma to the existing HsBangTy.
    --
    -- Otherwise, wrap the type in a new HsBangTy constructor.
    addUnpackedness :: EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
addUnpackedness EpAnn [AddEpAnn]
an (L SrcSpanAnnA
_ (HsBangTy XBangTy GhcPs
x HsSrcBang
bang LHsType GhcPs
t))
      | HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
strictness <- HsSrcBang
bang
      = XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy (EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns EpAnn [AddEpAnn]
an (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
XBangTy GhcPs
x) (EpAnn [AddEpAnn] -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
epAnnComments EpAnn [AddEpAnn]
XBangTy GhcPs
x)) (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
prag SrcUnpackedness
unpk SrcStrictness
strictness) LHsType GhcPs
t
    addUnpackedness EpAnn [AddEpAnn]
an GenLocated SrcSpanAnnA (HsType GhcPs)
t
      = XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy EpAnn [AddEpAnn]
XBangTy GhcPs
an (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
prag SrcUnpackedness
unpk SrcStrictness
NoSrcStrict) GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t

---------------------------------------------------------------------------
-- | Check for monad comprehensions
--
-- If the flag MonadComprehensions is set, return a 'MonadComp' context,
-- otherwise use the usual 'ListComp' context

checkMonadComp :: PV (HsStmtContext GhcRn)
checkMonadComp :: PV (HsStmtContext GhcRn)
checkMonadComp = do
    Bool
monadComprehensions <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
MonadComprehensionsBit
    HsStmtContext GhcRn -> PV (HsStmtContext GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsStmtContext GhcRn -> PV (HsStmtContext GhcRn))
-> HsStmtContext GhcRn -> PV (HsStmtContext GhcRn)
forall a b. (a -> b) -> a -> b
$ if Bool
monadComprehensions
                then HsStmtContext GhcRn
forall p. HsStmtContext p
MonadComp
                else HsStmtContext GhcRn
forall p. HsStmtContext p
ListComp

-- -------------------------------------------------------------------------
-- Expression/command/pattern ambiguity.
-- See Note [Ambiguous syntactic categories]
--

-- See Note [Ambiguous syntactic categories]
--
-- This newtype is required to avoid impredicative types in monadic
-- productions. That is, in a production that looks like
--
--    | ... {% return (ECP ...) }
--
-- we are dealing with
--    P ECP
-- whereas without a newtype we would be dealing with
--    P (forall b. DisambECP b => PV (Located b))
--
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)

-- The 'fbinds' parser rule produces values of this type. See Note
-- [RecordDotSyntax field updates].
type Fbind b = Either (LHsRecField GhcPs (LocatedA b)) (LHsRecProj GhcPs (LocatedA b))

-- | Disambiguate infix operators.
-- See Note [Ambiguous syntactic categories]
class DisambInfixOp b where
  mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN b)
  mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN b)
  mkHsInfixHolePV :: SrcSpan -> (EpAnnComments -> EpAnn EpAnnUnboundVar) -> PV (Located b)

instance DisambInfixOp (HsExpr GhcPs) where
  mkHsVarOpPV :: GenLocated SrcSpanAnnN RdrName -> PV (LocatedN (HsExpr GhcPs))
mkHsVarOpPV GenLocated SrcSpanAnnN RdrName
v = LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
forall (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 -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcPs
noExtField GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v)
  mkHsConOpPV :: GenLocated SrcSpanAnnN RdrName -> PV (LocatedN (HsExpr GhcPs))
mkHsConOpPV GenLocated SrcSpanAnnN RdrName
v = LocatedN (HsExpr GhcPs) -> PV (LocatedN (HsExpr GhcPs))
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 -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcPs
noExtField GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v)
  mkHsInfixHolePV :: SrcSpan
-> (EpAnnComments -> EpAnn EpAnnUnboundVar)
-> PV (Located (HsExpr GhcPs))
mkHsInfixHolePV SrcSpan
l EpAnnComments -> EpAnn EpAnnUnboundVar
ann = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr (EpAnnComments -> EpAnn EpAnnUnboundVar
ann EpAnnComments
cs))

instance DisambInfixOp RdrName where
  mkHsConOpPV :: GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
mkHsConOpPV (L SrcSpanAnnN
l RdrName
v) = GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
forall (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 (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
 -> PV (GenLocated SrcSpanAnnN RdrName))
-> GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
v
  mkHsInfixHolePV :: SrcSpan
-> (EpAnnComments -> EpAnn EpAnnUnboundVar) -> PV (Located RdrName)
mkHsInfixHolePV SrcSpan
l EpAnnComments -> EpAnn EpAnnUnboundVar
_ = PsError -> PV (Located RdrName)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (Located RdrName))
-> PsError -> PV (Located RdrName)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrInvalidInfixHole [] SrcSpan
l

type AnnoBody b
  = ( Anno (GRHS GhcPs (LocatedA (Body b GhcPs))) ~ SrcSpan
    , 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
    )

-- | Disambiguate constructs that may appear when we do not know ahead of time whether we are
-- parsing an expression, a command, or a pattern.
-- See Note [Ambiguous syntactic categories]
class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
  -- | See Note [Body in DisambECP]
  type Body b :: Type -> Type
  -- | Return a command without ambiguity, or fail in a non-command context.
  ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA b)
  -- | Return an expression without ambiguity, or fail in a non-expression context.
  ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b)
  mkHsProjUpdatePV :: SrcSpan -> Located [Located (HsFieldLabel GhcPs)]
    -> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b))
  -- | Disambiguate "\... -> ..." (lambda)
  mkHsLamPV
    :: SrcSpan -> (EpAnnComments -> MatchGroup GhcPs (LocatedA b)) -> PV (LocatedA b)
  -- | Disambiguate "let ... in ..."
  mkHsLetPV
    :: SrcSpan -> HsLocalBinds GhcPs -> LocatedA b -> AnnsLet -> PV (LocatedA b)
  -- | Infix operator representation
  type InfixOp b
  -- | Bring superclass constraints on InfixOp into scope.
  -- See Note [UndecidableSuperClasses for associated types]
  superInfixOp
    :: (DisambInfixOp (InfixOp b) => PV (LocatedA b )) -> PV (LocatedA b)
  -- | Disambiguate "f # x" (infix operator)
  mkHsOpAppPV :: SrcSpan -> LocatedA b -> LocatedN (InfixOp b) -> LocatedA b
              -> PV (LocatedA b)
  -- | Disambiguate "case ... of ..."
  mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> (LocatedL [LMatch GhcPs (LocatedA b)])
             -> EpAnnHsCase -> PV (LocatedA b)
  mkHsLamCasePV :: SrcSpan -> (LocatedL [LMatch GhcPs (LocatedA b)])
                -> [AddEpAnn]
                -> PV (LocatedA b)
  -- | Function argument representation
  type FunArg b
  -- | Bring superclass constraints on FunArg into scope.
  -- See Note [UndecidableSuperClasses for associated types]
  superFunArg :: (DisambECP (FunArg b) => PV (LocatedA b)) -> PV (LocatedA b)
  -- | Disambiguate "f x" (function application)
  mkHsAppPV :: SrcSpanAnnA -> LocatedA b -> LocatedA (FunArg b) -> PV (LocatedA b)
  -- | Disambiguate "f @t" (visible type application)
  mkHsAppTypePV :: SrcSpanAnnA -> LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b)
  -- | Disambiguate "if ... then ... else ..."
  mkHsIfPV :: SrcSpan
         -> LHsExpr GhcPs
         -> Bool  -- semicolon?
         -> LocatedA b
         -> Bool  -- semicolon?
         -> LocatedA b
         -> AnnsIf
         -> PV (LocatedA b)
  -- | Disambiguate "do { ... }" (do notation)
  mkHsDoPV ::
    SrcSpan ->
    Maybe ModuleName ->
    LocatedL [LStmt GhcPs (LocatedA b)] ->
    AnnList ->
    PV (LocatedA b)
  -- | Disambiguate "( ... )" (parentheses)
  mkHsParPV :: SrcSpan -> LocatedA b -> AnnParen -> PV (LocatedA b)
  -- | Disambiguate a variable "f" or a data constructor "MkF".
  mkHsVarPV :: LocatedN RdrName -> PV (LocatedA b)
  -- | Disambiguate a monomorphic literal
  mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located b)
  -- | Disambiguate an overloaded literal
  mkHsOverLitPV :: Located (HsOverLit GhcPs) -> PV (Located b)
  -- | Disambiguate a wildcard
  mkHsWildCardPV :: SrcSpan -> PV (Located b)
  -- | Disambiguate "a :: t" (type annotation)
  mkHsTySigPV
    :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
  -- | Disambiguate "[a,b,c]" (list syntax)
  mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b)
  -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices)
  mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located b)
  -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates)
  mkHsRecordPV ::
    Bool -> -- Is OverloadedRecordUpdate in effect?
    SrcSpan ->
    SrcSpan ->
    LocatedA b ->
    ([Fbind b], Maybe SrcSpan) ->
    [AddEpAnn] ->
    PV (LocatedA b)
  -- | Disambiguate "-a" (negation)
  mkHsNegAppPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
  -- | Disambiguate "(# a)" (right operator section)
  mkHsSectionR_PV
    :: SrcSpan -> LocatedA (InfixOp b) -> LocatedA b -> PV (Located b)
  -- | Disambiguate "(a -> b)" (view pattern)
  mkHsViewPatPV
    :: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
  -- | Disambiguate "a@b" (as-pattern)
  mkHsAsPatPV
    :: SrcSpan -> LocatedN RdrName -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
  -- | Disambiguate "~a" (lazy pattern)
  mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
  -- | Disambiguate "!a" (bang pattern)
  mkHsBangPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
  -- | Disambiguate tuple sections and unboxed sums
  mkSumOrTuplePV
    :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddEpAnn] -> PV (LocatedA b)
  -- | Validate infixexp LHS to reject unwanted {-# SCC ... #-} pragmas
  rejectPragmaPV :: LocatedA b -> PV ()

{- Note [UndecidableSuperClasses for associated types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(This Note is about the code in GHC, not about the user code that we are parsing)

Assume we have a class C with an associated type T:

  class C a where
    type T a
    ...

If we want to add 'C (T a)' as a superclass, we need -XUndecidableSuperClasses:

  {-# LANGUAGE UndecidableSuperClasses #-}
  class C (T a) => C a where
    type T a
    ...

Unfortunately, -XUndecidableSuperClasses don't work all that well, sometimes
making GHC loop. The workaround is to bring this constraint into scope
manually with a helper method:

  class C a where
    type T a
    superT :: (C (T a) => r) -> r

In order to avoid ambiguous types, 'r' must mention 'a'.

For consistency, we use this approach for all constraints on associated types,
even when -XUndecidableSuperClasses are not required.
-}

{- Note [Body in DisambECP]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
There are helper functions (mkBodyStmt, mkBindStmt, unguardedRHS, etc) that
require their argument to take a form of (body GhcPs) for some (body :: Type ->
*). To satisfy this requirement, we say that (b ~ Body b GhcPs) in the
superclass constraints of DisambECP.

The alternative is to change mkBodyStmt, mkBindStmt, unguardedRHS, etc, to drop
this requirement. It is possible and would allow removing the type index of
PatBuilder, but leads to worse type inference, breaking some code in the
typechecker.
-}

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))
forall (m :: * -> *) a. Monad m => a -> m a
return
  ecpFromExp' :: LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
ecpFromExp' (L SrcSpanAnnA
l HsExpr GhcPs
e) = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e)
  mkHsProjUpdatePV :: SrcSpan
-> Located [Located (HsFieldLabel GhcPs)]
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [Located (HsFieldLabel GhcPs)]
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
_ Bool
_ [AddEpAnn]
_ = PsError
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError
 -> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))))
-> PsError
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrOverloadedRecordDotInvalid [] SrcSpan
l
  mkHsLamPV :: SrcSpan
-> (EpAnnComments
    -> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLamPV SrcSpan
l EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdLam GhcPs -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam NoExtField
XCmdLam GhcPs
NoExtField (EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg EpAnnComments
cs))
  mkHsLetPV :: SrcSpan
-> HsLocalBinds GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> AnnsLet
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLetPV SrcSpan
l HsLocalBinds GhcPs
bs GenLocated SrcSpanAnnA (HsCmd GhcPs)
e AnnsLet
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdLet GhcPs -> HsLocalBinds GhcPs -> LHsCmd GhcPs -> HsCmd GhcPs
forall id. XCmdLet id -> HsLocalBinds id -> LHsCmd id -> HsCmd id
HsCmdLet (Anchor -> AnnsLet -> EpAnnComments -> EpAnn AnnsLet
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnsLet
anns EpAnnComments
cs) HsLocalBinds GhcPs
bs GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
e)
  type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
  superInfixOp :: (DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
 PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
superInfixOp DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
DisambInfixOp (InfixOp (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m
  mkHsOpAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LocatedN (InfixOp (HsCmd GhcPs))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsOpAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c1 LocatedN (InfixOp (HsCmd GhcPs))
op GenLocated SrcSpanAnnA (HsCmd GhcPs)
c2 = do
    let cmdArg :: GenLocated (SrcSpanAnn' a) (HsCmd p)
-> GenLocated SrcSpan (HsCmdTop p)
cmdArg GenLocated (SrcSpanAnn' a) (HsCmd p)
c = SrcSpan -> HsCmdTop p -> GenLocated SrcSpan (HsCmdTop p)
forall l e. l -> e -> GenLocated l e
L (GenLocated (SrcSpanAnn' a) (HsCmd p) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated (SrcSpanAnn' a) (HsCmd p)
c) (HsCmdTop p -> GenLocated SrcSpan (HsCmdTop p))
-> HsCmdTop p -> GenLocated SrcSpan (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 NoExtField
XCmdTop p
noExtField GenLocated (SrcSpanAnn' a) (HsCmd p)
XRec p (HsCmd p)
c
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall a b. (a -> b) -> a -> b
$ XCmdArrForm GhcPs
-> LHsExpr GhcPs
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcPs]
-> HsCmd GhcPs
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [] []) EpAnnComments
cs) (LocatedN (HsExpr GhcPs) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e. LocatedN e -> LocatedA e
reLocL LocatedN (HsExpr GhcPs)
LocatedN (InfixOp (HsCmd GhcPs))
op) LexicalFixity
Infix Maybe Fixity
forall a. Maybe a
Nothing [GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> GenLocated SrcSpan (HsCmdTop GhcPs)
forall {p} {a}.
(XCmdTop p ~ NoExtField,
 XRec p (HsCmd p) ~ GenLocated (SrcSpanAnn' a) (HsCmd p)) =>
GenLocated (SrcSpanAnn' a) (HsCmd p)
-> GenLocated SrcSpan (HsCmdTop p)
cmdArg GenLocated SrcSpanAnnA (HsCmd GhcPs)
c1, GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> GenLocated SrcSpan (HsCmdTop GhcPs)
forall {p} {a}.
(XCmdTop p ~ NoExtField,
 XRec p (HsCmd p) ~ GenLocated (SrcSpanAnn' a) (HsCmd p)) =>
GenLocated (SrcSpanAnn' a) (HsCmd p)
-> GenLocated SrcSpan (HsCmdTop p)
cmdArg GenLocated SrcSpanAnnA (HsCmd GhcPs)
c2]
  mkHsCasePV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> EpAnnHsCase
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsCasePV SrcSpan
l LHsExpr GhcPs
c (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
m) EpAnnHsCase
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg = Origin
-> LocatedL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
FromSource (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> LocatedL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
[LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
m)
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdCase GhcPs
-> LHsExpr GhcPs -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase (Anchor -> EpAnnHsCase -> EpAnnComments -> EpAnn EpAnnHsCase
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) EpAnnHsCase
anns EpAnnComments
cs) LHsExpr GhcPs
c MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
mg)
  mkHsLamCasePV :: SrcSpan
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsLamCasePV SrcSpan
l (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
m) [AddEpAnn]
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg = Origin
-> 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 [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
[LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
m)
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdLamCase GhcPs -> MatchGroup GhcPs (LHsCmd GhcPs) -> HsCmd GhcPs
forall id. XCmdLamCase id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLamCase (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
mg)
  type FunArg (HsCmd GhcPs) = HsExpr GhcPs
  superFunArg :: (DisambECP (FunArg (HsCmd GhcPs)) =>
 PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
superFunArg DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
DisambECP (FunArg (HsCmd GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m
  mkHsAppPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LocatedA (FunArg (HsCmd GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAppPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c LocatedA (FunArg (HsCmd GhcPs))
e = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    LHsCmd GhcPs -> PV ()
checkCmdBlockArguments GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
c
    LHsExpr GhcPs -> PV ()
checkExpBlockArguments LocatedA (FunArg (HsCmd GhcPs))
LHsExpr GhcPs
e
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XCmdApp GhcPs -> LHsCmd GhcPs -> LHsExpr GhcPs -> HsCmd GhcPs
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp (RealSrcSpan -> EpAnnComments -> EpAnnCO
comment (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) EpAnnComments
cs) GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
c LocatedA (FunArg (HsCmd GhcPs))
LHsExpr GhcPs
e)
  mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> SrcSpan
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c SrcSpan
_ LHsType GhcPs
t = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType 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 -> PsErrorDesc)
-> 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 -> PsErrorDesc)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse HsExpr GhcPs
-> Bool -> HsCmd GhcPs -> Bool -> HsCmd GhcPs -> PsErrorDesc
PsErrSemiColonsInCondCmd GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
c Bool
semi1 GenLocated SrcSpanAnnA (HsCmd GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsCmd GhcPs)
b
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (LHsExpr GhcPs
-> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn AnnsIf -> HsCmd GhcPs
mkHsCmdIf LHsExpr GhcPs
c GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
a GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
b (Anchor -> AnnsIf -> EpAnnComments -> EpAnn AnnsIf
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnsIf
anns EpAnnComments
cs))
  mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
Nothing LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
stmts AnnList
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdDo GhcPs -> XRec GhcPs [CmdLStmt GhcPs] -> HsCmd GhcPs
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
XRec GhcPs [CmdLStmt GhcPs]
stmts)
  mkHsDoPV SrcSpan
l (Just ModuleName
m)    LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
_ AnnList
_ = PsError -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PsError -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (ModuleName -> PsErrorDesc
PsErrQualifiedDoInCmd ModuleName
m) [] SrcSpan
l
  mkHsParPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> AnnParen
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsParPV SrcSpan
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
c AnnParen
ann = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsCmd GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> HsCmd GhcPs -> GenLocated SrcSpanAnnA (HsCmd GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCmdPar GhcPs -> LHsCmd GhcPs -> HsCmd GhcPs
forall id. XCmdPar id -> LHsCmd id -> HsCmd id
HsCmdPar (Anchor -> AnnParen -> EpAnnComments -> EpAnn AnnParen
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnParen
ann EpAnnComments
cs) GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
v)
  mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located (HsCmd GhcPs))
mkHsLitPV (L SrcSpan
l HsLit GhcPs
a) = SrcSpan -> SDoc -> PV (Located (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (HsLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit GhcPs
a)
  mkHsOverLitPV :: Located (HsOverLit GhcPs) -> PV (Located (HsCmd GhcPs))
mkHsOverLitPV (L SrcSpan
l HsOverLit GhcPs
a) = SrcSpan -> SDoc -> PV (Located (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (HsOverLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcPs
a)
  mkHsWildCardPV :: SrcSpan -> PV (Located (HsCmd GhcPs))
mkHsWildCardPV SrcSpan
l = SrcSpan -> SDoc -> PV (Located (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (String -> SDoc
text String
"_")
  mkHsTySigPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsTySigPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsCmd GhcPs)
a LHsType GhcPs
sig [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"::" SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType 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
brackets ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsCmd GhcPs)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (HsCmd GhcPs)]
xs)))
  mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located (HsCmd GhcPs))
mkHsSplicePV (L SrcSpan
l HsSplice GhcPs
sp) = SrcSpan -> SDoc -> PV (Located (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (HsSplice GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsSplice 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
   (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
fs, [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
ps) = [Either
   (GenLocated
      SrcSpanAnnA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
-> ([GenLocated
       SrcSpanAnnA
       (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))],
    [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsCmd GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (GenLocated
      SrcSpanAnnA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsCmd GhcPs))))]
[Fbind (HsCmd GhcPs)]
fbinds
    if Bool -> Bool
not ([GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
ps)
      then PsError -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> PsError -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrOverloadedRecordDotInvalid [] SrcSpan
l
      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
<+> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([GenLocated
   SrcSpanAnnA
   (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 [GenLocated
   SrcSpanAnnA
   (HsRecField 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
text String
"-" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
a)
  mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (HsCmd GhcPs))
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> PV (Located (HsCmd GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (HsCmd GhcPs))
op GenLocated SrcSpanAnnA (HsCmd GhcPs)
c = SrcSpan -> SDoc -> PV (Located (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail SrcSpan
l (SDoc -> PV (Located (HsCmd GhcPs)))
-> SDoc -> PV (Located (HsCmd GhcPs))
forall a b. (a -> b) -> a -> b
$
    let pp_op :: SDoc
pp_op = SDoc -> Maybe SDoc -> SDoc
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc
forall a. 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
<> 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 GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"->" SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
b
  mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v 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
$
    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
<> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> 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
text String
"~" SDoc -> SDoc -> SDoc
<> 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
text String
"!" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
  mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsCmd GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mkSumOrTuplePV SrcSpanAnnA
l Boxity
boxity SumOrTuple (HsCmd GhcPs)
a [AddEpAnn]
_ = SrcSpan -> SDoc -> PV (GenLocated SrcSpanAnnA (HsCmd GhcPs))
forall a. SrcSpan -> SDoc -> PV a
cmdFail (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (Boxity -> SumOrTuple (HsCmd GhcPs) -> SDoc
forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple Boxity
boxity SumOrTuple (HsCmd GhcPs)
a)
  rejectPragmaPV :: GenLocated SrcSpanAnnA (HsCmd GhcPs) -> PV ()
rejectPragmaPV GenLocated SrcSpanAnnA (HsCmd GhcPs)
_ = () -> PV ()
forall (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 = PsError -> PV a
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV a) -> PsError -> PV a
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (SDoc -> PsErrorDesc
PsErrParseErrorInCmd SDoc
e) [] SrcSpan
loc

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
    PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> PV ()) -> PsError -> PV ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (HsCmd GhcPs -> PsErrorDesc
PsErrArrowCmdInExpr HsCmd GhcPs
c) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn))
  ecpFromExp' :: LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ecpFromExp' = LHsExpr GhcPs -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return
  mkHsProjUpdatePV :: SrcSpan
-> Located [Located (HsFieldLabel GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [Located (HsFieldLabel GhcPs)]
fields GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
isPun [AddEpAnn]
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    LHsRecProj GhcPs (LHsExpr GhcPs)
-> PV (LHsRecProj GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsRecProj GhcPs (LHsExpr GhcPs)
 -> PV (LHsRecProj GhcPs (LHsExpr GhcPs)))
-> LHsRecProj GhcPs (LHsExpr GhcPs)
-> PV (LHsRecProj GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> Located [Located (HsFieldLabel GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) Located [Located (HsFieldLabel GhcPs)]
fields GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg Bool
isPun (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs)
  mkHsLamPV :: SrcSpan
-> (EpAnnComments
    -> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLamPV SrcSpan
l EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam NoExtField
XLam GhcPs
NoExtField (EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg EpAnnComments
cs))
  mkHsLetPV :: SrcSpan
-> HsLocalBinds GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> AnnsLet
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLetPV SrcSpan
l HsLocalBinds GhcPs
bs GenLocated SrcSpanAnnA (HsExpr GhcPs)
c AnnsLet
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XLet GhcPs -> HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet (Anchor -> AnnsLet -> EpAnnComments -> EpAnn AnnsLet
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnsLet
anns EpAnnComments
cs) HsLocalBinds GhcPs
bs GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
c)
  type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
  superInfixOp :: (DisambInfixOp (InfixOp (HsExpr GhcPs)) =>
 PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
superInfixOp DisambInfixOp (InfixOp (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
DisambInfixOp (InfixOp (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m
  mkHsOpAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LocatedN (InfixOp (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsOpAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LocatedN (InfixOp (HsExpr GhcPs))
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2 = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [] EpAnnComments
cs) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e1 (LocatedN (HsExpr GhcPs) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e. LocatedN e -> LocatedA e
reLocL LocatedN (HsExpr GhcPs)
LocatedN (InfixOp (HsExpr GhcPs))
op) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e2
  mkHsCasePV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> EpAnnHsCase
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsCasePV SrcSpan
l LHsExpr GhcPs
e (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
m) EpAnnHsCase
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg = Origin
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
FromSource (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
m)
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XCase GhcPs
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase (Anchor -> EpAnnHsCase -> EpAnnComments -> EpAnn EpAnnHsCase
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) EpAnnHsCase
anns EpAnnComments
cs) LHsExpr GhcPs
e MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
mg)
  mkHsLamCasePV :: SrcSpan
-> LocatedL [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLamCasePV SrcSpan
l (L SrcSpanAnnL
lm [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
m) [AddEpAnn]
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    let mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg = Origin
-> 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 [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
m)
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XLamCase GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
mg)
  type FunArg (HsExpr GhcPs) = HsExpr GhcPs
  superFunArg :: (DisambECP (FunArg (HsExpr GhcPs)) =>
 PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
superFunArg DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m = PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
DisambECP (FunArg (HsExpr GhcPs)) =>
PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m
  mkHsAppPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LocatedA (FunArg (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAppPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1 LocatedA (FunArg (HsExpr GhcPs))
e2 = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    LHsExpr GhcPs -> PV ()
checkExpBlockArguments GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e1
    LHsExpr GhcPs -> PV ()
checkExpBlockArguments LocatedA (FunArg (HsExpr GhcPs))
LHsExpr GhcPs
e2
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp (RealSrcSpan -> EpAnnComments -> EpAnnCO
comment (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) EpAnnComments
cs) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e1 LocatedA (FunArg (HsExpr GhcPs))
LHsExpr GhcPs
e2)
  mkHsAppTypePV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SrcSpan
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAppTypePV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e SrcSpan
la LHsType GhcPs
t = do
    LHsExpr GhcPs -> PV ()
checkExpBlockArguments GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 SrcSpan
XAppTypeE GhcPs
la GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType 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 -> PsErrorDesc)
-> 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 -> PsErrorDesc)
-> LocatedA a -> Bool -> LocatedA b -> Bool -> LocatedA c -> PV ()
checkDoAndIfThenElse HsExpr GhcPs
-> Bool -> HsExpr GhcPs -> Bool -> HsExpr GhcPs -> PsErrorDesc
PsErrSemiColonsInCondExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
c Bool
semi1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
a Bool
semi2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
b
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn AnnsIf -> HsExpr GhcPs
mkHsIf LHsExpr GhcPs
c GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
b (Anchor -> AnnsIf -> EpAnnComments -> EpAnn AnnsIf
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnsIf
anns EpAnnComments
cs))
  mkHsDoPV :: SrcSpan
-> Maybe ModuleName
-> LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsDoPV SrcSpan
l Maybe ModuleName
mod LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts AnnList
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XDo GhcPs
-> HsStmtContext (HsDoRn GhcPs)
-> XRec GhcPs [ExprLStmt GhcPs]
-> HsExpr GhcPs
forall p.
XDo p
-> HsStmtContext (HsDoRn p) -> XRec p [ExprLStmt p] -> HsExpr p
HsDo (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) (Maybe ModuleName -> HsStmtContext GhcRn
forall p. Maybe ModuleName -> HsStmtContext p
DoExpr Maybe ModuleName
mod) LocatedL [LStmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
XRec GhcPs [ExprLStmt GhcPs]
stmts)
  mkHsParPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> AnnParen
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsParPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e AnnParen
ann = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar (Anchor -> AnnParen -> EpAnnComments -> EpAnn AnnParen
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnParen
ann EpAnnComments
cs) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e)
  mkHsVarPV :: GenLocated SrcSpanAnnN RdrName
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsVarPV v :: GenLocated SrcSpanAnnN RdrName
v@(L SrcSpanAnnN
l RdrName
_) = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a ann. SrcSpanAnn' a -> SrcAnn ann
na2la SrcSpanAnnN
l) (XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcPs
noExtField GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v)
  mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located (HsExpr GhcPs))
mkHsLitPV (L SrcSpan
l HsLit GhcPs
a) = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit (RealSrcSpan -> EpAnnComments -> EpAnnCO
comment (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) EpAnnComments
cs) HsLit GhcPs
a)
  mkHsOverLitPV :: Located (HsOverLit GhcPs) -> PV (Located (HsExpr GhcPs))
mkHsOverLitPV (L SrcSpan
l HsOverLit GhcPs
a) = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit (RealSrcSpan -> EpAnnComments -> EpAnnCO
comment (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) EpAnnComments
cs) HsOverLit GhcPs
a)
  mkHsWildCardPV :: SrcSpan -> PV (Located (HsExpr GhcPs))
mkHsWildCardPV SrcSpan
l = Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn)
  mkHsTySigPV :: SrcSpanAnnA
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsTySigPV SrcSpanAnnA
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
a LHsType GhcPs
sig [AddEpAnn]
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a (LHsType GhcPs -> LHsSigWcType GhcPs
hsTypeToHsSigWcType LHsType GhcPs
sig))
  mkHsExplicitListPV :: SrcSpan
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> AnnList
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsExplicitListPV SrcSpan
l [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs AnnList
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XExplicitList GhcPs -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
xs)
  mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located (HsExpr GhcPs))
mkHsSplicePV sp :: Located (HsSplice GhcPs)
sp@(L SrcSpan
l HsSplice GhcPs
_) = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ (HsSplice GhcPs -> HsExpr GhcPs)
-> Located (HsSplice GhcPs) -> Located (HsExpr GhcPs)
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc (XSpliceE GhcPs -> HsSplice GhcPs -> HsExpr GhcPs
forall p. XSpliceE p -> HsSplice p -> HsExpr p
HsSpliceE (Anchor -> NoEpAnns -> EpAnnComments -> EpAnnCO
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) NoEpAnns
NoEpAnns EpAnnComments
cs)) Located (HsSplice GhcPs)
sp
  mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsRecordPV Bool
opts SrcSpan
l SrcSpan
lrec GenLocated SrcSpanAnnA (HsExpr GhcPs)
a ([Fbind (HsExpr GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    HsExpr GhcPs
r <- Bool
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate Bool
opts GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a SrcSpan
lrec ([Fbind (HsExpr GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs)
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a.
(MonadP m, Outputable a) =>
LocatedA a -> m (LocatedA a)
checkRecordSyntax (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) HsExpr GhcPs
r)
  mkHsNegAppPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsNegAppPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
a [AddEpAnn]
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (XNegApp GhcPs -> LHsExpr GhcPs -> SyntaxExpr GhcPs -> HsExpr GhcPs
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr)
  mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (Located (HsExpr GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (HsExpr GhcPs))
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
e = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs)))
-> Located (HsExpr GhcPs) -> PV (Located (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XSectionR GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR (RealSrcSpan -> EpAnnComments -> EpAnnCO
comment (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) EpAnnComments
cs) LocatedA (InfixOp (HsExpr GhcPs))
LHsExpr GhcPs
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e)
  mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a GenLocated SrcSpanAnnA (HsExpr GhcPs)
b [AddEpAnn]
_ = PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsExpr GhcPs -> LHsExpr GhcPs -> PsErrorDesc
PsErrViewPatInExpr LHsExpr GhcPs
a GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
b) [] SrcSpan
l)
                          PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn))
  mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v GenLocated SrcSpanAnnA (HsExpr GhcPs)
e   [AddEpAnn]
_ = PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (RdrName -> LHsExpr GhcPs -> PsErrorDesc
PsErrTypeAppWithoutSpace (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
v) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e) [] SrcSpan
l)
                          PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn))
  mkHsLazyPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsLazyPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e   [AddEpAnn]
_ = PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsExpr GhcPs -> PsErrorDesc
PsErrLazyPatWithoutSpace GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e) [] SrcSpan
l)
                          PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn))
  mkHsBangPatPV :: SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkHsBangPatPV SrcSpan
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
e   [AddEpAnn]
_ = PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (LHsExpr GhcPs -> PsErrorDesc
PsErrBangPatWithoutSpace GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e) [] SrcSpan
l)
                          PV ()
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
forall a. EpAnn a
noAnn))
  mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mkSumOrTuplePV = SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
mkSumOrTupleExpr
  rejectPragmaPV :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
rejectPragmaPV (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
e)) =
    -- assuming left-associative parsing of operators
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> PV ()
forall b. DisambECP b => LocatedA b -> PV ()
rejectPragmaPV GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e
  rejectPragmaPV (L SrcSpanAnnA
l (HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag LHsExpr GhcPs
_)) = PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> PV ()) -> PsError -> PV ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (HsPragE GhcPs -> PsErrorDesc
PsErrUnallowedPragma HsPragE GhcPs
prag) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
  rejectPragmaPV GenLocated SrcSpanAnnA (HsExpr GhcPs)
_                        = () -> PV ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr EpAnn EpAnnUnboundVar
anns = XUnboundVar GhcPs -> OccName -> HsExpr GhcPs
forall p. XUnboundVar p -> OccName -> HsExpr p
HsUnboundVar EpAnn EpAnnUnboundVar
XUnboundVar GhcPs
anns (String -> OccName
mkVarOcc String
"_")

type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs))) = SrcSpan
type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL
type instance Anno (Match GhcPs (LocatedA (PatBuilder GhcPs))) = SrcSpanAnnA
type instance Anno (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs))) = SrcSpanAnnA

instance DisambECP (PatBuilder GhcPs) where
  type Body (PatBuilder GhcPs) = PatBuilder
  ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA (PatBuilder GhcPs))
ecpFromCmd' (L SrcSpanAnnA
l HsCmd GhcPs
c)    = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (HsCmd GhcPs -> PsErrorDesc
PsErrArrowCmdInPat HsCmd GhcPs
c) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
  ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA (PatBuilder GhcPs))
ecpFromExp' (L SrcSpanAnnA
l HsExpr GhcPs
e)    = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (HsExpr GhcPs -> PsErrorDesc
PsErrArrowExprInPat HsExpr GhcPs
e) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
  mkHsLamPV :: SrcSpan
-> (EpAnnComments
    -> MatchGroup GhcPs (LocatedA (PatBuilder GhcPs)))
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLamPV SrcSpan
l EpAnnComments -> MatchGroup GhcPs (LocatedA (PatBuilder GhcPs))
_          = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrLambdaInPat [] SrcSpan
l
  mkHsLetPV :: SrcSpan
-> HsLocalBinds GhcPs
-> LocatedA (PatBuilder GhcPs)
-> AnnsLet
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLetPV SrcSpan
l HsLocalBinds GhcPs
_ LocatedA (PatBuilder GhcPs)
_ AnnsLet
_      = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrLetInPat [] SrcSpan
l
  mkHsProjUpdatePV :: SrcSpan
-> Located [Located (HsFieldLabel GhcPs)]
-> LocatedA (PatBuilder GhcPs)
-> Bool
-> [AddEpAnn]
-> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
mkHsProjUpdatePV SrcSpan
l Located [Located (HsFieldLabel GhcPs)]
_ LocatedA (PatBuilder GhcPs)
_ Bool
_ [AddEpAnn]
_ = PsError -> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs))))
-> PsError -> PV (LHsRecProj GhcPs (LocatedA (PatBuilder GhcPs)))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrOverloadedRecordDotInvalid [] SrcSpan
l
  type InfixOp (PatBuilder GhcPs) = RdrName
  superInfixOp :: (DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
 PV (LocatedA (PatBuilder GhcPs)))
-> PV (LocatedA (PatBuilder GhcPs))
superInfixOp DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m = PV (LocatedA (PatBuilder GhcPs))
DisambInfixOp (InfixOp (PatBuilder GhcPs)) =>
PV (LocatedA (PatBuilder GhcPs))
m
  mkHsOpAppPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> LocatedN (InfixOp (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
-> PV (LocatedA (PatBuilder GhcPs))
mkHsOpAppPV SrcSpan
l LocatedA (PatBuilder GhcPs)
p1 LocatedN (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p2 = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    let anns :: EpAnn [AddEpAnn]
anns = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [] EpAnnComments
cs
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs))
-> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ LocatedA (PatBuilder GhcPs)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder GhcPs)
-> EpAnn [AddEpAnn]
-> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p)
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder p)
-> EpAnn [AddEpAnn]
-> PatBuilder p
PatBuilderOpApp LocatedA (PatBuilder GhcPs)
p1 GenLocated SrcSpanAnnN RdrName
LocatedN (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p2 EpAnn [AddEpAnn]
anns
  mkHsCasePV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
-> EpAnnHsCase
-> PV (LocatedA (PatBuilder GhcPs))
mkHsCasePV SrcSpan
l LHsExpr GhcPs
_ LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
_ EpAnnHsCase
_     = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrCaseInPat [] SrcSpan
l
  mkHsLamCasePV :: SrcSpan
-> LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLamCasePV SrcSpan
l LocatedL [LMatch GhcPs (LocatedA (PatBuilder GhcPs))]
_ [AddEpAnn]
_    = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrLambdaCaseInPat [] SrcSpan
l
  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 (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)
-> SrcSpan
-> LHsType GhcPs
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAppTypePV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
p SrcSpan
la LHsType GhcPs
t = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    let anns :: EpAnn EpaLocation
anns = Anchor -> EpaLocation -> EpAnnComments -> EpAnn EpaLocation
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
la (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t))) (RealSrcSpan -> EpaLocation
EpaSpan (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
la)) EpAnnComments
cs
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
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)
-> HsPatSigType GhcPs -> PatBuilder GhcPs
forall p.
LocatedA (PatBuilder p) -> HsPatSigType GhcPs -> PatBuilder p
PatBuilderAppType LocatedA (PatBuilder GhcPs)
p (EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnn EpaLocation
anns LHsType GhcPs
t))
  mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
-> Bool
-> LocatedA (PatBuilder GhcPs)
-> Bool
-> LocatedA (PatBuilder GhcPs)
-> AnnsIf
-> PV (LocatedA (PatBuilder GhcPs))
mkHsIfPV SrcSpan
l LHsExpr GhcPs
_ Bool
_ LocatedA (PatBuilder GhcPs)
_ Bool
_ LocatedA (PatBuilder GhcPs)
_ AnnsIf
_ = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrIfTheElseInPat [] SrcSpan
l
  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
_       = PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrDoNotationInPat [] SrcSpan
l
  mkHsParPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> AnnParen
-> PV (LocatedA (PatBuilder GhcPs))
mkHsParPV SrcSpan
l LocatedA (PatBuilder GhcPs)
p AnnParen
an       = LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (LocatedA (PatBuilder GhcPs) -> AnnParen -> PatBuilder GhcPs
forall p. LocatedA (PatBuilder p) -> AnnParen -> PatBuilder p
PatBuilderPar LocatedA (PatBuilder GhcPs)
p AnnParen
an)
  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 (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a ann. SrcSpanAnn' a -> SrcAnn ann
na2la SrcSpanAnnN
l) (GenLocated SrcSpanAnnN RdrName -> PatBuilder GhcPs
forall p. GenLocated SrcSpanAnnN RdrName -> PatBuilder p
PatBuilderVar GenLocated SrcSpanAnnN RdrName
v)
  mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located (PatBuilder GhcPs))
mkHsLitPV lit :: Located (HsLit GhcPs)
lit@(L SrcSpan
l HsLit GhcPs
a) = do
    Located (HsLit GhcPs) -> PV ()
checkUnboxedStringLitPat Located (HsLit GhcPs)
lit
    Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)))
-> Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PatBuilder GhcPs -> Located (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XLitPat GhcPs -> HsLit GhcPs -> Pat GhcPs
forall p. XLitPat p -> HsLit p -> Pat p
LitPat NoExtField
XLitPat GhcPs
noExtField HsLit GhcPs
a))
  mkHsOverLitPV :: Located (HsOverLit GhcPs) -> PV (Located (PatBuilder GhcPs))
mkHsOverLitPV (L SrcSpan
l HsOverLit GhcPs
a) = Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)))
-> Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PatBuilder GhcPs -> Located (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsOverLit GhcPs -> PatBuilder GhcPs
forall p. HsOverLit GhcPs -> PatBuilder p
PatBuilderOverLit HsOverLit GhcPs
a)
  mkHsWildCardPV :: SrcSpan -> PV (Located (PatBuilder GhcPs))
mkHsWildCardPV SrcSpan
l = Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)))
-> Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PatBuilder GhcPs -> Located (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat NoExtField
XWildPat GhcPs
noExtField))
  mkHsTySigPV :: SrcSpanAnnA
-> LocatedA (PatBuilder GhcPs)
-> LHsType GhcPs
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsTySigPV SrcSpanAnnA
l LocatedA (PatBuilder GhcPs)
b LHsType GhcPs
sig [AddEpAnn]
anns = do
    GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
b
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XSigPat GhcPs
-> LPat GhcPs -> HsPatSigType (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
p (EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnn EpaLocation
forall a. EpAnn a
noAnn LHsType GhcPs
sig)))
  mkHsExplicitListPV :: SrcSpan
-> [LocatedA (PatBuilder GhcPs)]
-> AnnList
-> PV (LocatedA (PatBuilder GhcPs))
mkHsExplicitListPV SrcSpan
l [LocatedA (PatBuilder GhcPs)]
xs AnnList
anns = do
    [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps <- (LocatedA (PatBuilder GhcPs)
 -> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [LocatedA (PatBuilder GhcPs)]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse LocatedA (PatBuilder GhcPs)
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat [LocatedA (PatBuilder GhcPs)]
xs
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XListPat GhcPs -> [LPat GhcPs] -> Pat GhcPs
forall p. XListPat p -> [LPat p] -> Pat p
ListPat (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) AnnList
anns EpAnnComments
cs) [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
ps)))
  mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located (PatBuilder GhcPs))
mkHsSplicePV (L SrcSpan
l HsSplice GhcPs
sp) = Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs)))
-> Located (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PatBuilder GhcPs -> Located (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XSplicePat GhcPs -> HsSplice GhcPs -> Pat GhcPs
forall p. XSplicePat p -> HsSplice p -> Pat p
SplicePat NoExtField
XSplicePat GhcPs
noExtField HsSplice GhcPs
sp))
  mkHsRecordPV :: Bool
-> SrcSpan
-> SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> ([Fbind (PatBuilder GhcPs)], Maybe SrcSpan)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsRecordPV Bool
_ SrcSpan
l SrcSpan
_ LocatedA (PatBuilder GhcPs)
a ([Fbind (PatBuilder GhcPs)]
fbinds, Maybe SrcSpan
ddLoc) [AddEpAnn]
anns = do
    let ([GenLocated
   SrcSpanAnnA
   (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))]
fs, [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (LocatedA (PatBuilder GhcPs)))]
ps) = [Either
   (GenLocated
      SrcSpanAnnA
      (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs) (LocatedA (PatBuilder GhcPs))))]
-> ([GenLocated
       SrcSpanAnnA
       (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))],
    [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (FieldLabelStrings GhcPs) (LocatedA (PatBuilder GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (GenLocated
      SrcSpanAnnA
      (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs) (LocatedA (PatBuilder GhcPs))))]
[Fbind (PatBuilder GhcPs)]
fbinds
    if Bool -> Bool
not ([GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (LocatedA (PatBuilder GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (LocatedA (PatBuilder GhcPs)))]
ps)
     then PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrOverloadedRecordDotInvalid [] SrcSpan
l
     else do
       EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
       PatBuilder GhcPs
r <- LocatedA (PatBuilder GhcPs)
-> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
-> EpAnn [AddEpAnn]
-> PV (PatBuilder GhcPs)
mkPatRec LocatedA (PatBuilder GhcPs)
a ([GenLocated
   SrcSpanAnnA
   (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))]
-> Maybe SrcSpan -> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
forall (p :: Pass) arg.
[LocatedA (HsRecField (GhcPass p) arg)]
-> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields [GenLocated
   SrcSpanAnnA
   (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))]
fs Maybe SrcSpan
ddLoc) (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs)
       LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a.
(MonadP m, Outputable a) =>
LocatedA a -> m (LocatedA a)
checkRecordSyntax (SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) PatBuilder GhcPs
r)
  mkHsNegAppPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsNegAppPV SrcSpan
l (L SrcSpanAnnA
lp PatBuilder GhcPs
p) [AddEpAnn]
anns = do
    Located (HsOverLit GhcPs)
lit <- case PatBuilder GhcPs
p of
      PatBuilderOverLit HsOverLit GhcPs
pos_lit -> Located (HsOverLit GhcPs) -> PV (Located (HsOverLit GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsOverLit GhcPs -> Located (HsOverLit GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
lp) HsOverLit GhcPs
pos_lit)
      PatBuilder GhcPs
_ -> SrcSpan -> SDoc -> PV (Located (HsOverLit GhcPs))
forall a. SrcSpan -> SDoc -> PV a
patFail SrcSpan
l (String -> SDoc
text String
"-" SDoc -> SDoc -> SDoc
<> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
p)
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    let an :: EpAnn [AddEpAnn]
an = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (Located (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs) -> EpAnn [AddEpAnn] -> Pat GhcPs
mkNPat Located (HsOverLit GhcPs)
lit (NoExtField -> Maybe NoExtField
forall a. a -> Maybe a
Just NoExtField
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr) EpAnn [AddEpAnn]
an))
  mkHsSectionR_PV :: SrcSpan
-> LocatedA (InfixOp (PatBuilder GhcPs))
-> LocatedA (PatBuilder GhcPs)
-> PV (Located (PatBuilder GhcPs))
mkHsSectionR_PV SrcSpan
l LocatedA (InfixOp (PatBuilder GhcPs))
op LocatedA (PatBuilder GhcPs)
p = SrcSpan -> SDoc -> PV (Located (PatBuilder GhcPs))
forall a. SrcSpan -> SDoc -> PV a
patFail SrcSpan
l (RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc (GenLocated SrcSpanAnnA RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA RdrName
LocatedA (InfixOp (PatBuilder GhcPs))
op) SDoc -> SDoc -> SDoc
<> LocatedA (PatBuilder GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedA (PatBuilder GhcPs)
p)
  mkHsViewPatPV :: SrcSpan
-> LHsExpr GhcPs
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsViewPatPV SrcSpan
l LHsExpr GhcPs
a LocatedA (PatBuilder GhcPs)
b [AddEpAnn]
anns = do
    GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
b
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XViewPat GhcPs -> LHsExpr GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
anns EpAnnComments
cs) LHsExpr GhcPs
a GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
p))
  mkHsAsPatPV :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsAsPatPV SrcSpan
l GenLocated SrcSpanAnnN RdrName
v LocatedA (PatBuilder GhcPs)
e [AddEpAnn]
a = do
    GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XAsPat GhcPs -> LIdP GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XAsPat p -> LIdP p -> LPat p -> Pat p
AsPat (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
a EpAnnComments
cs) GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
p))
  mkHsLazyPatPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsLazyPatPV SrcSpan
l LocatedA (PatBuilder GhcPs)
e [AddEpAnn]
a = do
    GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XLazyPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XLazyPat p -> LPat p -> Pat p
LazyPat (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
a EpAnnComments
cs) GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
p))
  mkHsBangPatPV :: SrcSpan
-> LocatedA (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkHsBangPatPV SrcSpan
l LocatedA (PatBuilder GhcPs)
e [AddEpAnn]
an = do
    GenLocated SrcSpanAnnA (Pat GhcPs)
p <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
e
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor SrcSpan
l
    let pb :: Pat GhcPs
pb = XBangPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XBangPat p -> LPat p -> Pat p
BangPat (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) [AddEpAnn]
an EpAnnComments
cs) GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
p
    SrcSpan -> Pat GhcPs -> PV ()
hintBangPat SrcSpan
l Pat GhcPs
pb
    LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
l) (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat Pat GhcPs
pb)
  mkSumOrTuplePV :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePV = SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat
  rejectPragmaPV :: LocatedA (PatBuilder GhcPs) -> PV ()
rejectPragmaPV LocatedA (PatBuilder GhcPs)
_ = () -> PV ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
checkUnboxedStringLitPat (L SrcSpan
loc HsLit GhcPs
lit) =
  case HsLit GhcPs
lit of
    HsStringPrim XHsStringPrim GhcPs
_ ByteString
_  -- Trac #13260
      -> PsError -> PV ()
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV ()) -> PsError -> PV ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (HsLit GhcPs -> PsErrorDesc
PsErrIllegalUnboxedStringInPat HsLit GhcPs
lit) [] SrcSpan
loc
    HsLit GhcPs
_ -> () -> PV ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

mkPatRec ::
  LocatedA (PatBuilder GhcPs) ->
  HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) ->
  EpAnn [AddEpAnn] ->
  PV (PatBuilder GhcPs)
mkPatRec :: LocatedA (PatBuilder GhcPs)
-> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
-> EpAnn [AddEpAnn]
-> PV (PatBuilder GhcPs)
mkPatRec (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc -> PatBuilderVar GenLocated SrcSpanAnnN RdrName
c) (HsRecFields [LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
fs Maybe (Located Int)
dd) EpAnn [AddEpAnn]
anns
  | RdrName -> Bool
isRdrDataCon (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
c)
  = do [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
fs <- (GenLocated
   SrcSpanAnnA
   (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))
 -> PV
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
      SrcSpanAnnA
      (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))]
-> PV
     [GenLocated
        SrcSpanAnnA
        (HsRecField'
           (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))
-> PV
     (GenLocated
        SrcSpanAnnA
        (HsRecField'
           (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
checkPatField [GenLocated
   SrcSpanAnnA
   (HsRecField' (FieldOcc GhcPs) (LocatedA (PatBuilder GhcPs)))]
[LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))]
fs
       PatBuilder GhcPs -> PV (PatBuilder GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatBuilder GhcPs -> PV (PatBuilder GhcPs))
-> PatBuilder GhcPs -> PV (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (Pat GhcPs -> PatBuilder GhcPs) -> Pat GhcPs -> PatBuilder GhcPs
forall a b. (a -> b) -> a -> b
$ ConPat
         { pat_con_ext :: XConPat GhcPs
pat_con_ext = EpAnn [AddEpAnn]
XConPat GhcPs
anns
         , pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
c
         , pat_args :: HsConPatDetails GhcPs
pat_args = HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> HsConDetails
     (HsPatSigType GhcPs)
     (GenLocated SrcSpanAnnA (Pat GhcPs))
     (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon ([LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> Maybe (Located Int)
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
[LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
fs Maybe (Located Int)
dd)
         }
mkPatRec LocatedA (PatBuilder GhcPs)
p HsRecFields GhcPs (LocatedA (PatBuilder GhcPs))
_ EpAnn [AddEpAnn]
_ =
  PsError -> PV (PatBuilder GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (PatBuilder GhcPs))
-> PsError -> PV (PatBuilder GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (PatBuilder GhcPs -> PsErrorDesc
PsErrInvalidRecordCon (LocatedA (PatBuilder GhcPs) -> PatBuilder GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (PatBuilder GhcPs)
p)) [] (LocatedA (PatBuilder GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA (PatBuilder GhcPs)
p)

-- | Disambiguate constructs that may appear when we do not know
-- ahead of time whether we are parsing a type or a newtype/data constructor.
--
-- See Note [Ambiguous syntactic categories] for the general idea.
--
-- See Note [Parsing data constructors is hard] for the specific issue this
-- particular class is solving.
--
class DisambTD b where
  -- | Process the head of a type-level function/constructor application,
  -- i.e. the @H@ in @H a b c@.
  mkHsAppTyHeadPV :: LHsType GhcPs -> PV (LocatedA b)
  -- | Disambiguate @f x@ (function application or prefix data constructor).
  mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b)
  -- | Disambiguate @f \@t@ (visible kind application)
  mkHsAppKindTyPV :: LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b)
  -- | Disambiguate @f \# x@ (infix operator)
  mkHsOpTyPV :: LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
  -- | Disambiguate @{-\# UNPACK \#-} t@ (unpack/nounpack pragma)
  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))
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 (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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t1 LHsType GhcPs
t2)
  mkHsAppKindTyPV :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> SrcSpan
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsAppKindTyPV GenLocated SrcSpanAnnA (HsType GhcPs)
t SrcSpan
l_at LHsType GhcPs
ki = GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (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 SrcSpan
XAppKindTy GhcPs
l_at GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t LHsType GhcPs
ki)
  mkHsOpTyPV :: LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
mkHsOpTyPV LHsType GhcPs
t1 GenLocated SrcSpanAnnN RdrName
op LHsType GhcPs
t2 = GenLocated SrcSpanAnnA (HsType GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName -> LHsType GhcPs -> LHsType GhcPs
mkLHsOpTy 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
-> 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

-- Detect when the record syntax is used:
--   data T = MkT { ... }
dataConBuilderDetails :: DataConBuilder -> HsConDeclH98Details GhcPs
dataConBuilderDetails (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds GenLocated SrcSpanAnnN RdrName
_)
  | [L SrcSpanAnnA
l_t (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
fields)] <- OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
OrdList (LHsType GhcPs)
flds
  = GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> HsConDetails
     Void
     (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon (SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnList -> SrcSpan -> SrcSpanAnnL
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnList
XRecTy GhcPs
an (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_t)) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
[LConDeclField GhcPs]
fields)

-- Normal prefix constructor, e.g.  data T = MkT A B C
dataConBuilderDetails (PrefixDataConBuilder OrdList (LHsType GhcPs)
flds GenLocated SrcSpanAnnN RdrName
_)
  = [Void]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> HsConDetails
     Void
     (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs ((GenLocated SrcSpanAnnA (HsType GhcPs)
 -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a pass. a -> HsScaled pass a
hsLinear (OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
OrdList (LHsType GhcPs)
flds))

-- Infix constructor, e.g. data T = Int :! Bool
dataConBuilderDetails (InfixDataConBuilder LHsType GhcPs
lhs GenLocated SrcSpanAnnN RdrName
_ LHsType GhcPs
rhs)
  = HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsConDetails
     Void
     (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a pass. a -> HsScaled pass a
hsLinear GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
lhs) (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a pass. a -> HsScaled pass a
hsLinear GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType 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 (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$
      SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t))
        (OrdList (LHsType GhcPs)
-> GenLocated SrcSpanAnnN RdrName -> DataConBuilder
PrefixDataConBuilder (OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
OrdList (LHsType GhcPs)
flds OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> OrdList (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. OrdList a -> a -> OrdList a
`snocOL` GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t) GenLocated SrcSpanAnnN RdrName
fn)
  mkHsAppTyPV (L SrcSpanAnnA
_ InfixDataConBuilder{}) LHsType GhcPs
_ =
    -- This case is impossible because of the way
    -- the grammar in Parser.y is written (see infixtype/ftype).
    String -> PV (LocatedA DataConBuilder)
forall a. String -> a
panic String
"mkHsAppTyPV: InfixDataConBuilder"

  mkHsAppKindTyPV :: LocatedA DataConBuilder
-> SrcSpan -> LHsType GhcPs -> PV (LocatedA DataConBuilder)
mkHsAppKindTyPV LocatedA DataConBuilder
lhs SrcSpan
l_at LHsType GhcPs
ki =
    PsError -> PV (LocatedA DataConBuilder)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA DataConBuilder))
-> PsError -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (DataConBuilder -> HsType GhcPs -> PsErrorDesc
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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ki)) [] SrcSpan
l_at

  mkHsOpTyPV :: LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> PV (LocatedA DataConBuilder)
mkHsOpTyPV 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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
rhs)  -- check the RHS because parsing type operators is right-associative
      GenLocated SrcSpanAnnN RdrName
data_con <- Either PsError (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. MonadP m => Either PsError a -> m a
eitherToP (Either PsError (GenLocated SrcSpanAnnN RdrName)
 -> PV (GenLocated SrcSpanAnnN RdrName))
-> Either PsError (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName
-> Either PsError (GenLocated SrcSpanAnnN RdrName)
tyConToDataCon GenLocated SrcSpanAnnN RdrName
tc
      LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> DataConBuilder
InfixDataConBuilder LHsType GhcPs
lhs GenLocated SrcSpanAnnN RdrName
data_con LHsType GhcPs
rhs)
    where
      l :: SrcSpanAnnA
l = GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
combineLocsA GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
lhs GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType 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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t)
      check_no_ops (HsOpTy{}) =
        PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> PV ()) -> PsError -> PV ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (HsType GhcPs -> RdrName -> HsType GhcPs -> PsErrorDesc
PsErrInvalidInfixDataCon (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType 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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
rhs)) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
      check_no_ops HsType GhcPs
_ = () -> PV ()
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
    = -- When the user writes  data T = {-# UNPACK #-} Int :+ Bool
      --   we apply {-# UNPACK #-} to the LHS
      do GenLocated SrcSpanAnnA (HsType GhcPs)
lhs' <- Located UnpackednessPragma -> LHsType GhcPs -> PV (LHsType GhcPs)
forall (m :: * -> *).
MonadP m =>
Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)
addUnpackednessP Located UnpackednessPragma
unpk LHsType GhcPs
lhs
         let l :: SrcSpanAnnA
l = GenLocated SrcSpanAnnA UnpackednessPragma
-> LocatedA DataConBuilder -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
combineLocsA (Located UnpackednessPragma
-> GenLocated SrcSpanAnnA UnpackednessPragma
forall e ann. Located e -> LocatedAn ann e
reLocA Located UnpackednessPragma
unpk) LocatedA DataConBuilder
constr_stuff
         LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName
-> LHsType GhcPs
-> DataConBuilder
InfixDataConBuilder GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
lhs' GenLocated SrcSpanAnnN RdrName
data_con LHsType GhcPs
rhs)
    | Bool
otherwise =
      do PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> PV ()) -> PsError -> PV ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrUnpackDataCon [] (Located UnpackednessPragma -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located UnpackednessPragma
unpk)
         LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
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
NotPromoted LIdP GhcPs
v)) = do
  GenLocated SrcSpanAnnN RdrName
data_con <- Either PsError (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. MonadP m => Either PsError a -> m a
eitherToP (Either PsError (GenLocated SrcSpanAnnN RdrName)
 -> PV (GenLocated SrcSpanAnnN RdrName))
-> Either PsError (GenLocated SrcSpanAnnN RdrName)
-> PV (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName
-> Either PsError (GenLocated SrcSpanAnnN RdrName)
tyConToDataCon GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v
  LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA DataConBuilder -> PV (LocatedA DataConBuilder))
-> LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> DataConBuilder -> LocatedA DataConBuilder
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (OrdList (LHsType GhcPs)
-> GenLocated SrcSpanAnnN RdrName -> DataConBuilder
PrefixDataConBuilder OrdList (LHsType GhcPs)
forall a. OrdList a
nilOL GenLocated SrcSpanAnnN RdrName
data_con)
tyToDataConBuilder (L SrcSpanAnnA
l (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
ts)) = do
  let data_con :: GenLocated SrcSpanAnnN RdrName
data_con = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
l) (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Boxity -> Int -> DataCon
tupleDataCon Boxity
Boxed ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
ts)))
  LocatedA DataConBuilder -> PV (LocatedA DataConBuilder)
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 [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
ts) GenLocated SrcSpanAnnN RdrName
data_con)
tyToDataConBuilder LHsType GhcPs
t =
  PsError -> PV (LocatedA DataConBuilder)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA DataConBuilder))
-> PsError -> PV (LocatedA DataConBuilder)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (HsType GhcPs -> PsErrorDesc
PsErrInvalidDataCon (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t)) [] (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t)

{- Note [Ambiguous syntactic categories]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There are places in the grammar where we do not know whether we are parsing an
expression or a pattern without unlimited lookahead (which we do not have in
'happy'):

View patterns:

    f (Con a b     ) = ...  -- 'Con a b' is a pattern
    f (Con a b -> x) = ...  -- 'Con a b' is an expression

do-notation:

    do { Con a b <- x } -- 'Con a b' is a pattern
    do { Con a b }      -- 'Con a b' is an expression

Guards:

    x | True <- p && q = ...  -- 'True' is a pattern
    x | True           = ...  -- 'True' is an expression

Top-level value/function declarations (FunBind/PatBind):

    f ! a         -- TH splice
    f ! a = ...   -- function declaration

    Until we encounter the = sign, we don't know if it's a top-level
    TemplateHaskell splice where ! is used, or if it's a function declaration
    where ! is bound.

There are also places in the grammar where we do not know whether we are
parsing an expression or a command:

    proc x -> do { (stuff) -< x }   -- 'stuff' is an expression
    proc x -> do { (stuff) }        -- 'stuff' is a command

    Until we encounter arrow syntax (-<) we don't know whether to parse 'stuff'
    as an expression or a command.

In fact, do-notation is subject to both ambiguities:

    proc x -> do { (stuff) -< x }        -- 'stuff' is an expression
    proc x -> do { (stuff) <- f -< x }   -- 'stuff' is a pattern
    proc x -> do { (stuff) }             -- 'stuff' is a command

There are many possible solutions to this problem. For an overview of the ones
we decided against, see Note [Resolving parsing ambiguities: non-taken alternatives]

The solution that keeps basic definitions (such as HsExpr) clean, keeps the
concerns local to the parser, and does not require duplication of hsSyn types,
or an extra pass over the entire AST, is to parse into an overloaded
parser-validator (a so-called tagless final encoding):

    class DisambECP b where ...
    instance DisambECP (HsCmd GhcPs) where ...
    instance DisambECP (HsExp GhcPs) where ...
    instance DisambECP (PatBuilder GhcPs) where ...

The 'DisambECP' class contains functions to build and validate 'b'. For example,
to add parentheses we have:

  mkHsParPV :: DisambECP b => SrcSpan -> Located b -> PV (Located b)

'mkHsParPV' will wrap the inner value in HsCmdPar for commands, HsPar for
expressions, and 'PatBuilderPar' for patterns (later transformed into ParPat,
see Note [PatBuilder]).

Consider the 'alts' production used to parse case-of alternatives:

  alts :: { Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }

We abstract over LHsExpr GhcPs, and it becomes:

  alts :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (Located b)])) }
    : alts1     { $1 >>= \ $1 ->
                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
    | ';' alts  { $2 >>= \ $2 ->
                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }

Compared to the initial definition, the added bits are:

    forall b. DisambECP b => PV ( ... ) -- in the type signature
    $1 >>= \ $1 -> return $             -- in one reduction rule
    $2 >>= \ $2 -> return $             -- in another reduction rule

The overhead is constant relative to the size of the rest of the reduction
rule, so this approach scales well to large parser productions.

Note that we write ($1 >>= \ $1 -> ...), so the second $1 is in a binding
position and shadows the previous $1. We can do this because internally
'happy' desugars $n to happy_var_n, and the rationale behind this idiom
is to be able to write (sLL $1 $>) later on. The alternative would be to
write this as ($1 >>= \ fresh_name -> ...), but then we couldn't refer
to the last fresh name as $>.

Finally, we instantiate the polymorphic type to a concrete one, and run the
parser-validator, for example:

    stmt   :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
    e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
            : stmt {% runPV $1 }

In e_stmt, three things happen:

  1. we instantiate: b ~ HsExpr GhcPs
  2. we embed the PV computation into P by using runPV
  3. we run validation by using a monadic production, {% ... }

At this point the ambiguity is resolved.
-}


{- Note [Resolving parsing ambiguities: non-taken alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Alternative I, extra constructors in GHC.Hs.Expr
------------------------------------------------
We could add extra constructors to HsExpr to represent command-specific and
pattern-specific syntactic constructs. Under this scheme, we parse patterns
and commands as expressions and rejig later.  This is what GHC used to do, and
it polluted 'HsExpr' with irrelevant constructors:

  * for commands: 'HsArrForm', 'HsArrApp'
  * for patterns: 'EWildPat', 'EAsPat', 'EViewPat', 'ELazyPat'

(As of now, we still do that for patterns, but we plan to fix it).

There are several issues with this:

  * The implementation details of parsing are leaking into hsSyn definitions.

  * Code that uses HsExpr has to panic on these impossible-after-parsing cases.

  * HsExpr is arbitrarily selected as the extension basis. Why not extend
    HsCmd or HsPat with extra constructors instead?

Alternative II, extra constructors in GHC.Hs.Expr for GhcPs
-----------------------------------------------------------
We could address some of the problems with Alternative I by using Trees That
Grow and extending HsExpr only in the GhcPs pass. However, GhcPs corresponds to
the output of parsing, not to its intermediate results, so we wouldn't want
them there either.

Alternative III, extra constructors in GHC.Hs.Expr for GhcPrePs
---------------------------------------------------------------
We could introduce a new pass, GhcPrePs, to keep GhcPs pristine.
Unfortunately, creating a new pass would significantly bloat conversion code
and slow down the compiler by adding another linear-time pass over the entire
AST. For example, in order to build HsExpr GhcPrePs, we would need to build
HsLocalBinds GhcPrePs (as part of HsLet), and we never want HsLocalBinds
GhcPrePs.


Alternative IV, sum type and bottom-up data flow
------------------------------------------------
Expressions and commands are disjoint. There are no user inputs that could be
interpreted as either an expression or a command depending on outer context:

  5        -- definitely an expression
  x -< y   -- definitely a command

Even though we have both 'HsLam' and 'HsCmdLam', we can look at
the body to disambiguate:

  \p -> 5        -- definitely an expression
  \p -> x -< y   -- definitely a command

This means we could use a bottom-up flow of information to determine
whether we are parsing an expression or a command, using a sum type
for intermediate results:

  Either (LHsExpr GhcPs) (LHsCmd GhcPs)

There are two problems with this:

  * We cannot handle the ambiguity between expressions and
    patterns, which are not disjoint.

  * Bottom-up flow of information leads to poor error messages. Consider

        if ... then 5 else (x -< y)

    Do we report that '5' is not a valid command or that (x -< y) is not a
    valid expression?  It depends on whether we want the entire node to be
    'HsIf' or 'HsCmdIf', and this information flows top-down, from the
    surrounding parsing context (are we in 'proc'?)

Alternative V, backtracking with parser combinators
---------------------------------------------------
One might think we could sidestep the issue entirely by using a backtracking
parser and doing something along the lines of (try pExpr <|> pPat).

Turns out, this wouldn't work very well, as there can be patterns inside
expressions (e.g. via 'case', 'let', 'do') and expressions inside patterns
(e.g. view patterns). To handle this, we would need to backtrack while
backtracking, and unbound levels of backtracking lead to very fragile
performance.

Alternative VI, an intermediate data type
-----------------------------------------
There are common syntactic elements of expressions, commands, and patterns
(e.g. all of them must have balanced parentheses), and we can capture this
common structure in an intermediate data type, Frame:

data Frame
  = FrameVar RdrName
    -- ^ Identifier: Just, map, BS.length
  | FrameTuple [LTupArgFrame] Boxity
    -- ^ Tuple (section): (a,b) (a,b,c) (a,,) (,a,)
  | FrameTySig LFrame (LHsSigWcType GhcPs)
    -- ^ Type signature: x :: ty
  | FramePar (SrcSpan, SrcSpan) LFrame
    -- ^ Parentheses
  | FrameIf LFrame LFrame LFrame
    -- ^ If-expression: if p then x else y
  | FrameCase LFrame [LFrameMatch]
    -- ^ Case-expression: case x of { p1 -> e1; p2 -> e2 }
  | FrameDo (HsStmtContext GhcRn) [LFrameStmt]
    -- ^ Do-expression: do { s1; a <- s2; s3 }
  ...
  | FrameExpr (HsExpr GhcPs)   -- unambiguously an expression
  | FramePat (HsPat GhcPs)     -- unambiguously a pattern
  | FrameCommand (HsCmd GhcPs) -- unambiguously a command

To determine which constructors 'Frame' needs to have, we take the union of
intersections between HsExpr, HsCmd, and HsPat.

The intersection between HsPat and HsExpr:

  HsPat  =  VarPat   | TuplePat      | SigPat        | ParPat   | ...
  HsExpr =  HsVar    | ExplicitTuple | ExprWithTySig | HsPar    | ...
  -------------------------------------------------------------------
  Frame  =  FrameVar | FrameTuple    | FrameTySig    | FramePar | ...

The intersection between HsCmd and HsExpr:

  HsCmd  = HsCmdIf | HsCmdCase | HsCmdDo | HsCmdPar
  HsExpr = HsIf    | HsCase    | HsDo    | HsPar
  ------------------------------------------------
  Frame = FrameIf  | FrameCase | FrameDo | FramePar

The intersection between HsCmd and HsPat:

  HsPat  = ParPat   | ...
  HsCmd  = HsCmdPar | ...
  -----------------------
  Frame  = FramePar | ...

Take the union of each intersection and this yields the final 'Frame' data
type. The problem with this approach is that we end up duplicating a good
portion of hsSyn:

    Frame         for  HsExpr, HsPat, HsCmd
    TupArgFrame   for  HsTupArg
    FrameMatch    for  Match
    FrameStmt     for  StmtLR
    FrameGRHS     for  GRHS
    FrameGRHSs    for  GRHSs
    ...

Alternative VII, a product type
-------------------------------
We could avoid the intermediate representation of Alternative VI by parsing
into a product of interpretations directly:

    type ExpCmdPat = ( PV (LHsExpr GhcPs)
                     , PV (LHsCmd GhcPs)
                     , PV (LHsPat GhcPs) )

This means that in positions where we do not know whether to produce
expression, a pattern, or a command, we instead produce a parser-validator for
each possible option.

Then, as soon as we have parsed far enough to resolve the ambiguity, we pick
the appropriate component of the product, discarding the rest:

    checkExpOf3 (e, _, _) = e  -- interpret as an expression
    checkCmdOf3 (_, c, _) = c  -- interpret as a command
    checkPatOf3 (_, _, p) = p  -- interpret as a pattern

We can easily define ambiguities between arbitrary subsets of interpretations.
For example, when we know ahead of type that only an expression or a command is
possible, but not a pattern, we can use a smaller type:

    type ExpCmd = (PV (LHsExpr GhcPs), PV (LHsCmd GhcPs))

    checkExpOf2 (e, _) = e  -- interpret as an expression
    checkCmdOf2 (_, c) = c  -- interpret as a command

However, there is a slight problem with this approach, namely code duplication
in parser productions. Consider the 'alts' production used to parse case-of
alternatives:

  alts :: { Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }

Under the new scheme, we have to completely duplicate its type signature and
each reduction rule:

  alts :: { ( PV (Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)])) -- as an expression
            , PV (Located ([AddEpAnn],[LMatch GhcPs (LHsCmd GhcPs)]))  -- as a command
            ) }
    : alts1
        { ( checkExpOf2 $1 >>= \ $1 ->
            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)
          , checkCmdOf2 $1 >>= \ $1 ->
            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)
          ) }
    | ';' alts
        { ( checkExpOf2 $2 >>= \ $2 ->
            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)
          , checkCmdOf2 $2 >>= \ $2 ->
            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)
          ) }

And the same goes for other productions: 'altslist', 'alts1', 'alt', 'alt_rhs',
'ralt', 'gdpats', 'gdpat', 'exp', ... and so on. That is a lot of code!

Alternative VIII, a function from a GADT
----------------------------------------
We could avoid code duplication of the Alternative VII by representing the product
as a function from a GADT:

    data ExpCmdG b where
      ExpG :: ExpCmdG HsExpr
      CmdG :: ExpCmdG HsCmd

    type ExpCmd = forall b. ExpCmdG b -> PV (Located (b GhcPs))

    checkExp :: ExpCmd -> PV (LHsExpr GhcPs)
    checkCmd :: ExpCmd -> PV (LHsCmd GhcPs)
    checkExp f = f ExpG  -- interpret as an expression
    checkCmd f = f CmdG  -- interpret as a command

Consider the 'alts' production used to parse case-of alternatives:

  alts :: { Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }

We abstract over LHsExpr, and it becomes:

  alts :: { forall b. ExpCmdG b -> PV (Located ([AddEpAnn],[LMatch GhcPs (Located (b GhcPs))])) }
    : alts1
        { \tag -> $1 tag >>= \ $1 ->
                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
    | ';' alts
        { \tag -> $2 tag >>= \ $2 ->
                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }

Note that 'ExpCmdG' is a singleton type, the value is completely
determined by the type:

  when (b~HsExpr),  tag = ExpG
  when (b~HsCmd),   tag = CmdG

This is a clear indication that we can use a class to pass this value behind
the scenes:

  class    ExpCmdI b      where expCmdG :: ExpCmdG b
  instance ExpCmdI HsExpr where expCmdG = ExpG
  instance ExpCmdI HsCmd  where expCmdG = CmdG

And now the 'alts' production is simplified, as we no longer need to
thread 'tag' explicitly:

  alts :: { forall b. ExpCmdI b => PV (Located ([AddEpAnn],[LMatch GhcPs (Located (b GhcPs))])) }
    : alts1     { $1 >>= \ $1 ->
                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
    | ';' alts  { $2 >>= \ $2 ->
                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }

This encoding works well enough, but introduces an extra GADT unlike the
tagless final encoding, and there's no need for this complexity.

-}

{- Note [PatBuilder]
~~~~~~~~~~~~~~~~~~~~
Unlike HsExpr or HsCmd, the Pat type cannot accommodate all intermediate forms,
so we introduce the notion of a PatBuilder.

Consider a pattern like this:

  Con a b c

We parse arguments to "Con" one at a time in the  fexp aexp  parser production,
building the result with mkHsAppPV, so the intermediate forms are:

  1. Con
  2. Con a
  3. Con a b
  4. Con a b c

In 'HsExpr', we have 'HsApp', so the intermediate forms are represented like
this (pseudocode):

  1. "Con"
  2. HsApp "Con" "a"
  3. HsApp (HsApp "Con" "a") "b"
  3. HsApp (HsApp (HsApp "Con" "a") "b") "c"

Similarly, in 'HsCmd' we have 'HsCmdApp'. In 'Pat', however, what we have
instead is 'ConPatIn', which is very awkward to modify and thus unsuitable for
the intermediate forms.

We also need an intermediate representation to postpone disambiguation between
FunBind and PatBind. Consider:

  a `Con` b = ...
  a `fun` b = ...

How do we know that (a `Con` b) is a PatBind but (a `fun` b) is a FunBind? We
learn this by inspecting an intermediate representation in 'isFunLhs' and
seeing that 'Con' is a data constructor but 'f' is not. We need an intermediate
representation capable of representing both a FunBind and a PatBind, so Pat is
insufficient.

PatBuilder is an extension of Pat that is capable of representing intermediate
parsing results for patterns and function bindings:

  data PatBuilder p
    = PatBuilderPat (Pat p)
    | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
    | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedA RdrName) (LocatedA (PatBuilder p))
    ...

It can represent any pattern via 'PatBuilderPat', but it also has a variety of
other constructors which were added by following a simple principle: we never
pattern match on the pattern stored inside 'PatBuilderPat'.
-}

---------------------------------------------------------------------------
-- Miscellaneous utilities

-- | Check if a fixity is valid. We support bypassing the usual bound checks
-- for some special operators.
checkPrecP
        :: Located (SourceText,Int)              -- ^ precedence
        -> Located (OrdList (LocatedN RdrName))  -- ^ operators
        -> 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
 | Bool
otherwise = PsError -> P ()
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (Int -> PsErrorDesc
PsErrPrecedenceOutOfRange Int
i) [] SrcSpan
l
  where
    -- If you change this, consider updating Note [Fixity of (->)] in GHC/Types.hs
    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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ RdrName
eqTyCon_RDR
                                   , TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
unrestrictedFunTyCon ]

mkRecConstrOrUpdate
        :: Bool
        -> LHsExpr GhcPs
        -> SrcSpan
        -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
        -> EpAnn [AddEpAnn]
        -> PV (HsExpr GhcPs)
mkRecConstrOrUpdate :: Bool
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate Bool
_ (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
l RdrName
c))) SrcSpan
_lrec ([Fbind (HsExpr GhcPs)]
fbinds,Maybe SrcSpan
dd) EpAnn [AddEpAnn]
anns
  | RdrName -> Bool
isRdrDataCon RdrName
c
  = do
      let ([LocatedA
   (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
   (LocatedA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs)
         (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([LocatedA
       (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
    [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (FieldLabelStrings GhcPs)
          (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (LocatedA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs)
         (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
[Fbind (HsExpr GhcPs)]
fbinds
      if Bool -> Bool
not ([GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps)
        then PsError -> PV (HsExpr GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (HsExpr GhcPs)) -> PsError -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrOverloadedRecordDotInvalid [] (GenLocated
  SrcSpanAnnA
  (HsRecField'
     (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA ([GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. [a] -> a
head [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps))
        else HsExpr GhcPs -> PV (HsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
-> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l RdrName
c) ([LocatedA
   (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Maybe SrcSpan
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) arg.
[LocatedA (HsRecField (GhcPass p) arg)]
-> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields [LocatedA
   (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs Maybe SrcSpan
dd) EpAnn [AddEpAnn]
anns)
mkRecConstrOrUpdate Bool
overloaded_update LHsExpr GhcPs
exp SrcSpan
_ ([Fbind (HsExpr GhcPs)]
fs,Maybe SrcSpan
dd) EpAnn [AddEpAnn]
anns
  | Just SrcSpan
dd_loc <- Maybe SrcSpan
dd = PsError -> PV (HsExpr GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (HsExpr GhcPs)) -> PsError -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrDotsInRecordUpdate [] SrcSpan
dd_loc
  | Bool
otherwise = Bool
-> LHsExpr GhcPs
-> [Fbind (HsExpr GhcPs)]
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_update LHsExpr GhcPs
exp [Fbind (HsExpr GhcPs)]
fs EpAnn [AddEpAnn]
anns

mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> EpAnn [AddEpAnn] -> PV (HsExpr GhcPs)
mkRdrRecordUpd :: Bool
-> LHsExpr GhcPs
-> [Fbind (HsExpr GhcPs)]
-> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRdrRecordUpd Bool
overloaded_on exp :: LHsExpr GhcPs
exp@(L SrcSpanAnnA
loc HsExpr GhcPs
_) [Fbind (HsExpr GhcPs)]
fbinds EpAnn [AddEpAnn]
anns = do
  -- We do not need to know if OverloadedRecordDot is in effect. We do
  -- however need to know if OverloadedRecordUpdate (passed in
  -- overloaded_on) is in effect because it affects the Left/Right nature
  -- of the RecordUpd value we calculate.
  let ([LocatedA
   (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs, [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps) = [Either
   (LocatedA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs)
         (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ([LocatedA
       (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
    [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (FieldLabelStrings GhcPs)
          (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (LocatedA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs)
         (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
[Fbind (HsExpr GhcPs)]
fbinds
      fs' :: [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs' = (LocatedA
   (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [LocatedA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map ((HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> HsRecField'
      (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedA
     (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA
     (HsRecField'
        (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsRecField'
     (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field) [LocatedA
   (HsRecField 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
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ps ->
      -- A '.' was found in an update and OverloadedRecordUpdate isn't on.
      PsError -> PV (HsExpr GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (HsExpr GhcPs)) -> PsError -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrOverloadedRecordUpdateNotEnabled [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
    Bool
False ->
      -- This is just a regular record update.
      HsExpr GhcPs -> PV (HsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return RecordUpd {
        rupd_ext :: XRecordUpd GhcPs
rupd_ext = EpAnn [AddEpAnn]
XRecordUpd GhcPs
anns
      , rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
      , rupd_flds :: Either [LHsRecUpdField GhcPs] [LHsRecProj GhcPs (LHsExpr GhcPs)]
rupd_flds = [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
     [GenLocated
        SrcSpanAnnA
        (HsRecField'
           (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. a -> Either a b
Left [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs' }
    Bool
True -> do
      let qualifiedFields :: [GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)]
qualifiedFields =
            [ SrcSpan
-> AmbiguousFieldOcc GhcPs
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l AmbiguousFieldOcc GhcPs
lbl | L SrcSpanAnnA
_ (HsRecField XHsRecField (AmbiguousFieldOcc GhcPs)
_ (L SrcSpan
l AmbiguousFieldOcc GhcPs
lbl) GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ Bool
_) <- [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fs'
                      , RdrName -> Bool
isQual (RdrName -> Bool)
-> (AmbiguousFieldOcc GhcPs -> RdrName)
-> AmbiguousFieldOcc GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousFieldOcc GhcPs -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc (AmbiguousFieldOcc GhcPs -> Bool)
-> AmbiguousFieldOcc GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc GhcPs
lbl
            ]
      if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)]
qualifiedFields
        then
          PsError -> PV (HsExpr GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (HsExpr GhcPs)) -> PsError -> PV (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrOverloadedRecordUpdateNoQualifiedFields [] (GenLocated SrcSpan (AmbiguousFieldOcc GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc ([GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)]
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
forall a. [a] -> a
head [GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)]
qualifiedFields))
        else -- This is a RecordDotSyntax update.
          HsExpr GhcPs -> PV (HsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return RecordUpd {
            rupd_ext :: XRecordUpd GhcPs
rupd_ext = EpAnn [AddEpAnn]
XRecordUpd GhcPs
anns
           , rupd_expr :: LHsExpr GhcPs
rupd_expr = LHsExpr GhcPs
exp
           , rupd_flds :: Either [LHsRecUpdField GhcPs] [LHsRecProj GhcPs (LHsExpr GhcPs)]
rupd_flds = [GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
     [GenLocated
        SrcSpanAnnA
        (HsRecField'
           (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. b -> Either a b
Right ([Fbind (HsExpr GhcPs)] -> [LHsRecProj GhcPs (LHsExpr GhcPs)]
toProjUpdates [Fbind (HsExpr GhcPs)]
fbinds) }
  where
    toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdProj GhcPs]
    toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecProj GhcPs (LHsExpr GhcPs)]
toProjUpdates = (Either
   (LocatedA
      (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
 -> GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [Either
      (LocatedA
         (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldLabelStrings GhcPs)
            (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> [GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (\case { Right GenLocated
  SrcSpanAnnA
  (HsRecField'
     (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p -> GenLocated
  SrcSpanAnnA
  (HsRecField'
     (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
p; Left LocatedA (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
f -> LHsRecField GhcPs (LHsExpr GhcPs)
-> LHsRecProj GhcPs (LHsExpr GhcPs)
recFieldToProjUpdate LocatedA (HsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
LHsRecField GhcPs (LHsExpr GhcPs)
f })

    -- Convert a top-level field update like {foo=2} or {bar} (punned)
    -- to a projection update.
    recFieldToProjUpdate :: LHsRecField GhcPs  (LHsExpr GhcPs) -> LHsRecUpdProj GhcPs
    recFieldToProjUpdate :: LHsRecField GhcPs (LHsExpr GhcPs)
-> LHsRecProj GhcPs (LHsExpr GhcPs)
recFieldToProjUpdate (L SrcSpanAnnA
l (HsRecField XHsRecField (FieldOcc GhcPs)
anns (L SrcSpan
_ (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpanAnnN
loc RdrName
rdr))) GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
pun)) =
        -- The idea here is to convert the label to a singleton [FastString].
        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 :: HsFieldLabel GhcPs
fl = XCHsFieldLabel GhcPs -> Located FastString -> HsFieldLabel GhcPs
forall p. XCHsFieldLabel p -> Located FastString -> HsFieldLabel p
HsFieldLabel XCHsFieldLabel GhcPs
forall a. EpAnn a
noAnn (SrcSpan -> FastString -> Located FastString
forall l e. l -> e -> GenLocated l e
L SrcSpan
lf FastString
f) -- AZ: what about the ann?
            lf :: SrcSpan
lf = SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc
        in SrcSpanAnnA
-> Located [Located (HsFieldLabel GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate SrcSpanAnnA
l (SrcSpan
-> [Located (HsFieldLabel GhcPs)]
-> Located [Located (HsFieldLabel GhcPs)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
lf [SrcSpan -> HsFieldLabel GhcPs -> Located (HsFieldLabel GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
lf HsFieldLabel GhcPs
fl]) (FastString -> LHsExpr GhcPs
punnedVar FastString
f) Bool
pun EpAnn [AddEpAnn]
XHsRecField (FieldOcc GhcPs)
anns
        where
          -- If punning, compute HsVar "f" otherwise just arg. This
          -- has the effect that sentinel HsVar "pun-rhs" is replaced
          -- by HsVar "f" here, before the update is written to a
          -- setField expressions.
          punnedVar :: FastString -> LHsExpr GhcPs
          punnedVar :: FastString -> LHsExpr GhcPs
punnedVar FastString
f  = if Bool -> Bool
not Bool
pun then GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg else HsExpr GhcPs -> LHsExpr GhcPs
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> LHsExpr GhcPs)
-> (FastString -> HsExpr GhcPs) -> FastString -> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcPs
noExtField (GenLocated SrcSpanAnnN RdrName -> HsExpr GhcPs)
-> (FastString -> GenLocated SrcSpanAnnN RdrName)
-> FastString
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> (FastString -> RdrName)
-> FastString
-> GenLocated SrcSpanAnnN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName)
-> (FastString -> OccName) -> FastString -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> OccName
mkVarOccFS (FastString -> LHsExpr GhcPs) -> FastString -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ FastString
f

mkRdrRecordCon
  :: LocatedN RdrName -> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon :: GenLocated SrcSpanAnnN RdrName
-> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon GenLocated SrcSpanAnnN RdrName
con HsRecordBinds GhcPs
flds EpAnn [AddEpAnn]
anns
  = RecordCon { rcon_ext :: XRecordCon GhcPs
rcon_ext = EpAnn [AddEpAnn]
XRecordCon GhcPs
anns, rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_con = GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
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 = [LocatedA (HsRecField (GhcPass p) arg)]
[LHsRecField (GhcPass p) arg]
fs, rec_dotdot :: Maybe (Located Int)
rec_dotdot = Maybe (Located Int)
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 = [LocatedA (HsRecField (GhcPass p) arg)]
[LHsRecField (GhcPass p) arg]
fs
                                     , rec_dotdot :: Maybe (Located Int)
rec_dotdot = Located Int -> Maybe (Located Int)
forall a. a -> Maybe a
Just (SrcSpan -> Int -> Located Int
forall l e. l -> e -> GenLocated l e
L SrcSpan
s ([LocatedA (HsRecField (GhcPass p) arg)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocatedA (HsRecField (GhcPass p) arg)]
fs)) }

mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field (HsRecField XHsRecField (FieldOcc GhcPs)
noAnn (L SrcSpan
loc (FieldOcc XCFieldOcc GhcPs
_ GenLocated SrcSpanAnnN RdrName
rdr)) LHsExpr GhcPs
arg Bool
pun)
  = XHsRecField (AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> HsRecField'
     (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall id arg.
XHsRecField id -> Located id -> arg -> Bool -> HsRecField' id arg
HsRecField XHsRecField (AmbiguousFieldOcc GhcPs)
XHsRecField (FieldOcc GhcPs)
noAnn (SrcSpan
-> AmbiguousFieldOcc GhcPs
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XUnambiguous GhcPs
-> GenLocated SrcSpanAnnN RdrName -> AmbiguousFieldOcc GhcPs
forall pass.
XUnambiguous pass
-> GenLocated SrcSpanAnnN RdrName -> AmbiguousFieldOcc pass
Unambiguous NoExtField
XUnambiguous GhcPs
noExtField GenLocated SrcSpanAnnN RdrName
rdr)) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg Bool
pun

mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
               -> InlinePragma
-- The (Maybe Activation) is because the user can omit
-- the activation spec (and usually does)
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 -- Note [Pragma source text] in GHC.Types.SourceText
                 , 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  -> -- No phase specified
                        case InlineSpec
inl of
                          InlineSpec
NoInline -> Activation
NeverActive
                          InlineSpec
_other   -> Activation
AlwaysActive

-----------------------------------------------------------------------------
-- utilities for foreign declarations

-- construct a foreign import declaration
--
mkImport :: Located CCallConv
         -> Located Safety
         -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
         -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkImport :: Located CCallConv
-> Located Safety
-> (Located StringLiteral, GenLocated SrcSpanAnnN RdrName,
    LHsSigType GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkImport Located CCallConv
cconv Located Safety
safety (L SrcSpan
loc (StringLiteral SourceText
esrc FastString
entity Maybe RealSrcSpan
_), GenLocated SrcSpanAnnN RdrName
v, LHsSigType GhcPs
ty) =
    case Located CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc Located CCallConv
cconv of
      CCallConv
CCallConv          -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkCImport
      CCallConv
CApiConv           -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkCImport
      CCallConv
StdCallConv        -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkCImport
      CCallConv
PrimCallConv       -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
      CCallConv
JavaScriptCallConv -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkOtherImport
  where
    -- Parse a C-like entity string of the following form:
    --   "[static] [chname] [&] [cid]" | "dynamic" | "wrapper"
    -- If 'cid' is missing, the function name 'v' is used instead as symbol
    -- name (cf section 8.5.1 in Haskell 2010 report).
    mkCImport :: P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkCImport = do
      let e :: String
e = FastString -> String
unpackFS FastString
entity
      case Located CCallConv
-> Located Safety
-> FastString
-> String
-> Located SourceText
-> Maybe ForeignImport
parseCImport Located CCallConv
cconv Located Safety
safety (RdrName -> FastString
mkExtName (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
v)) String
e (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc SourceText
esrc) of
        Maybe ForeignImport
Nothing         -> PsError -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> PsError -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrMalformedEntityString [] SrcSpan
loc
        Just ForeignImport
importSpec -> ForeignImport -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport
importSpec

    -- currently, all the other import conventions only support a symbol name in
    -- the entity string. If it is missing, we use the function name instead.
    mkOtherImport :: P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkOtherImport = ForeignImport -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport
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
importSpec = Located CCallConv
-> Located Safety
-> Maybe Header
-> CImportSpec
-> Located SourceText
-> ForeignImport
CImport Located CCallConv
cconv Located Safety
safety Maybe Header
forall a. Maybe a
Nothing CImportSpec
funcTarget (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc SourceText
esrc)

    returnSpec :: ForeignImport -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
returnSpec ForeignImport
spec = (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return ((EpAnn [AddEpAnn] -> HsDecl GhcPs)
 -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \EpAnn [AddEpAnn]
ann -> XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD NoExtField
XForD GhcPs
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  = EpAnn [AddEpAnn]
XForeignImport GhcPs
ann
          , fd_name :: LIdP GhcPs
fd_name   = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v
          , fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = LHsSigType GhcPs
ty
          , fd_fi :: ForeignImport
fd_fi     = ForeignImport
spec
          }



-- the string "foo" is ambiguous: either a header or a C identifier.  The
-- C identifier case comes first in the alternatives below, so we pick
-- that one.
parseCImport :: Located CCallConv -> Located Safety -> FastString -> String
             -> Located SourceText
             -> Maybe ForeignImport
parseCImport :: Located CCallConv
-> Located Safety
-> FastString
-> String
-> Located SourceText
-> Maybe ForeignImport
parseCImport Located CCallConv
cconv Located Safety
safety FastString
nm String
str Located SourceText
sourceText =
 [ForeignImport] -> Maybe ForeignImport
forall a. [a] -> Maybe a
listToMaybe ([ForeignImport] -> Maybe ForeignImport)
-> [ForeignImport] -> Maybe ForeignImport
forall a b. (a -> b) -> a -> b
$ ((ForeignImport, String) -> ForeignImport)
-> [(ForeignImport, String)] -> [ForeignImport]
forall a b. (a -> b) -> [a] -> [b]
map (ForeignImport, String) -> ForeignImport
forall a b. (a, b) -> a
fst ([(ForeignImport, String)] -> [ForeignImport])
-> [(ForeignImport, String)] -> [ForeignImport]
forall a b. (a -> b) -> a -> b
$ ((ForeignImport, String) -> Bool)
-> [(ForeignImport, String)] -> [(ForeignImport, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null(String -> Bool)
-> ((ForeignImport, String) -> String)
-> (ForeignImport, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ForeignImport, String) -> String
forall a b. (a, b) -> b
snd) ([(ForeignImport, String)] -> [(ForeignImport, String)])
-> [(ForeignImport, String)] -> [(ForeignImport, String)]
forall a b. (a -> b) -> a -> b
$
     ReadP ForeignImport -> ReadS ForeignImport
forall a. ReadP a -> ReadS a
readP_to_S ReadP ForeignImport
parse String
str
 where
   parse :: ReadP ForeignImport
parse = do
       ReadP ()
skipSpaces
       ForeignImport
r <- [ReadP ForeignImport] -> ReadP ForeignImport
forall a. [ReadP a] -> ReadP a
choice [
          String -> ReadP String
string String
"dynamic" ReadP String -> ReadP ForeignImport -> ReadP ForeignImport
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignImport -> ReadP ForeignImport
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Header -> CImportSpec -> ForeignImport
mk Maybe Header
forall a. Maybe a
Nothing (CCallTarget -> CImportSpec
CFunction CCallTarget
DynamicTarget)),
          String -> ReadP String
string String
"wrapper" ReadP String -> ReadP ForeignImport -> ReadP ForeignImport
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignImport -> ReadP ForeignImport
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Header -> CImportSpec -> ForeignImport
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
skipSpaces)
             ((Maybe Header -> CImportSpec -> ForeignImport
mk Maybe Header
forall a. Maybe a
Nothing (CImportSpec -> ForeignImport)
-> ReadP CImportSpec -> ReadP ForeignImport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> ReadP CImportSpec
cimp FastString
nm) ReadP ForeignImport -> ReadP ForeignImport -> ReadP ForeignImport
forall a. ReadP a -> ReadP a -> ReadP a
+++
              (do String
h <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
hdr_char
                  ReadP ()
skipSpaces
                  Maybe Header -> CImportSpec -> ForeignImport
mk (Header -> Maybe Header
forall a. a -> Maybe a
Just (SourceText -> FastString -> Header
Header (String -> SourceText
SourceText String
h) (String -> FastString
mkFastString String
h)))
                      (CImportSpec -> ForeignImport)
-> ReadP CImportSpec -> ReadP ForeignImport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> ReadP CImportSpec
cimp FastString
nm))
         ]
       ReadP ()
skipSpaces
       ForeignImport -> ReadP ForeignImport
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignImport
r

   token :: String -> ReadP ()
token String
str = do String
_ <- String -> ReadP String
string String
str
                  String
toks <- ReadP String
look
                  case String
toks of
                      Char
c : String
_
                       | Char -> Bool
id_char Char
c -> ReadP ()
forall a. ReadP a
pfail
                      String
_            -> () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   mk :: Maybe Header -> CImportSpec -> ForeignImport
mk Maybe Header
h CImportSpec
n = Located CCallConv
-> Located Safety
-> Maybe Header
-> CImportSpec
-> Located SourceText
-> ForeignImport
CImport Located CCallConv
cconv Located Safety
safety Maybe Header
h CImportSpec
n Located SourceText
sourceText

   hdr_char :: Char -> Bool
hdr_char Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c)
   -- header files are filenames, which can contain
   -- pretty much any char (depending on the platform),
   -- so just accept any non-space character
   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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
skipSpaces ReadP () -> ReadP CImportSpec -> ReadP CImportSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FastString -> CImportSpec
CLabel (FastString -> CImportSpec)
-> ReadP FastString -> ReadP CImportSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP FastString
cid)
             ReadP CImportSpec -> ReadP CImportSpec -> ReadP CImportSpec
forall a. ReadP a -> ReadP a -> ReadP a
+++ (do Bool
isFun <- case Located CCallConv -> CCallConv
forall l e. GenLocated l e -> e
unLoc Located CCallConv
cconv of
                               CCallConv
CApiConv ->
                                  Bool -> ReadP Bool -> ReadP Bool
forall a. a -> ReadP a -> ReadP a
option Bool
True
                                         (do String -> ReadP ()
token String
"value"
                                             ReadP ()
skipSpaces
                                             Bool -> ReadP Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                               CCallConv
_ -> Bool -> ReadP Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                     FastString
cid' <- ReadP FastString
cid
                     CImportSpec -> ReadP CImportSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (CCallTarget -> CImportSpec
CFunction (SourceText -> FastString -> Maybe Unit -> Bool -> CCallTarget
StaticTarget SourceText
NoSourceText FastString
cid'
                                        Maybe Unit
forall a. Maybe a
Nothing Bool
isFun)))
          where
            cid :: ReadP FastString
cid = FastString -> ReadP FastString
forall (m :: * -> *) a. Monad m => a -> m a
return FastString
nm ReadP FastString -> ReadP FastString -> ReadP FastString
forall a. ReadP a -> ReadP a -> ReadP a
+++
                  (do Char
c  <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
id_first_char
                      String
cs <-  ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
id_char)
                      FastString -> ReadP FastString
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FastString
mkFastString (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)))


-- construct a foreign export declaration
--
mkExport :: Located CCallConv
         -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
         -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkExport :: Located CCallConv
-> (Located StringLiteral, GenLocated SrcSpanAnnN RdrName,
    LHsSigType GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkExport (L SrcSpan
lc CCallConv
cconv) (L SrcSpan
le (StringLiteral SourceText
esrc FastString
entity Maybe RealSrcSpan
_), GenLocated SrcSpanAnnN RdrName
v, LHsSigType GhcPs
ty)
 = (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return ((EpAnn [AddEpAnn] -> HsDecl GhcPs)
 -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs))
-> (EpAnn [AddEpAnn] -> HsDecl GhcPs)
-> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \EpAnn [AddEpAnn]
ann -> XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD NoExtField
XForD GhcPs
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 = EpAnn [AddEpAnn]
XForeignExport GhcPs
ann, fd_name :: LIdP GhcPs
fd_name = GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
v, fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = LHsSigType GhcPs
ty
                 , fd_fe :: ForeignExport
fd_fe = Located CExportSpec -> Located SourceText -> ForeignExport
CExport (SrcSpan -> CExportSpec -> Located CExportSpec
forall l e. l -> e -> GenLocated l e
L SrcSpan
lc (SourceText -> FastString -> CCallConv -> CExportSpec
CExportStatic SourceText
esrc FastString
entity' CCallConv
cconv))
                                   (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
le SourceText
esrc) }
  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

-- Supplying the ext_name in a foreign decl is optional; if it
-- isn't there, the Haskell name is assumed. Note that no transformation
-- of the Haskell name is then performed, so if you foreign export (++),
-- it's external name will be "++". Too bad; it's important because we don't
-- want z-encoding (e.g. names with z's in them shouldn't be doubled)
--
mkExtName :: RdrName -> CLabelString
mkExtName :: RdrName -> FastString
mkExtName RdrName
rdrNm = String -> FastString
mkFastString (OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
rdrNm))

--------------------------------------------------------------------------------
-- Help with module system imports/exports

data ImpExpSubSpec = ImpExpAbs
                   | ImpExpAll
                   | ImpExpList [LocatedA ImpExpQcSpec]
                   | ImpExpAllWith [LocatedA ImpExpQcSpec]

data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
                  | ImpExpQcType EpaLocation (LocatedN RdrName)
                  | ImpExpQcWildcard

mkModuleImpExp :: [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp :: [AddEpAnn]
-> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp [AddEpAnn]
anns (L SrcSpanAnnA
l ImpExpQcSpec
specname) ImpExpSubSpec
subs = do
  EpAnnComments
cs <- SrcSpan -> P EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) -- AZ: IEVar can discard comments
  let ann :: EpAnn [AddEpAnn]
ann = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs
  case ImpExpSubSpec
subs of
    ImpExpSubSpec
ImpExpAbs
      | NameSpace -> Bool
isVarNameSpace (RdrName -> NameSpace
rdrNameSpace RdrName
name)
                       -> IE GhcPs -> P (IE GhcPs)
forall (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 (IdP GhcPs) -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcPs
noExtField (SrcSpanAnnA
-> IEWrappedName RdrName
-> GenLocated SrcSpanAnnA (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ImpExpQcSpec -> IEWrappedName RdrName
ieNameFromSpec ImpExpQcSpec
specname))
      | Bool
otherwise      -> XIEThingAbs GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs EpAnn [AddEpAnn]
XIEThingAbs GhcPs
ann (GenLocated SrcSpanAnnA (IEWrappedName RdrName) -> IE GhcPs)
-> (IEWrappedName RdrName
    -> GenLocated SrcSpanAnnA (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> IE GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> IEWrappedName RdrName
-> GenLocated SrcSpanAnnA (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName RdrName -> IE GhcPs)
-> P (IEWrappedName RdrName) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName RdrName)
nameT
    ImpExpSubSpec
ImpExpAll          -> XIEThingAll GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll EpAnn [AddEpAnn]
XIEThingAll GhcPs
ann (GenLocated SrcSpanAnnA (IEWrappedName RdrName) -> IE GhcPs)
-> (IEWrappedName RdrName
    -> GenLocated SrcSpanAnnA (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> IE GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> IEWrappedName RdrName
-> GenLocated SrcSpanAnnA (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName RdrName -> IE GhcPs)
-> P (IEWrappedName RdrName) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName RdrName)
nameT
    ImpExpList [LocatedA ImpExpQcSpec]
xs      ->
      (\IEWrappedName RdrName
newName -> XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith EpAnn [AddEpAnn]
XIEThingWith GhcPs
ann (SrcSpanAnnA
-> IEWrappedName RdrName
-> GenLocated SrcSpanAnnA (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName RdrName
newName)
        IEWildcard
NoIEWildcard ([LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName RdrName)]
forall {l}.
[GenLocated l ImpExpQcSpec]
-> [GenLocated l (IEWrappedName RdrName)]
wrapped [LocatedA ImpExpQcSpec]
xs)) (IEWrappedName RdrName -> IE GhcPs)
-> P (IEWrappedName RdrName) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName RdrName)
nameT
    ImpExpAllWith [LocatedA ImpExpQcSpec]
xs                       ->
      do Bool
allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
PatternSynonymsBit
         if Bool
allowed
          then
            let withs :: [ImpExpQcSpec]
withs = (LocatedA ImpExpQcSpec -> ImpExpQcSpec)
-> [LocatedA ImpExpQcSpec] -> [ImpExpQcSpec]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA ImpExpQcSpec -> ImpExpQcSpec
forall l e. GenLocated l e -> e
unLoc [LocatedA ImpExpQcSpec]
xs
                pos :: IEWildcard
pos   = IEWildcard -> (Int -> IEWildcard) -> Maybe Int -> IEWildcard
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IEWildcard
NoIEWildcard Int -> IEWildcard
IEWildcard
                          ((ImpExpQcSpec -> Bool) -> [ImpExpQcSpec] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ImpExpQcSpec -> Bool
isImpExpQcWildcard [ImpExpQcSpec]
withs)
                ies :: [LocatedA (IEWrappedName RdrName)]
                ies :: [GenLocated SrcSpanAnnA (IEWrappedName RdrName)]
ies   = [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName RdrName)]
forall {l}.
[GenLocated l ImpExpQcSpec]
-> [GenLocated l (IEWrappedName RdrName)]
wrapped ([LocatedA ImpExpQcSpec]
 -> [GenLocated SrcSpanAnnA (IEWrappedName RdrName)])
-> [LocatedA ImpExpQcSpec]
-> [GenLocated SrcSpanAnnA (IEWrappedName RdrName)]
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 RdrName
newName
                        -> XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith EpAnn [AddEpAnn]
XIEThingWith GhcPs
ann (SrcSpanAnnA
-> IEWrappedName RdrName
-> GenLocated SrcSpanAnnA (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName RdrName
newName) IEWildcard
pos [GenLocated SrcSpanAnnA (IEWrappedName RdrName)]
[LIEWrappedName (IdP GhcPs)]
ies)
               (IEWrappedName RdrName -> IE GhcPs)
-> P (IEWrappedName RdrName) -> P (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (IEWrappedName RdrName)
nameT
          else PsError -> P (IE GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P (IE GhcPs)) -> PsError -> P (IE GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrIllegalPatSynExport [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
  where
    name :: RdrName
name = ImpExpQcSpec -> RdrName
ieNameVal ImpExpQcSpec
specname
    nameT :: P (IEWrappedName RdrName)
nameT =
      if NameSpace -> Bool
isVarNameSpace (RdrName -> NameSpace
rdrNameSpace RdrName
name)
        then PsError -> P (IEWrappedName RdrName)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> P (IEWrappedName RdrName))
-> PsError -> P (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (RdrName -> PsErrorDesc
PsErrVarForTyCon RdrName
name) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
        else IEWrappedName RdrName -> P (IEWrappedName RdrName)
forall (m :: * -> *) a. Monad m => a -> m a
return (IEWrappedName RdrName -> P (IEWrappedName RdrName))
-> IEWrappedName RdrName -> P (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ ImpExpQcSpec -> IEWrappedName RdrName
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. String -> a
panic String
"ieNameVal got wildcard"

    ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName RdrName
ieNameFromSpec (ImpExpQcName   GenLocated SrcSpanAnnN RdrName
ln) = GenLocated SrcSpanAnnN RdrName -> IEWrappedName RdrName
forall name. LocatedN name -> IEWrappedName name
IEName   GenLocated SrcSpanAnnN RdrName
ln
    ieNameFromSpec (ImpExpQcType EpaLocation
r GenLocated SrcSpanAnnN RdrName
ln) = EpaLocation
-> GenLocated SrcSpanAnnN RdrName -> IEWrappedName RdrName
forall name. EpaLocation -> LocatedN name -> IEWrappedName name
IEType EpaLocation
r GenLocated SrcSpanAnnN RdrName
ln
    ieNameFromSpec (ImpExpQcSpec
ImpExpQcWildcard)  = String -> IEWrappedName RdrName
forall a. String -> a
panic String
"ieName got wildcard"

    wrapped :: [GenLocated l ImpExpQcSpec]
-> [GenLocated l (IEWrappedName RdrName)]
wrapped = (GenLocated l ImpExpQcSpec -> GenLocated l (IEWrappedName RdrName))
-> [GenLocated l ImpExpQcSpec]
-> [GenLocated l (IEWrappedName RdrName)]
forall a b. (a -> b) -> [a] -> [b]
map ((ImpExpQcSpec -> IEWrappedName RdrName)
-> GenLocated l ImpExpQcSpec
-> GenLocated l (IEWrappedName RdrName)
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc ImpExpQcSpec -> IEWrappedName RdrName
ieNameFromSpec)

mkTypeImpExp :: LocatedN RdrName   -- TcCls or Var name space
             -> P (LocatedN RdrName)
mkTypeImpExp :: GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
mkTypeImpExp GenLocated SrcSpanAnnN RdrName
name =
  do Bool
allowed <- ExtBits -> P Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
ExplicitNamespacesBit
     Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowed (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ PsError -> P ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrIllegalExplicitNamespace [] (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
name)
     GenLocated SrcSpanAnnN RdrName
-> P (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. Monad m => a -> m a
return ((RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
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 (IdP GhcPs)
_ (IEWildcard Int
_) [LIEWrappedName (IdP GhcPs)]
_)) <- [GenLocated SrcSpanAnnA (IE GhcPs)]
[LIE GhcPs]
specs] of
      [] -> LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> P (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
LocatedL [LIE GhcPs]
ie
      (SrcSpanAnnA
l:[SrcSpanAnnA]
_) -> SrcSpan -> P (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall {m :: * -> *} {a}. MonadP m => SrcSpan -> m a
importSpecError (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
  where
    importSpecError :: SrcSpan -> m a
importSpecError SrcSpan
l =
      PsError -> m a
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> m a) -> PsError -> m a
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrIllegalImportBundleForm [] SrcSpan
l

-- In the correct order
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec [] = ([AddEpAnn], ImpExpSubSpec) -> P ([AddEpAnn], ImpExpSubSpec)
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 (m :: * -> *) a. Monad m => a -> m a
return ([AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnDotdot (RealSrcSpan -> EpaLocation
EpaSpan (RealSrcSpan -> EpaLocation) -> RealSrcSpan -> EpaLocation
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> RealSrcSpan
forall a. SrcSpanAnn' a -> RealSrcSpan
la2r 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 (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 (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

-----------------------------------------------------------------------------
-- Warnings and failures

warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule SrcSpan
span =
  WarningFlag -> PsWarning -> P ()
forall (m :: * -> *). MonadP m => WarningFlag -> PsWarning -> m ()
addWarning WarningFlag
Opt_WarnPrepositiveQualifiedModule (SrcSpan -> PsWarning
PsWarnImportPreQualified SrcSpan
span)

failOpNotEnabledImportQualifiedPost :: SrcSpan -> P ()
failOpNotEnabledImportQualifiedPost :: SrcSpan -> P ()
failOpNotEnabledImportQualifiedPost SrcSpan
loc = PsError -> P ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrImportPostQualified [] SrcSpan
loc

failOpImportQualifiedTwice :: SrcSpan -> P ()
failOpImportQualifiedTwice :: SrcSpan -> P ()
failOpImportQualifiedTwice SrcSpan
loc = PsError -> P ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> P ()) -> PsError -> P ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrImportQualifiedTwice [] SrcSpan
loc

warnStarIsType :: SrcSpan -> P ()
warnStarIsType :: SrcSpan -> P ()
warnStarIsType SrcSpan
span = WarningFlag -> PsWarning -> P ()
forall (m :: * -> *). MonadP m => WarningFlag -> PsWarning -> m ()
addWarning WarningFlag
Opt_WarnStarIsType (SrcSpan -> PsWarning
PsWarnStarIsType SrcSpan
span)

failOpFewArgs :: MonadP m => LocatedN RdrName -> m a
failOpFewArgs :: forall (m :: * -> *) a.
MonadP m =>
GenLocated SrcSpanAnnN RdrName -> m a
failOpFewArgs (L SrcSpanAnnN
loc RdrName
op) =
  do { Bool
star_is_type <- ExtBits -> m Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
StarIsTypeBit
     ; PsError -> m a
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> m a) -> PsError -> m a
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (StarIsType -> RdrName -> PsErrorDesc
PsErrOpFewArgs (Bool -> StarIsType
StarIsType Bool
star_is_type) RdrName
op) [] (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) }

-----------------------------------------------------------------------------
-- Misc utils

data PV_Context =
  PV_Context
    { PV_Context -> ParserOpts
pv_options :: ParserOpts
    , PV_Context -> [Hint]
pv_hints   :: [Hint]  -- See Note [Parser-Validator Hint]
    }

data PV_Accum =
  PV_Accum
    { PV_Accum -> Bag PsWarning
pv_warnings        :: Bag PsWarning
    , PV_Accum -> Bag PsError
pv_errors          :: Bag PsError
    , PV_Accum -> Maybe [LEpaComment]
pv_header_comments :: Maybe [LEpaComment]
    , PV_Accum -> [LEpaComment]
pv_comment_q       :: [LEpaComment]
    }

data PV_Result a = PV_Ok PV_Accum a | PV_Failed PV_Accum

-- During parsing, we make use of several monadic effects: reporting parse errors,
-- accumulating warnings, adding API annotations, and checking for extensions. These
-- effects are captured by the 'MonadP' type class.
--
-- Sometimes we need to postpone some of these effects to a later stage due to
-- ambiguities described in Note [Ambiguous syntactic categories].
-- We could use two layers of the P monad, one for each stage:
--
--   abParser :: forall x. DisambAB x => P (P x)
--
-- The outer layer of P consumes the input and builds the inner layer, which
-- validates the input. But this type is not particularly helpful, as it obscures
-- the fact that the inner layer of P never consumes any input.
--
-- For clarity, we introduce the notion of a parser-validator: a parser that does
-- not consume any input, but may fail or use other effects. Thus we have:
--
--   abParser :: forall x. DisambAB x => P (PV x)
--
newtype PV a = PV { forall a. PV a -> PV_Context -> PV_Accum -> PV_Result a
unPV :: PV_Context -> PV_Accum -> PV_Result a }

instance Functor PV where
  fmap :: forall a b. (a -> b) -> PV a -> PV b
fmap = (a -> b) -> PV a -> PV b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative PV where
  pure :: forall a. a -> PV a
pure a
a = a
a a -> PV a -> PV a
`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 = [Hint] -> PV a -> P a
forall a. [Hint] -> PV a -> P a
runPV_hints []

runPV_hints :: [Hint] -> PV a -> P a
runPV_hints :: forall a. [Hint] -> PV a -> P a
runPV_hints [Hint]
hints 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_hints :: [Hint]
pv_hints   = [Hint]
hints }
      pv_acc :: PV_Accum
pv_acc = PV_Accum
        { pv_warnings :: Bag PsWarning
pv_warnings = PState -> Bag PsWarning
warnings PState
s
        , pv_errors :: Bag PsError
pv_errors   = PState -> Bag PsError
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 :: Bag PsWarning
warnings = PV_Accum -> Bag PsWarning
pv_warnings PV_Accum
acc'
          , errors :: Bag PsError
errors   = PV_Accum -> Bag PsError
pv_errors PV_Accum
acc'
          , comment_q :: [LEpaComment]
comment_q = PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
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')

add_hint :: Hint -> PV a -> PV a
add_hint :: forall a. Hint -> PV a -> PV a
add_hint Hint
hint PV a
m =
  let modifyHint :: PV_Context -> PV_Context
modifyHint PV_Context
ctx = PV_Context
ctx{pv_hints :: [Hint]
pv_hints = PV_Context -> [Hint]
pv_hints PV_Context
ctx [Hint] -> [Hint] -> [Hint]
forall a. [a] -> [a] -> [a]
++ [Hint
hint]} in
  (PV_Context -> PV_Accum -> PV_Result a) -> PV a
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV (\PV_Context
ctx PV_Accum
acc -> 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_Context
modifyHint PV_Context
ctx) PV_Accum
acc)

instance MonadP PV where
  addError :: PsError -> PV ()
addError err :: PsError
err@(PsError PsErrorDesc
e [Hint]
hints SrcSpan
loc) =
    (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 ->
      let err' :: PsError
err' | [Hint] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PV_Context -> [Hint]
pv_hints PV_Context
ctx) = PsError
err
               | Bool
otherwise           = PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
e ([Hint]
hints [Hint] -> [Hint] -> [Hint]
forall a. [a] -> [a] -> [a]
++ PV_Context -> [Hint]
pv_hints PV_Context
ctx) SrcSpan
loc
      in PV_Accum -> () -> PV_Result ()
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc{pv_errors :: Bag PsError
pv_errors = PsError
err' PsError -> Bag PsError -> Bag PsError
forall a. a -> Bag a -> Bag a
`consBag` PV_Accum -> Bag PsError
pv_errors PV_Accum
acc} ()
  addWarning :: WarningFlag -> PsWarning -> PV ()
addWarning WarningFlag
option PsWarning
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 ->
      if WarningFlag -> ParserOpts -> Bool
warnopt WarningFlag
option (PV_Context -> ParserOpts
pv_options PV_Context
ctx)
         then PV_Accum -> () -> PV_Result ()
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc{pv_warnings :: Bag PsWarning
pv_warnings= PsWarning
w PsWarning -> Bag PsWarning -> Bag PsWarning
forall a. a -> Bag a -> Bag a
`consBag` PV_Accum -> Bag PsWarning
pv_warnings PV_Accum
acc} ()
         else PV_Accum -> () -> PV_Result ()
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc ()
  addFatalError :: forall a. PsError -> PV a
addFatalError PsError
err =
    PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError PsError
err PV () -> PV a -> PV a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PV_Context -> PV_Accum -> PV_Result a) -> PV a
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Accum -> PV_Result a) -> PV_Context -> PV_Accum -> PV_Result a
forall a b. a -> b -> a
const PV_Accum -> PV_Result a
forall a. PV_Accum -> PV_Result a
PV_Failed)
  getBit :: ExtBits -> PV Bool
getBit ExtBits
ext =
    (PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool)
-> (PV_Context -> PV_Accum -> PV_Result Bool) -> PV Bool
forall a b. (a -> b) -> a -> b
$ \PV_Context
ctx PV_Accum
acc ->
      let b :: Bool
b = ExtBits
ext ExtBits -> ExtsBitmap -> Bool
`xtest` ParserOpts -> ExtsBitmap
pExtsBitmap (PV_Context -> ParserOpts
pv_options PV_Context
ctx) in
      PV_Accum -> Bool -> PV_Result Bool
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
acc (Bool -> PV_Result Bool) -> Bool -> PV_Result Bool
forall a b. (a -> b) -> a -> b
$! Bool
b
  allocateCommentsP :: RealSrcSpan -> PV EpAnnComments
allocateCommentsP RealSrcSpan
ss = (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a. (PV_Context -> PV_Accum -> PV_Result a) -> PV a
PV ((PV_Context -> PV_Accum -> PV_Result EpAnnComments)
 -> PV EpAnnComments)
-> (PV_Context -> PV_Accum -> PV_Result EpAnnComments)
-> PV EpAnnComments
forall a b. (a -> b) -> a -> b
$ \PV_Context
_ PV_Accum
s ->
    let ([LEpaComment]
comment_q', [LEpaComment]
newAnns) = RealSrcSpan -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
allocateComments RealSrcSpan
ss (PV_Accum -> [LEpaComment]
pv_comment_q PV_Accum
s) in
      PV_Accum -> EpAnnComments -> PV_Result EpAnnComments
forall a. PV_Accum -> a -> PV_Result a
PV_Ok PV_Accum
s {
         pv_comment_q :: [LEpaComment]
pv_comment_q = [LEpaComment]
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 :: Maybe [LEpaComment]
pv_header_comments = Maybe [LEpaComment]
header_comments',
         pv_comment_q :: [LEpaComment]
pv_comment_q = [LEpaComment]
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 :: Maybe [LEpaComment]
pv_header_comments = Maybe [LEpaComment]
header_comments',
         pv_comment_q :: [LEpaComment]
pv_comment_q = [LEpaComment]
comment_q'
       } ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced ([LEpaComment] -> Maybe [LEpaComment] -> [LEpaComment]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LEpaComment]
header_comments') ([LEpaComment] -> [LEpaComment]
forall a. [a] -> [a]
reverse [LEpaComment]
newAnns))

{- Note [Parser-Validator Hint]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A PV computation is parametrized by a hint for error messages, which can be set
depending on validation context. We use this in checkPattern to fix #984.

Consider this example, where the user has forgotten a 'do':

  f _ = do
    x <- computation
    case () of
      _ ->
        result <- computation
        case () of () -> undefined

GHC parses it as follows:

  f _ = do
    x <- computation
    (case () of
      _ ->
        result) <- computation
        case () of () -> undefined

Note that this fragment is parsed as a pattern:

  case () of
    _ ->
      result

We attempt to detect such cases and add a hint to the error messages:

  T984.hs:6:9:
    Parse error in pattern: case () of { _ -> result }
    Possibly caused by a missing 'do'?

The "Possibly caused by a missing 'do'?" suggestion is the hint that is passed
as the 'pv_hints' field 'PV_Context'. When validating in a context other than
'bindpat' (a pattern to the left of <-), we set the hint to 'empty' and it has
no effect on the error messages.

-}

-- | Hint about bang patterns, assuming @BangPatterns@ is off.
hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat SrcSpan
span Pat GhcPs
e = do
    Bool
bang_on <- ExtBits -> PV Bool
forall (m :: * -> *). MonadP m => ExtBits -> m Bool
getBit ExtBits
BangPatBit
    Bool -> PV () -> PV ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
bang_on (PV () -> PV ()) -> PV () -> PV ()
forall a b. (a -> b) -> a -> b
$
      PsError -> PV ()
forall (m :: * -> *). MonadP m => PsError -> m ()
addError (PsError -> PV ()) -> PsError -> PV ()
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (Pat GhcPs -> PsErrorDesc
PsErrIllegalBangPattern Pat GhcPs
e) [] SrcSpan
span

mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)
                 -> [AddEpAnn]
                 -> PV (LHsExpr GhcPs)

-- Tuple
mkSumOrTupleExpr :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (HsExpr GhcPs)
-> [AddEpAnn]
-> PV (LHsExpr GhcPs)
mkSumOrTupleExpr SrcSpanAnnA
l Boxity
boxity (Tuple [Either
   (EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
es) [AddEpAnn]
anns = do
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XExplicitTuple GhcPs -> [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) ((Either (EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> HsTupArg GhcPs)
-> [Either
      (EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [HsTupArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Either (EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsTupArg GhcPs
Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg [Either
   (EpAnn EpaLocation) (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
es) Boxity
boxity)
  where
    toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
    toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg (Left EpAnn EpaLocation
ann) = EpAnn EpaLocation -> HsTupArg GhcPs
missingTupArg EpAnn EpaLocation
ann
    toTupArg (Right LHsExpr GhcPs
a)  = XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
forall a. EpAnn a
noAnn LHsExpr GhcPs
a

-- Sum
-- mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
--     return $ L l (ExplicitSum noExtField alt arity e)
mkSumOrTupleExpr SrcSpanAnnA
l Boxity
Unboxed (Sum Int
alt Int
arity GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [EpaLocation]
barsp [EpaLocation]
barsa) [AddEpAnn]
anns = do
    let an :: AnnExplicitSum
an = case [AddEpAnn]
anns of
               [AddEpAnn AnnKeywordId
AnnOpenPH EpaLocation
o, AddEpAnn AnnKeywordId
AnnClosePH EpaLocation
c] ->
                 EpaLocation
-> [EpaLocation] -> [EpaLocation] -> EpaLocation -> AnnExplicitSum
AnnExplicitSum EpaLocation
o [EpaLocation]
barsp [EpaLocation]
barsa EpaLocation
c
               [AddEpAnn]
_ -> String -> AnnExplicitSum
forall a. String -> a
panic String
"mkSumOrTupleExpr"
    EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XExplicitSum GhcPs -> Int -> Int -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
ExplicitSum (Anchor -> AnnExplicitSum -> EpAnnComments -> EpAnn AnnExplicitSum
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) AnnExplicitSum
an EpAnnComments
cs) Int
alt Int
arity GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e)
mkSumOrTupleExpr SrcSpanAnnA
l Boxity
Boxed a :: SumOrTuple (HsExpr GhcPs)
a@Sum{} [AddEpAnn]
_ =
    PsError -> PV (LHsExpr GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LHsExpr GhcPs)) -> PsError -> PV (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (SumOrTuple (HsExpr GhcPs) -> PsErrorDesc
PsErrUnsupportedBoxedSumExpr SumOrTuple (HsExpr GhcPs)
a) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)

mkSumOrTuplePat
  :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> [AddEpAnn]
  -> PV (LocatedA (PatBuilder GhcPs))

-- Tuple
mkSumOrTuplePat :: SrcSpanAnnA
-> Boxity
-> SumOrTuple (PatBuilder GhcPs)
-> [AddEpAnn]
-> PV (LocatedA (PatBuilder GhcPs))
mkSumOrTuplePat SrcSpanAnnA
l Boxity
boxity (Tuple [Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))]
ps) [AddEpAnn]
anns = do
  [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- (Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
 -> PV (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))]
-> PV [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
-> PV (GenLocated SrcSpanAnnA (Pat GhcPs))
Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
toTupPat [Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))]
ps
  EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
  LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XTuplePat GhcPs -> [LPat GhcPs] -> Boxity -> Pat GhcPs
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat (Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) [AddEpAnn]
anns EpAnnComments
cs) [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
ps' Boxity
boxity))
  where
    toTupPat :: Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs)
    -- Ignore the element location so that the error message refers to the
    -- entire tuple. See #19504 (and the discussion) for details.
    toTupPat :: Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
-> PV (LPat GhcPs)
toTupPat Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
p = case Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs))
p of
      Left EpAnn EpaLocation
_ -> PsError -> PV (LPat GhcPs)
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LPat GhcPs)) -> PsError -> PV (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError PsErrorDesc
PsErrTupleSectionInPat [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
      Right LocatedA (PatBuilder GhcPs)
p' -> LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
p'

-- Sum
mkSumOrTuplePat SrcSpanAnnA
l Boxity
Unboxed (Sum Int
alt Int
arity LocatedA (PatBuilder GhcPs)
p [EpaLocation]
barsb [EpaLocation]
barsa) [AddEpAnn]
anns = do
   GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
checkLPat LocatedA (PatBuilder GhcPs)
p
   EpAnnComments
cs <- SrcSpan -> PV EpAnnComments
forall (m :: * -> *). MonadP m => SrcSpan -> m EpAnnComments
getCommentsFor (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
   let an :: EpAnn EpAnnSumPat
an = Anchor -> EpAnnSumPat -> EpAnnComments -> EpAnn EpAnnSumPat
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) ([AddEpAnn] -> [EpaLocation] -> [EpaLocation] -> EpAnnSumPat
EpAnnSumPat [AddEpAnn]
anns [EpaLocation]
barsb [EpaLocation]
barsa) EpAnnComments
cs
   LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs)))
-> LocatedA (PatBuilder GhcPs) -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> PatBuilder GhcPs -> LocatedA (PatBuilder GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Pat GhcPs -> PatBuilder GhcPs
forall p. Pat p -> PatBuilder p
PatBuilderPat (XSumPat GhcPs -> LPat GhcPs -> Int -> Int -> Pat GhcPs
forall p. XSumPat p -> LPat p -> Int -> Int -> Pat p
SumPat EpAnn EpAnnSumPat
XSumPat GhcPs
an GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
p' Int
alt Int
arity))
mkSumOrTuplePat SrcSpanAnnA
l Boxity
Boxed a :: SumOrTuple (PatBuilder GhcPs)
a@Sum{} [AddEpAnn]
_ =
    PsError -> PV (LocatedA (PatBuilder GhcPs))
forall (m :: * -> *) a. MonadP m => PsError -> m a
addFatalError (PsError -> PV (LocatedA (PatBuilder GhcPs)))
-> PsError -> PV (LocatedA (PatBuilder GhcPs))
forall a b. (a -> b) -> a -> b
$ PsErrorDesc -> [Hint] -> SrcSpan -> PsError
PsError (SumOrTuple (PatBuilder GhcPs) -> PsErrorDesc
PsErrUnsupportedBoxedSumPat SumOrTuple (PatBuilder GhcPs)
a) [] (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)

mkLHsOpTy :: LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> LHsType GhcPs
mkLHsOpTy :: LHsType GhcPs
-> GenLocated SrcSpanAnnN RdrName -> LHsType GhcPs -> LHsType GhcPs
mkLHsOpTy 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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
x SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
`combineSrcSpansA` (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
op) SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
`combineSrcSpansA` GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
y
  in SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LHsType GhcPs
-> LocatedN (IdP GhcPs) -> LHsType GhcPs -> HsType GhcPs
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsType (GhcPass p)
-> LocatedN (IdP (GhcPass p))
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
mkHsOpTy LHsType GhcPs
x GenLocated SrcSpanAnnN RdrName
LocatedN (IdP GhcPs)
op LHsType GhcPs
y)

mkMultTy :: IsUnicodeSyntax -> Located Token -> LHsType GhcPs -> HsArrow GhcPs
mkMultTy :: IsUnicodeSyntax -> Located Token -> LHsType GhcPs -> HsArrow GhcPs
mkMultTy IsUnicodeSyntax
u Located Token
tok t :: LHsType GhcPs
t@(L SrcSpanAnnA
_ (HsTyLit XTyLit GhcPs
_ (HsNumTy (SourceText String
"1") Integer
1)))
  -- See #18888 for the use of (SourceText "1") above
  = IsUnicodeSyntax -> Maybe AddEpAnn -> HsArrow GhcPs
forall pass. IsUnicodeSyntax -> Maybe AddEpAnn -> HsArrow pass
HsLinearArrow IsUnicodeSyntax
u (AddEpAnn -> Maybe AddEpAnn
forall a. a -> Maybe a
Just (AddEpAnn -> Maybe AddEpAnn) -> AddEpAnn -> Maybe AddEpAnn
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnPercentOne (RealSrcSpan -> EpaLocation
EpaSpan (RealSrcSpan -> EpaLocation) -> RealSrcSpan -> EpaLocation
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Located Token -> Located (HsType GhcPs) -> SrcSpan
forall a b. Located a -> Located b -> SrcSpan
combineLocs Located Token
tok (GenLocated SrcSpanAnnA (HsType GhcPs) -> Located (HsType GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t)))
mkMultTy IsUnicodeSyntax
u Located Token
tok LHsType GhcPs
t = IsUnicodeSyntax -> Maybe AddEpAnn -> LHsType GhcPs -> HsArrow GhcPs
forall pass.
IsUnicodeSyntax -> Maybe AddEpAnn -> LHsType pass -> HsArrow pass
HsExplicitMult IsUnicodeSyntax
u (AddEpAnn -> Maybe AddEpAnn
forall a. a -> Maybe a
Just (AddEpAnn -> Maybe AddEpAnn) -> AddEpAnn -> Maybe AddEpAnn
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnPercent (RealSrcSpan -> EpaLocation
EpaSpan (RealSrcSpan -> EpaLocation) -> RealSrcSpan -> EpaLocation
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Located Token -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located Token
tok)) LHsType GhcPs
t

-----------------------------------------------------------------------------
-- Token symbols

starSym :: Bool -> String
starSym :: Bool -> String
starSym Bool
True = String
"★"
starSym Bool
False = String
"*"

-----------------------------------------
-- Bits and pieces for RecordDotSyntax.

mkRdrGetField :: SrcSpanAnnA -> LHsExpr GhcPs -> Located (HsFieldLabel GhcPs)
  -> EpAnnCO -> LHsExpr GhcPs
mkRdrGetField :: SrcSpanAnnA
-> LHsExpr GhcPs
-> Located (HsFieldLabel GhcPs)
-> EpAnnCO
-> LHsExpr GhcPs
mkRdrGetField SrcSpanAnnA
loc LHsExpr GhcPs
arg Located (HsFieldLabel GhcPs)
field EpAnnCO
anns =
  SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsGetField {
      gf_ext :: XGetField GhcPs
gf_ext = EpAnnCO
XGetField GhcPs
anns
    , gf_expr :: LHsExpr GhcPs
gf_expr = LHsExpr GhcPs
arg
    , gf_field :: Located (HsFieldLabel GhcPs)
gf_field = Located (HsFieldLabel GhcPs)
field
    }

mkRdrProjection :: [Located (HsFieldLabel GhcPs)] -> EpAnn AnnProjection -> HsExpr GhcPs
mkRdrProjection :: [Located (HsFieldLabel GhcPs)]
-> EpAnn AnnProjection -> HsExpr GhcPs
mkRdrProjection [] EpAnn AnnProjection
_ = String -> HsExpr GhcPs
forall a. String -> a
panic String
"mkRdrProjection: The impossible has happened!"
mkRdrProjection [Located (HsFieldLabel GhcPs)]
flds EpAnn AnnProjection
anns =
  HsProjection {
      proj_ext :: XProjection GhcPs
proj_ext = EpAnn AnnProjection
XProjection GhcPs
anns
    , proj_flds :: [Located (HsFieldLabel GhcPs)]
proj_flds = [Located (HsFieldLabel GhcPs)]
flds
    }

mkRdrProjUpdate :: SrcSpanAnnA -> Located [Located (HsFieldLabel GhcPs)]
                -> LHsExpr GhcPs -> Bool -> EpAnn [AddEpAnn]
                -> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate :: SrcSpanAnnA
-> Located [Located (HsFieldLabel GhcPs)]
-> LHsExpr GhcPs
-> Bool
-> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate SrcSpanAnnA
_ (L SrcSpan
_ []) LHsExpr GhcPs
_ Bool
_ EpAnn [AddEpAnn]
_ = String
-> GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. String -> a
panic String
"mkRdrProjUpdate: The impossible has happened!"
mkRdrProjUpdate SrcSpanAnnA
loc (L SrcSpan
l [Located (HsFieldLabel GhcPs)]
flds) LHsExpr GhcPs
arg Bool
isPun EpAnn [AddEpAnn]
anns =
  SrcSpanAnnA
-> HsRecField'
     (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsRecField {
      hsRecFieldAnn :: XHsRecField (FieldLabelStrings GhcPs)
hsRecFieldAnn = EpAnn [AddEpAnn]
XHsRecField (FieldLabelStrings GhcPs)
anns
    , hsRecFieldLbl :: Located (FieldLabelStrings GhcPs)
hsRecFieldLbl = SrcSpan
-> FieldLabelStrings GhcPs -> Located (FieldLabelStrings GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l ([Located (HsFieldLabel GhcPs)] -> FieldLabelStrings GhcPs
forall p. [Located (HsFieldLabel p)] -> FieldLabelStrings p
FieldLabelStrings [Located (HsFieldLabel GhcPs)]
flds)
    , hsRecFieldArg :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
hsRecFieldArg = GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg
    , hsRecPun :: Bool
hsRecPun = Bool
isPun
  }