    {-# OPTIONS_HADDOCK hide #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE PatternGuards #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.Haskell.Exts.ParseUtils
    -- Copyright   :  (c) Niklas Broberg 2004-2009,
    --                (c) The GHC Team, 1997-2000
    -- License     :  BSD-style (see the file LICENSE.txt)
    --
    -- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- Utilities for the Haskell-exts parser.
    --
    -----------------------------------------------------------------------------

    module Language.Haskell.Exts.ParseUtils (
          splitTyConApp         -- PType -> P (Name,[Type])
        , checkEnabled          -- (Show e, Enabled e) => e -> P ()
        , checkEnabledOneOf
        , checkToplevel         -- ??
        , checkPatternGuards    -- [Stmt] -> P ()
        , mkRecConstrOrUpdate   -- PExp -> [PFieldUpdate] -> P Exp
        , checkPrec             -- Integer -> P Int
        , checkPContext         -- PType -> P PContext
        , checkContext          -- PContext -> P Context
        , checkAssertion        -- PType -> P PAsst
        , checkDataHeader       -- PType -> P (Context,Name,[TyVarBind])
        , checkClassHeader      -- PType -> P (Context,Name,[TyVarBind])
        , checkInstHeader       -- PType -> P (Context,QName,[Type])
        , checkDeriving         -- [PType] -> P [Deriving]
        , checkPattern          -- PExp -> P Pat
        , checkExpr             -- PExp -> P Exp
        , checkType             -- PType -> P Type
        , checkTyVar            -- Name  -> P PType
        , bangType              -- L -> BangType -> Type -> Type
        , checkKind             -- Kind -> P ()
        , checkValDef           -- SrcLoc -> PExp -> Maybe Type -> Rhs -> Binds -> P Decl
        , checkExplicitPatSyn   --
        , checkClassBody        -- [ClassDecl] -> P [ClassDecl]
        , checkInstBody         -- [InstDecl] -> P [InstDecl]
        , checkUnQual           -- QName -> P Name
        , checkQualOrUnQual     -- QName -> P QName
        , checkSingleDecl       -- [Decl] -> P Decl
        , checkRevDecls         -- [Decl] -> P [Decl]
        , checkRevClsDecls      -- [ClassDecl] -> P [ClassDecl]
        , checkRevInstDecls     -- [InstDecl] -> P [InstDecl]
        , checkDataOrNew        -- DataOrNew -> [QualConDecl] -> P ()
        , checkDataOrNewG       -- DataOrNew -> [GadtDecl] -> P ()
        , checkSimpleType       -- PType -> P (Name, [TyVarBind])
        , checkSigVar           -- PExp -> P Name
        , checkDefSigDef        -- Decl -> P Decl
        , getGConName           -- S.Exp -> P QName
        , mkTyForall            -- Maybe [TyVarBind] -> PContext -> PType -> PType
        , mkRoleAnnotDecl       --
        , mkAssocType
        , mkEThingWith
        , splitTilde
        -- HaRP
        , checkRPattern         -- PExp -> P RPat
        -- Hsx
        , checkEqNames          -- XName -> XName -> P XName
        , checkPageModule
        , checkHybridModule
        , mkDVar                -- [String] -> String
        -- Pragmas
        , checkRuleExpr         -- PExp -> P Exp
        , readTool              -- Maybe String -> Maybe Tool
        -- Helpers
        , updateQNameLoc        -- l -> QName l -> QName l

        , SumOrTuple(..), mkSumOrTuple

        -- Parsed expressions and types
        , PExp(..), PFieldUpdate(..), ParseXAttr(..), PType(..), PContext, PAsst(..)
        , p_unit_con            -- PExp
        , p_tuple_con           -- Boxed -> Int -> PExp
        , p_unboxed_singleton_con   -- PExp
        , pexprToQName
        ) where

    import Language.Haskell.Exts.Syntax hiding ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) )
    import qualified Language.Haskell.Exts.Syntax as S ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..), Role(..), PatternSynDirection(..))

    import Language.Haskell.Exts.ParseSyntax
    import Language.Haskell.Exts.ParseMonad
    import Language.Haskell.Exts.Pretty
    import Language.Haskell.Exts.SrcLoc hiding (loc)
    import Language.Haskell.Exts.Extension
    import Language.Haskell.Exts.ExtScheme

    import Prelude hiding (mod)
    import Data.List (intercalate, intersperse)
    import Data.Maybe (fromJust, fromMaybe)
    import Data.Either
    import Control.Monad (when,unless)

    #if __GLASGOW_HASKELL__ < 710
    import Control.Applicative ((<$>))
    #endif

    type L = SrcSpanInfo
    type S = SrcSpan

    pexprToQName :: PExp l -> P (QName l)
    pexprToQName :: forall l. PExp l -> P (QName l)
    pexprToQName (Con l
    _ QName l
    qn) = QName l -> P (QName l)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName l
    qn
    pexprToQName (List l
    l []) = QName l -> P (QName l)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName l -> P (QName l)) -> QName l -> P (QName l)
    forall a b. (a -> b) -> a -> b
    $ l -> SpecialCon l -> QName l
    forall l. l -> SpecialCon l -> QName l
    Special l
    l (l -> SpecialCon l
    forall l. l -> SpecialCon l
    ListCon l
    l)
    pexprToQName PExp l
    _ = String -> P (QName l)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "pexprToQName"

    splitTyConApp :: PType L -> P (Name L, [S.Type L])
    splitTyConApp :: PType L -> P (Name L, [Type L])
    splitTyConApp PType L
    t0 = do
                (n, pts) <- PType L -> [PType L] -> P (Name L, [PType L])
    split PType L
    t0 []
                ts <- mapM checkType pts
                return (n,ts)
     where
        split :: PType L -> [PType L] -> P (Name L, [PType L])
        split :: PType L -> [PType L] -> P (Name L, [PType L])
    split (TyApp L
    _ PType L
    t PType L
    u) [PType L]
    ts = PType L -> [PType L] -> P (Name L, [PType L])
    split PType L
    t (PType L
    uPType L -> [PType L] -> [PType L]
    forall a. a -> [a] -> [a]
    :[PType L]
    ts)
        split (TyCon L
    _ (UnQual L
    _ Name L
    t)) [PType L]
    ts = (Name L, [PType L]) -> P (Name L, [PType L])
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name L
    t,[PType L]
    ts)
        split (TyInfix L
    l PType L
    a MaybePromotedName L
    op PType L
    b) [PType L]
    ts = PType L -> [PType L] -> P (Name L, [PType L])
    split (L -> QName L -> PType L
    forall l. l -> QName l -> PType l
    TyCon L
    l (MaybePromotedName L -> QName L
    forall l. MaybePromotedName l -> QName l
    getMaybePromotedQName MaybePromotedName L
    op)) (PType L
    aPType L -> [PType L] -> [PType L]
    forall a. a -> [a] -> [a]
    :PType L
    bPType L -> [PType L] -> [PType L]
    forall a. a -> [a] -> [a]
    :[PType L]
    ts)
        split PType L
    _ [PType L]
    _ = String -> P (Name L, [PType L])
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal data/newtype declaration"

    -----------------------------------------------------------------------------
    -- Checking for extensions

    checkEnabled :: (Show e, Enabled e) => e  -> P ()
    checkEnabled :: forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled e
    e = do
        exts <- P [KnownExtension]
    getExtensions
        unless (isEnabled e exts) $ fail errorMsg
     where errorMsg :: String
    errorMsg = [String] -> String
    unwords
              [ e -> String
    forall a. Show a => a -> String
    show e
    e
              , String
    "language extension is not enabled."
              , String
    "Please add {-# LANGUAGE " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ e -> String
    forall a. Show a => a -> String
    show e
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    " #-}"
              , String
    "pragma at the top of your module."
              ]

    checkEnabledOneOf :: (Show e, Enabled e) => [e] -> P ()
    checkEnabledOneOf :: forall e. (Show e, Enabled e) => [e] -> P ()
    checkEnabledOneOf [e]
    es = do
        exts <- P [KnownExtension]
    getExtensions
        unless (any (`isEnabled` exts) es) $
            fail errorMsg
      where errorMsg :: String
    errorMsg = [String] -> String
    unwords
              [ String
    "At least one of"
              , (String -> String) -> String
    joinOr String -> String
    forall a. a -> a
    id
              , String
    "language extensions needs to be enabled."
              , String
    "Please add:"
              , (String -> String) -> String
    joinOr (\String
    s -> String
    "{-# LANGUAGE " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " #-}")
              , String
    "language pragma at the top of your module."
              ]
            joinOr :: (String -> String) -> String
    joinOr String -> String
    f = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String) -> ([e] -> [String]) -> [e] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    " or "  ([String] -> [String]) -> ([e] -> [String]) -> [e] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (e -> String) -> [e] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String
    f (String -> String) -> (e -> String) -> e -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> String
    forall a. Show a => a -> String
    show) ([e] -> String) -> [e] -> String
    forall a b. (a -> b) -> a -> b
    $ [e]
    es

    checkPatternGuards :: [Stmt L] -> P ()
    checkPatternGuards :: [Stmt L] -> P ()
    checkPatternGuards [Qualifier L
    _ Exp L
    _] = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkPatternGuards [Stmt L]
    _ = KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    PatternGuards

    checkToplevel :: PExp t -> P ()
    checkToplevel :: forall t. PExp t -> P ()
    checkToplevel PExp t
    e = do
        exts <- P [KnownExtension]
    getExtensions
        let isQQ = case PExp t
    e of
                QuasiQuote {} -> KnownExtension -> [KnownExtension] -> Bool
    forall a. Enabled a => a -> [KnownExtension] -> Bool
    isEnabled KnownExtension
    QuasiQuotes [KnownExtension]
    exts
                PExp t
    _ -> Bool
    False
        unless isQQ (checkEnabled TemplateHaskell)

    -----------------------------------------------------------------------------
    -- Checking contexts

    -- Check that a context is syntactically correct. Takes care of
    -- checking for MPTCs, TypeOperators, TypeFamilies (for eq constraints)
    -- and ImplicitParameters, but leaves checking of the class assertion
    -- parameters for later.
    checkPContext :: PType L -> P (PContext L)
    checkPContext :: PType L -> P (PContext L)
    checkPContext (TyTuple L
    l Boxed
    Boxed [PType L]
    ts) =
        (PType L -> P (PAsst L)) -> [PType L] -> P [PAsst L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PType L -> P (PAsst L)
    checkAssertion [PType L]
    ts P [PAsst L] -> ([PAsst L] -> P (PContext L)) -> P (PContext L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= PContext L -> P (PContext L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PContext L -> P (PContext L))
    -> ([PAsst L] -> PContext L) -> [PAsst L] -> P (PContext L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> [PAsst L] -> PContext L
    forall l. l -> [PAsst l] -> PContext l
    CxTuple L
    l
    checkPContext (TyCon L
    l (Special L
    _ (UnitCon L
    _))) =
        PContext L -> P (PContext L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PContext L -> P (PContext L)) -> PContext L -> P (PContext L)
    forall a b. (a -> b) -> a -> b
    $ L -> PContext L
    forall l. l -> PContext l
    CxEmpty L
    l
    checkPContext (TyParen L
    l PType L
    t) = do
        c <- PType L -> P (PAsst L)
    checkAssertion PType L
    t
        return $ CxSingle l (ParenA l c)
    checkPContext t :: PType L
    t@(TyEquals L
    tp PType L
    _ PType L
    _) = do
      [KnownExtension] -> P ()
    forall e. (Show e, Enabled e) => [e] -> P ()
    checkEnabledOneOf [KnownExtension
    TypeFamilies, KnownExtension
    GADTs]
      PContext L -> P (PContext L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PContext L -> P (PContext L)) -> PContext L -> P (PContext L)
    forall a b. (a -> b) -> a -> b
    $ L -> PAsst L -> PContext L
    forall l. l -> PAsst l -> PContext l
    CxSingle L
    tp (PAsst L -> PContext L) -> PAsst L -> PContext L
    forall a b. (a -> b) -> a -> b
    $ L -> PType L -> PAsst L
    forall l. l -> PType l -> PAsst l
    TypeA L
    tp PType L
    t

    checkPContext PType L
    t = do
        c <- PType L -> P (PAsst L)
    checkAssertion PType L
    t
        return $ CxSingle (ann c) c

    ------------------------------------------------------------------------------------------------------------------- WORKING HERE

    -- Check a single assertion according to the above, still leaving
    -- the class assertion parameters for later.
    checkAssertion :: PType L -> P (PAsst L)
    -- We cannot even get here unless ImplicitParameters is enabled.
    checkAssertion :: PType L -> P (PAsst L)
    checkAssertion (TyParen L
    l PType L
    asst) = do
        asst' <- PType L -> P (PAsst L)
    checkAssertion PType L
    asst
        return $ ParenA l asst'
    checkAssertion (TyPred L
    _ PAsst L
    p) = PAsst L -> P (PAsst L)
    checkAAssertion PAsst L
    p
    -- We cannot even get here unless TypeFamilies or GADTs is enabled.
    -- N.B.: this is called only when the equality assertion is part of a
    -- tuple
    checkAssertion PType L
    t' = do
            t'' <- (L -> L) -> [PType L] -> PType L -> P (PType L)
    checkAssertion' L -> L
    forall a. a -> a
    id [] PType L
    t'
            return $ TypeA (ann t'') t''
        where   -- class assertions must have at least one argument
                checkAssertion' :: (L -> L) -> [PType L] -> PType L -> P (PType L)
    checkAssertion' L -> L
    _ [PType L]
    _ t :: PType L
    t@(TyEquals L
    _ PType L
    _ PType L
    _) = PType L -> P (PType L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PType L
    t
                checkAssertion' L -> L
    fl [PType L]
    ts (TyCon L
    l QName L
    c) = do
                    Bool -> P () -> P ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([PType L] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [PType L]
    ts Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1) (P () -> P ()) -> P () -> P ()
    forall a b. (a -> b) -> a -> b
    $ KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    FlexibleContexts
                    QName L -> P ()
    checkAndWarnTypeOperators QName L
    c
                    PType L -> P (PType L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PType L -> P (PType L)) -> PType L -> P (PType L)
    forall a b. (a -> b) -> a -> b
    $ L -> PType L -> [PType L] -> PType L
    tyApps (L -> L
    fl L
    l) (L -> QName L -> PType L
    forall l. l -> QName l -> PType l
    TyCon (L -> L
    fl L
    l) QName L
    c) [PType L]
    ts
                checkAssertion' L -> L
    fl [PType L]
    ts (TyApp L
    l PType L
    a PType L
    t) =
                    -- no check on t at this stage
                    (L -> L) -> [PType L] -> PType L -> P (PType L)
    checkAssertion' (L -> L -> L
    forall a b. a -> b -> a
    const (L -> L
    fl L
    l)) (PType L
    tPType L -> [PType L] -> [PType L]
    forall a. a -> [a] -> [a]
    :[PType L]
    ts) PType L
    a
                checkAssertion' L -> L
    fl [PType L]
    _ (TyInfix L
    l PType L
    a MaybePromotedName L
    op PType L
    b) = do
                    -- infix operators require TypeOperators
                    QName L -> P ()
    checkAndWarnTypeOperators (MaybePromotedName L -> QName L
    forall l. MaybePromotedName l -> QName l
    getMaybePromotedQName MaybePromotedName L
    op)
                    PType L -> P (PType L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PType L -> P (PType L)) -> PType L -> P (PType L)
    forall a b. (a -> b) -> a -> b
    $ L -> PType L -> MaybePromotedName L -> PType L -> PType L
    forall l. l -> PType l -> MaybePromotedName l -> PType l -> PType l
    TyInfix (L -> L
    fl L
    l) PType L
    a MaybePromotedName L
    op PType L
    b
                checkAssertion' L -> L
    fl [PType L]
    ts (TyParen L
    l PType L
    t) =
                    (L -> L) -> [PType L] -> PType L -> P (PType L)
    checkAssertion' (L -> L -> L
    forall a b. a -> b -> a
    const (L -> L
    fl L
    l)) [PType L]
    ts PType L
    t
                checkAssertion' L -> L
    fl [PType L]
    ts (TyVar L
    l Name L
    t) = do -- Dict :: cxt => Dict cxt
                    KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    ConstraintKinds
                    PType L -> P (PType L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PType L -> P (PType L)) -> PType L -> P (PType L)
    forall a b. (a -> b) -> a -> b
    $ L -> PType L -> [PType L] -> PType L
    tyApps (L -> L
    fl L
    l) (L -> Name L -> PType L
    forall l. l -> Name l -> PType l
    TyVar (L -> L
    fl L
    l) Name L
    t) [PType L]
    ts
                checkAssertion' L -> L
    _ [PType L]
    _ t :: PType L
    t@(TyWildCard L
    _ Maybe (Name L)
    _) = PType L -> P (PType L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PType L
    t
                checkAssertion' L -> L
    _ [PType L]
    _ PType L
    t = do
                    KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    QuantifiedConstraints -- anything goes
                    PType L -> P (PType L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PType L
    t
                tyApps :: L -> PType L -> [PType L] -> PType L
                tyApps :: L -> PType L -> [PType L] -> PType L
    tyApps L
    _ PType L
    c [] = PType L
    c
                tyApps L
    l PType L
    c (PType L
    a:[PType L]
    aa) = L -> PType L -> [PType L] -> PType L
    tyApps L
    l (L -> PType L -> PType L -> PType L
    forall l. l -> PType l -> PType l -> PType l
    TyApp L
    l PType L
    c PType L
    a) [PType L]
    aa

    checkAAssertion :: PAsst L -> P (PAsst L)
    checkAAssertion :: PAsst L -> P (PAsst L)
    checkAAssertion (TypeA L
    _ PType L
    t) = PType L -> P (PAsst L)
    checkAssertion PType L
    t
    checkAAssertion (ParenA L
    l PAsst L
    a) = do
        a' <- PAsst L -> P (PAsst L)
    checkAAssertion PAsst L
    a
        return $ ParenA l a'
    checkAAssertion PAsst L
    p = PAsst L -> P (PAsst L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PAsst L
    p

    -- Check class/instance declaration for multiparams
    checkMultiParam :: PType L -> P ()
    checkMultiParam :: PType L -> P ()
    checkMultiParam = [PType L] -> PType L -> P ()
    forall {l}. [PType l] -> PType l -> P ()
    checkMultiParam' []
        where
            checkMultiParam' :: [PType l] -> PType l -> P ()
    checkMultiParam' [PType l]
    ts (TyCon l
    _ QName l
    _) =
                Bool -> P () -> P ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([PType l] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [PType l]
    ts Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    1) (P () -> P ()) -> P () -> P ()
    forall a b. (a -> b) -> a -> b
    $ KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    MultiParamTypeClasses
            checkMultiParam' [PType l]
    ts (TyApp l
    _ PType l
    a PType l
    t) = [PType l] -> PType l -> P ()
    checkMultiParam' (PType l
    tPType l -> [PType l] -> [PType l]
    forall a. a -> [a] -> [a]
    :[PType l]
    ts) PType l
    a
            checkMultiParam' [PType l]
    _ (TyInfix l
    _ PType l
    _ MaybePromotedName l
    _ PType l
    _) = KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    MultiParamTypeClasses
            checkMultiParam' [PType l]
    ts (TyParen l
    _ PType l
    t) = [PType l] -> PType l -> P ()
    checkMultiParam' [PType l]
    ts PType l
    t
            checkMultiParam' [PType l]
    _ PType l
    _ = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    getSymbol :: QName L -> Maybe String
    getSymbol :: QName L -> Maybe String
    getSymbol (UnQual L
    _ (Symbol L
    _ String
    s)) = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s
    getSymbol (Qual L
    _ ModuleName L
    _ (Symbol L
    _ String
    s)) = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s
    getSymbol QName L
    _                       = Maybe String
    forall a. Maybe a
    Nothing

    -- | Checks whether the parameter is a symbol, and gives a nice warning for
    -- "." if ExplicitForAll/TypeOperators are not enabled.
    checkAndWarnTypeOperators :: QName L -> P ()
    checkAndWarnTypeOperators :: QName L -> P ()
    checkAndWarnTypeOperators QName L
    c =
        case QName L -> Maybe String
    getSymbol QName L
    c of
            Just String
    s | String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "."  -> [KnownExtension] -> P ()
    forall e. (Show e, Enabled e) => [e] -> P ()
    checkEnabledOneOf [KnownExtension
    ExplicitForAll, KnownExtension
    TypeOperators]
                   | Bool
    otherwise -> KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    TypeOperators
            Maybe String
    Nothing -> () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- Checks simple contexts for class and instance
    -- headers. If FlexibleContexts is enabled then
    -- anything goes, otherwise only tyvars are allowed.
    checkSContext :: Maybe (PContext L) -> P (Maybe (S.Context L))
    checkSContext :: Maybe (PContext L) -> P (Maybe (Context L))
    checkSContext (Just PContext L
    ctxt) = case PContext L
    ctxt of
        CxEmpty L
    l -> Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Context L) -> P (Maybe (Context L)))
    -> Maybe (Context L) -> P (Maybe (Context L))
    forall a b. (a -> b) -> a -> b
    $ Context L -> Maybe (Context L)
    forall a. a -> Maybe a
    Just (Context L -> Maybe (Context L)) -> Context L -> Maybe (Context L)
    forall a b. (a -> b) -> a -> b
    $ L -> Context L
    forall l. l -> Context l
    S.CxEmpty L
    l
        CxSingle L
    l PAsst L
    a -> PAsst L -> P (Asst L)
    checkAsst PAsst L
    a P (Asst L)
    -> (Asst L -> P (Maybe (Context L))) -> P (Maybe (Context L))
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Context L) -> P (Maybe (Context L)))
    -> (Asst L -> Maybe (Context L)) -> Asst L -> P (Maybe (Context L))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context L -> Maybe (Context L)
    forall a. a -> Maybe a
    Just (Context L -> Maybe (Context L))
    -> (Asst L -> Context L) -> Asst L -> Maybe (Context L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> Asst L -> Context L
    forall l. l -> Asst l -> Context l
    S.CxSingle L
    l
        CxTuple L
    l [PAsst L]
    as -> (PAsst L -> P (Asst L)) -> [PAsst L] -> P [Asst L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PAsst L -> P (Asst L)
    checkAsst [PAsst L]
    as P [Asst L]
    -> ([Asst L] -> P (Maybe (Context L))) -> P (Maybe (Context L))
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Context L) -> P (Maybe (Context L)))
    -> ([Asst L] -> Maybe (Context L))
    -> [Asst L]
    -> P (Maybe (Context L))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context L -> Maybe (Context L)
    forall a. a -> Maybe a
    Just (Context L -> Maybe (Context L))
    -> ([Asst L] -> Context L) -> [Asst L] -> Maybe (Context L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> [Asst L] -> Context L
    forall l. l -> [Asst l] -> Context l
    S.CxTuple L
    l
    checkSContext Maybe (PContext L)
    _ = Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Context L)
    forall a. Maybe a
    Nothing

    -- Checks ordinary contexts for sigtypes and data type
    -- declarations. If FlexibleContexts is enabled then
    -- anything goes, otherwise only tyvars OR tyvars
    -- applied to types are allowed.
    checkContext :: Maybe (PContext L) -> P (Maybe (S.Context L))
    checkContext :: Maybe (PContext L) -> P (Maybe (Context L))
    checkContext (Just PContext L
    ctxt) = case PContext L
    ctxt of
        CxEmpty L
    l -> Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Context L) -> P (Maybe (Context L)))
    -> Maybe (Context L) -> P (Maybe (Context L))
    forall a b. (a -> b) -> a -> b
    $ Context L -> Maybe (Context L)
    forall a. a -> Maybe a
    Just (Context L -> Maybe (Context L)) -> Context L -> Maybe (Context L)
    forall a b. (a -> b) -> a -> b
    $ L -> Context L
    forall l. l -> Context l
    S.CxEmpty L
    l
        CxSingle L
    l PAsst L
    a -> PAsst L -> P (Asst L)
    checkAsst PAsst L
    a P (Asst L)
    -> (Asst L -> P (Maybe (Context L))) -> P (Maybe (Context L))
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Context L) -> P (Maybe (Context L)))
    -> (Asst L -> Maybe (Context L)) -> Asst L -> P (Maybe (Context L))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context L -> Maybe (Context L)
    forall a. a -> Maybe a
    Just (Context L -> Maybe (Context L))
    -> (Asst L -> Context L) -> Asst L -> Maybe (Context L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> Asst L -> Context L
    forall l. l -> Asst l -> Context l
    S.CxSingle L
    l
        CxTuple L
    l [PAsst L]
    as -> (PAsst L -> P (Asst L)) -> [PAsst L] -> P [Asst L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PAsst L -> P (Asst L)
    checkAsst [PAsst L]
    as P [Asst L]
    -> ([Asst L] -> P (Maybe (Context L))) -> P (Maybe (Context L))
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Context L) -> P (Maybe (Context L)))
    -> ([Asst L] -> Maybe (Context L))
    -> [Asst L]
    -> P (Maybe (Context L))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context L -> Maybe (Context L)
    forall a. a -> Maybe a
    Just (Context L -> Maybe (Context L))
    -> ([Asst L] -> Context L) -> [Asst L] -> Maybe (Context L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> [Asst L] -> Context L
    forall l. l -> [Asst l] -> Context l
    S.CxTuple L
    l
    checkContext Maybe (PContext L)
    _ = Maybe (Context L) -> P (Maybe (Context L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Context L)
    forall a. Maybe a
    Nothing

    checkAsst :: PAsst L -> P (S.Asst L)
    checkAsst :: PAsst L -> P (Asst L)
    checkAsst PAsst L
    asst =
        case PAsst L
    asst of
          TypeA L
    l PType L
    pt -> do
                    t <- PType L -> P (Type L)
    checkType PType L
    pt
                    return $ S.TypeA l t
          IParam L
    l IPName L
    ipn PType L
    pt -> do
                    t <- PType L -> P (Type L)
    checkType PType L
    pt
                    return $ S.IParam l ipn t
          ParenA L
    l PAsst L
    a      -> do
                    a' <- PAsst L -> P (Asst L)
    checkAsst PAsst L
    a
                    return $ S.ParenA l a'

    -----------------------------------------------------------------------------
    -- Checking Headers

    checkDataHeader :: PType L -> P (Maybe (S.Context L), DeclHead L)
    checkDataHeader :: PType L -> P (Maybe (Context L), DeclHead L)
    checkDataHeader (TyForall L
    _ Maybe [TyVarBind L]
    Nothing Maybe (PContext L)
    cs PType L
    t) = do
        dh <- String -> PType L -> P (DeclHead L)
    checkSimple String
    "data/newtype" PType L
    t
        cs' <- checkContext cs
        return (cs',dh)
    checkDataHeader PType L
    t = do
        dh <- String -> PType L -> P (DeclHead L)
    checkSimple String
    "data/newtype" PType L
    t
        return (Nothing,dh)

    checkClassHeader :: PType L -> P (Maybe (S.Context L), DeclHead L)
    checkClassHeader :: PType L -> P (Maybe (Context L), DeclHead L)
    checkClassHeader (TyForall L
    _ Maybe [TyVarBind L]
    Nothing Maybe (PContext L)
    cs PType L
    t) = do
        PType L -> P ()
    checkMultiParam PType L
    t
        dh <- String -> PType L -> P (DeclHead L)
    checkSimple String
    "class" PType L
    t
        cs' <- checkSContext cs
        return (cs',dh)
    checkClassHeader PType L
    t = do
        PType L -> P ()
    checkMultiParam PType L
    t
        dh <- String -> PType L -> P (DeclHead L)
    checkSimple String
    "class" PType L
    t
        return (Nothing,dh)

    checkSimple :: String -> PType L -> P (DeclHead L)
    --checkSimple kw (TyApp _ l t) xs | isTyVarBind t = checkSimple kw l (toTyVarBind t : xs)

    checkSimple :: String -> PType L -> P (DeclHead L)
    checkSimple String
    kw (TyApp L
    l PType L
    h PType L
    t) = do
      tvb <- String -> PType L -> P (TyVarBind L)
    mkTyVarBind String
    kw PType L
    t
      h' <- checkSimple kw h
      return $ DHApp l h' tvb
    checkSimple String
    kw (TyInfix L
    l PType L
    t1 MaybePromotedName L
    mq PType L
    t2)
      | c :: QName L
    c@(UnQual L
    _ Name L
    t) <- MaybePromotedName L -> QName L
    forall l. MaybePromotedName l -> QName l
    getMaybePromotedQName MaybePromotedName L
    mq
      = do
           QName L -> P ()
    checkAndWarnTypeOperators QName L
    c
           tv1 <- String -> PType L -> P (TyVarBind L)
    mkTyVarBind String
    kw PType L
    t1
           tv2 <- mkTyVarBind kw t2
           return $ DHApp l (DHInfix l tv1 t) tv2
    checkSimple String
    _kw (TyCon L
    _ c :: QName L
    c@(UnQual L
    l Name L
    t)) = do
        QName L -> P ()
    checkAndWarnTypeOperators QName L
    c
        DeclHead L -> P (DeclHead L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Name L -> DeclHead L
    forall l. l -> Name l -> DeclHead l
    DHead L
    l Name L
    t)
    checkSimple String
    kw (TyParen L
    l PType L
    t) = do
        dh <- String -> PType L -> P (DeclHead L)
    checkSimple String
    kw PType L
    t
        return (DHParen l dh)
    checkSimple String
    kw PType L
    _ = String -> P (DeclHead L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Illegal " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    kw String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " declaration")

    mkTyVarBind :: String -> PType L -> P (TyVarBind L)
    mkTyVarBind :: String -> PType L -> P (TyVarBind L)
    mkTyVarBind String
    _ (TyVar L
    l Name L
    n) = TyVarBind L -> P (TyVarBind L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyVarBind L -> P (TyVarBind L)) -> TyVarBind L -> P (TyVarBind L)
    forall a b. (a -> b) -> a -> b
    $ L -> Name L -> TyVarBind L
    forall l. l -> Name l -> TyVarBind l
    UnkindedVar L
    l Name L
    n
    mkTyVarBind String
    _ (TyKind L
    l (TyVar L
    _ Name L
    n) Type L
    k) = TyVarBind L -> P (TyVarBind L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyVarBind L -> P (TyVarBind L)) -> TyVarBind L -> P (TyVarBind L)
    forall a b. (a -> b) -> a -> b
    $ L -> Name L -> Type L -> TyVarBind L
    forall l. l -> Name l -> Kind l -> TyVarBind l
    KindedVar L
    l Name L
    n Type L
    k
    mkTyVarBind String
    _ (TyCon L
    l c :: QName L
    c@(UnQual L
    _ n :: Name L
    n@(Symbol L
    _ String
    _))) = QName L -> P ()
    checkAndWarnTypeOperators QName L
    c P () -> P (TyVarBind L) -> P (TyVarBind L)
    forall a b. P a -> P b -> P b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TyVarBind L -> P (TyVarBind L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Name L -> TyVarBind L
    forall l. l -> Name l -> TyVarBind l
    UnkindedVar L
    l Name L
    n)
    mkTyVarBind String
    _ (TyKind L
    l (TyCon L
    _ c :: QName L
    c@(UnQual L
    _ n :: Name L
    n@(Symbol L
    _ String
    _))) Type L
    k) = QName L -> P ()
    checkAndWarnTypeOperators QName L
    c P () -> P (TyVarBind L) -> P (TyVarBind L)
    forall a b. P a -> P b -> P b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TyVarBind L -> P (TyVarBind L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Name L -> Type L -> TyVarBind L
    forall l. l -> Name l -> Kind l -> TyVarBind l
    KindedVar L
    l Name L
    n Type L
    k)
    mkTyVarBind String
    kw PType L
    _ = String -> P (TyVarBind L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Illegal " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    kw String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " declaration")

    {-
    isTyVarBind :: PType L -> Bool
    isTyVarBind (TyVar _ _) = True
    --isTyVarBind (TyCon _ (UnQual _ n@(Symbol _ _))) = True
    isTyVarBind (TyKind _ (TyVar _ _) _) = True
    isTyVarBind _ = False

    toTyVarBind :: PType L -> TyVarBind L
    toTyVarBind (TyVar l n) = UnkindedVar l n
    toTyVarBind (TyKind l (TyVar _ n) k) = KindedVar l n k
    -}

    checkInstHeader :: PType L -> P (InstRule L)
    checkInstHeader :: PType L -> P (InstRule L)
    checkInstHeader (TyParen L
    l PType L
    t) = PType L -> P (InstRule L)
    checkInstHeader PType L
    t P (InstRule L) -> (InstRule L -> P (InstRule L)) -> P (InstRule L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= InstRule L -> P (InstRule L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstRule L -> P (InstRule L))
    -> (InstRule L -> InstRule L) -> InstRule L -> P (InstRule L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> InstRule L -> InstRule L
    forall l. l -> InstRule l -> InstRule l
    IParen L
    l
    checkInstHeader (TyForall L
    l Maybe [TyVarBind L]
    mtvs Maybe (PContext L)
    cs PType L
    t) = do
        cs' <- Maybe (PContext L) -> P (Maybe (Context L))
    checkSContext Maybe (PContext L)
    cs
        checkMultiParam t
        checkInsts (Just l) mtvs cs' t
    checkInstHeader PType L
    t = PType L -> P ()
    checkMultiParam PType L
    t P () -> P (InstRule L) -> P (InstRule L)
    forall a b. P a -> P b -> P b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe L
    -> Maybe [TyVarBind L]
    -> Maybe (Context L)
    -> PType L
    -> P (InstRule L)
    checkInsts Maybe L
    forall a. Maybe a
    Nothing Maybe [TyVarBind L]
    forall a. Maybe a
    Nothing Maybe (Context L)
    forall a. Maybe a
    Nothing PType L
    t

    checkInsts :: Maybe L -> Maybe [TyVarBind L] -> Maybe (S.Context L) -> PType L -> P (InstRule L)
    checkInsts :: Maybe L
    -> Maybe [TyVarBind L]
    -> Maybe (Context L)
    -> PType L
    -> P (InstRule L)
    checkInsts Maybe L
    _ Maybe [TyVarBind L]
    mtvs Maybe (Context L)
    mctxt (TyParen L
    l PType L
    t) = Maybe L
    -> Maybe [TyVarBind L]
    -> Maybe (Context L)
    -> PType L
    -> P (InstRule L)
    checkInsts Maybe L
    forall a. Maybe a
    Nothing Maybe [TyVarBind L]
    mtvs Maybe (Context L)
    mctxt PType L
    t P (InstRule L) -> (InstRule L -> P (InstRule L)) -> P (InstRule L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= InstRule L -> P (InstRule L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstRule L -> P (InstRule L))
    -> (InstRule L -> InstRule L) -> InstRule L -> P (InstRule L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> InstRule L -> InstRule L
    forall l. l -> InstRule l -> InstRule l
    IParen L
    l
    checkInsts Maybe L
    l1 Maybe [TyVarBind L]
    mtvs Maybe (Context L)
    mctxt PType L
    t = do
        t' <- PType L -> P (InstHead L)
    checkInstsGuts PType L
    t
        return $ IRule (fromMaybe (fmap ann mctxt <?+> ann t') l1) mtvs mctxt t'

    checkInstsGuts :: PType L -> P (InstHead L)
    checkInstsGuts :: PType L -> P (InstHead L)
    checkInstsGuts (TyApp L
    l PType L
    h PType L
    t) = do
        t' <- PType L -> P (Type L)
    checkType PType L
    t
        h' <- checkInstsGuts h
        return $ IHApp l h' t'
    checkInstsGuts (TyCon L
    l QName L
    c) = do
        QName L -> P ()
    checkAndWarnTypeOperators QName L
    c
        InstHead L -> P (InstHead L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstHead L -> P (InstHead L)) -> InstHead L -> P (InstHead L)
    forall a b. (a -> b) -> a -> b
    $ L -> QName L -> InstHead L
    forall l. l -> QName l -> InstHead l
    IHCon L
    l QName L
    c
    checkInstsGuts (TyInfix L
    l PType L
    a MaybePromotedName L
    op PType L
    b) = do
        QName L -> P ()
    checkAndWarnTypeOperators (MaybePromotedName L -> QName L
    forall l. MaybePromotedName l -> QName l
    getMaybePromotedQName MaybePromotedName L
    op)
        [ta,tb] <- [PType L] -> P [Type L]
    checkTypes [PType L
    a,PType L
    b]
        return $ IHApp l (IHInfix l ta (getMaybePromotedQName op)) tb
    checkInstsGuts (TyParen L
    l PType L
    t) = PType L -> P (InstHead L)
    checkInstsGuts PType L
    t P (InstHead L) -> (InstHead L -> P (InstHead L)) -> P (InstHead L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= InstHead L -> P (InstHead L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstHead L -> P (InstHead L))
    -> (InstHead L -> InstHead L) -> InstHead L -> P (InstHead L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> InstHead L -> InstHead L
    forall l. l -> InstHead l -> InstHead l
    IHParen L
    l
    checkInstsGuts PType L
    _ = String -> P (InstHead L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal instance declaration"

    checkDeriving :: [PType L] -> P [InstRule L]
    checkDeriving :: [PType L] -> P [InstRule L]
    checkDeriving = (PType L -> P (InstRule L)) -> [PType L] -> P [InstRule L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Maybe L
    -> Maybe [TyVarBind L]
    -> Maybe (Context L)
    -> PType L
    -> P (InstRule L)
    checkInsts Maybe L
    forall a. Maybe a
    Nothing Maybe [TyVarBind L]
    forall a. Maybe a
    Nothing Maybe (Context L)
    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 :: PExp L -> P (Pat L)
    checkPattern :: PExp L -> P (Pat L)
    checkPattern PExp L
    e = PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []

    checkPat :: PExp L -> [Pat L] -> P (Pat L)
    checkPat :: PExp L -> [Pat L] -> P (Pat L)
    checkPat (Con L
    l QName L
    c) [Pat L]
    args = do
      let l' :: L
    l' = (L -> L -> L) -> L -> [L] -> L
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl L -> L -> L
    combSpanInfo L
    l ((Pat L -> L) -> [Pat L] -> [L]
    forall a b. (a -> b) -> [a] -> [b]
    map Pat L -> L
    forall l. Pat l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann [Pat L]
    args)
      Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> QName L -> [Pat L] -> Pat L
    forall l. l -> QName l -> [Pat l] -> Pat l
    PApp L
    l' QName L
    c [Pat L]
    args)
    checkPat (App L
    _ PExp L
    f PExp L
    x) [Pat L]
    args = do
        x' <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    x []
        checkPat f (x':args)
    checkPat (InfixApp L
    _ PExp L
    l QOp L
    op PExp L
    r) [Pat L]
    args
        | QOp L
    op QOp L -> QOp () -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= () -> QName () -> QOp ()
    forall l. l -> QName l -> QOp l
    QVarOp () (() -> Name () -> QName ()
    forall l. l -> Name l -> QName l
    UnQual () (() -> String -> Name ()
    forall l. l -> String -> Name l
    Symbol () String
    "!")) = do
            -- We must have BangPatterns on
            KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    BangPatterns
            let (PExp L
    e,[PExp L]
    es) = PExp L -> [PExp L] -> (PExp L, [PExp L])
    splitBang PExp L
    r []
            ps <- (PExp L -> P (Pat L)) -> [PExp L] -> P [Pat L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PExp L -> P (Pat L)
    checkPattern (L -> PExp L -> PExp L
    forall l. l -> PExp l -> PExp l
    BangPat (QOp L -> L
    forall l. QOp l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann QOp L
    op) PExp L
    ePExp L -> [PExp L] -> [PExp L]
    forall a. a -> [a] -> [a]
    :[PExp L]
    es)
            checkPat l (ps++args)
    checkPat PExp L
    e' [] = case PExp L
    e' of
        Var L
    _ (UnQual L
    l Name L
    x)   -> Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Name L -> Pat L
    forall l. l -> Name l -> Pat l
    PVar L
    l Name L
    x)
        Var L
    _ (Special L
    l (ExprHole L
    _)) -> Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Pat L
    forall l. l -> Pat l
    PWildCard L
    l)
        Lit L
    l Literal L
    lit            -> Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Sign L -> Literal L -> Pat L
    forall l. l -> Sign l -> Literal l -> Pat l
    PLit L
    l (L -> Sign L
    forall l. l -> Sign l
    Signless L
    l2) Literal L
    lit)
                where l2 :: L
    l2 = SrcSpan -> L
    noInfoSpan (SrcSpan -> L) -> (L -> SrcSpan) -> L -> L
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> SrcSpan
    srcInfoSpan (L -> L) -> L -> L
    forall a b. (a -> b) -> a -> b
    $ L
    l
        InfixApp L
    loc PExp L
    l QOp L
    op PExp L
    r  ->
            case QOp L
    op of
                QConOp L
    _ QName L
    c -> do
                        l' <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    l []
                        r' <- checkPat r []
                        return (PInfixApp loc l' c r')
                QVarOp L
    ppos (UnQual L
    _ (Symbol L
    _ String
    "+")) -> do
                        KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    NPlusKPatterns
                        case (PExp L
    l,PExp L
    r) of
                            (Var L
    _ (UnQual L
    _ n :: Name L
    n@(Ident L
    _ String
    _)), Lit L
    _ (Int L
    kpos Integer
    k String
    _)) -> do
                                let pp :: SrcSpan
    pp = L -> SrcSpan
    srcInfoSpan L
    ppos
                                    kp :: SrcSpan
    kp = L -> SrcSpan
    srcInfoSpan L
    kpos
                                Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Name L -> Integer -> Pat L
    forall l. l -> Name l -> Integer -> Pat l
    PNPlusK (L
    loc L -> [SrcSpan] -> L
    <** [SrcSpan
    pp,SrcSpan
    kp]) Name L
    n Integer
    k)
                            (PExp L, PExp L)
    _ -> String -> P (Pat L)
    forall a. String -> P a
    patFail String
    ""
                QOp L
    _ -> String -> P (Pat L)
    forall a. String -> P a
    patFail String
    ""
        TupleSection L
    l Boxed
    bx [Maybe (PExp L)]
    mes    ->
                if Maybe (PExp L)
    forall a. Maybe a
    Nothing Maybe (PExp L) -> [Maybe (PExp L)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Maybe (PExp L)]
    mes
                 then do ps <- (PExp L -> P (Pat L)) -> [PExp L] -> P [Pat L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\PExp L
    e -> PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []) ((Maybe (PExp L) -> PExp L) -> [Maybe (PExp L)] -> [PExp L]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe (PExp L) -> PExp L
    forall a. HasCallStack => Maybe a -> a
    fromJust [Maybe (PExp L)]
    mes)
                         return (PTuple l bx ps)
                 else String -> P (Pat L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal tuple section in pattern"
        UnboxedSum L
    l Int
    b Int
    a PExp L
    e ->
          L -> Int -> Int -> Pat L -> Pat L
    forall l. l -> Int -> Int -> Pat l -> Pat l
    PUnboxedSum L
    l Int
    b Int
    a (Pat L -> Pat L) -> P (Pat L) -> P (Pat L)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PExp L -> P (Pat L)
    checkPattern PExp L
    e

        List L
    l [PExp L]
    es      -> do
                      ps <- (PExp L -> P (RPat L)) -> [PExp L] -> P [RPat L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PExp L -> P (RPat L)
    checkRPattern [PExp L]
    es
                      if all isStdPat ps
                        then return . PList l $ map stripRP ps
                        -- we don't allow truly regular patterns unless the extension is enabled
                        else checkEnabled RegularPatterns >> return (PRPat l $ map fixRPOpPrec ps)
                where isStdPat :: RPat L -> Bool
                      isStdPat :: RPat L -> Bool
    isStdPat (RPPat L
    _ Pat L
    _) = Bool
    True
                      isStdPat (RPAs L
    _ Name L
    _ RPat L
    p) = RPat L -> Bool
    isStdPat RPat L
    p
                      isStdPat (RPParen L
    _ RPat L
    p) = RPat L -> Bool
    isStdPat RPat L
    p
                      isStdPat RPat L
    _           = Bool
    False
                      stripRP :: RPat L -> Pat L
                      stripRP :: RPat L -> Pat L
    stripRP (RPPat  L
    _ Pat L
    p) = Pat L
    p
                      stripRP (RPAs L
    l' Name L
    n RPat L
    p) = L -> Name L -> Pat L -> Pat L
    forall l. l -> Name l -> Pat l -> Pat l
    PAsPat L
    l' Name L
    n (RPat L -> Pat L
    stripRP RPat L
    p)
                      stripRP (RPParen L
    l' RPat L
    p) = L -> Pat L -> Pat L
    forall l. l -> Pat l -> Pat l
    PParen L
    l' (RPat L -> Pat L
    stripRP RPat L
    p)
                      stripRP RPat L
    _           = String -> Pat L
    forall a. HasCallStack => String -> a
    error String
    "cannot strip RP wrapper if not all patterns are base"

        Paren L
    l PExp L
    e      -> do
                      p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
                      return (PParen l p)
        AsPat L
    l Name L
    n PExp L
    e    -> do
                      p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
                      return (PAsPat l n p)
        WildCard L
    l   -> Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Pat L
    forall l. l -> Pat l
    PWildCard L
    l)
        IrrPat L
    l PExp L
    e   -> do
                      p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
                      return (PIrrPat l p)
        ViewPat L
    l PExp L
    e Pat L
    p  -> do
                      e1 <- PExp L -> P (Exp L)
    checkExpr PExp L
    e
                      return (PViewPat l e1 p)
        RecConstr L
    l QName L
    c [PFieldUpdate L]
    fs   -> do
                      fs' <- (PFieldUpdate L -> P (PatField L))
    -> [PFieldUpdate L] -> P [PatField L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PFieldUpdate L -> P (PatField L)
    checkPatField [PFieldUpdate L]
    fs
                      return (PRec l c fs')
        NegApp L
    l (Lit L
    _ Literal L
    lit) ->
                      let siSign :: SrcSpan
    siSign = [SrcSpan] -> SrcSpan
    forall a. HasCallStack => [a] -> a
    last ([SrcSpan] -> SrcSpan) -> (L -> [SrcSpan]) -> L -> SrcSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> [SrcSpan]
    srcInfoPoints (L -> SrcSpan) -> L -> SrcSpan
    forall a b. (a -> b) -> a -> b
    $ L
    l
                          lSign :: L
    lSign = SrcSpan -> [SrcSpan] -> L
    infoSpan SrcSpan
    siSign [SrcSpan
    siSign]
                      in do
                        Bool -> P () -> P ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> (Literal L -> Bool) -> Literal L -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Literal L -> Bool
    forall a. Literal a -> Bool
    isNegatableLiteral (Literal L -> Bool) -> Literal L -> Bool
    forall a b. (a -> b) -> a -> b
    $ Literal L
    lit) (String -> P ()
    forall a. String -> P a
    patFail (String -> P ()) -> String -> P ()
    forall a b. (a -> b) -> a -> b
    $ PExp L -> String
    forall a. Pretty a => a -> String
    prettyPrint PExp L
    e')
                        Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Sign L -> Literal L -> Pat L
    forall l. l -> Sign l -> Literal l -> Pat l
    PLit L
    l (L -> Sign L
    forall l. l -> Sign l
    Negative L
    lSign) Literal L
    lit)
        ExpTypeSig L
    l PExp L
    e Type L
    t -> do
                      -- patterns cannot have signatures unless ScopedTypeVariables is enabled.
                      KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    ScopedTypeVariables
                      p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
                      return (PatTypeSig l p t)

        -- Hsx
        XTag L
    l XName L
    n [ParseXAttr L]
    attrs Maybe (PExp L)
    mattr [PExp L]
    cs -> do
                      pattrs <- (ParseXAttr L -> P (PXAttr L)) -> [ParseXAttr L] -> P [PXAttr L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ParseXAttr L -> P (PXAttr L)
    checkPAttr [ParseXAttr L]
    attrs
                      pcs    <- mapM (\PExp L
    c -> PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    c []) cs
                      mpattr <- maybe (return Nothing)
                                  (\PExp L
    e -> do p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
                                            return $ Just p)
                                  mattr
                      let cps = [Pat L] -> [Pat L]
    mkChildrenPat [Pat L]
    pcs
                      return $ PXTag l n pattrs mpattr cps
        XETag L
    l XName L
    n [ParseXAttr L]
    attrs Maybe (PExp L)
    mattr -> do
                      pattrs <- (ParseXAttr L -> P (PXAttr L)) -> [ParseXAttr L] -> P [PXAttr L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ParseXAttr L -> P (PXAttr L)
    checkPAttr [ParseXAttr L]
    attrs
                      mpattr <- maybe (return Nothing)
                                  (\PExp L
    e -> do p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
                                            return $ Just p)
                                  mattr
                      return $ PXETag l n pattrs mpattr
        XPcdata L
    l String
    pcdata   -> Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pat L -> P (Pat L)) -> Pat L -> P (Pat L)
    forall a b. (a -> b) -> a -> b
    $ L -> String -> Pat L
    forall l. l -> String -> Pat l
    PXPcdata L
    l String
    pcdata
        XExpTag L
    l PExp L
    e -> do
                p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
                return $ PXPatTag l p
        XRPats L
    l [PExp L]
    es -> do
                rps <- (PExp L -> P (RPat L)) -> [PExp L] -> P [RPat L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PExp L -> P (RPat L)
    checkRPattern [PExp L]
    es
                return (PXRPats l $ map fixRPOpPrec rps)

        -- Template Haskell
        SpliceExp L
    l Splice L
    e -> Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pat L -> P (Pat L)) -> Pat L -> P (Pat L)
    forall a b. (a -> b) -> a -> b
    $ L -> Splice L -> Pat L
    forall l. l -> Splice l -> Pat l
    PSplice L
    l Splice L
    e
        QuasiQuote L
    l String
    n String
    q -> Pat L -> P (Pat L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pat L -> P (Pat L)) -> Pat L -> P (Pat L)
    forall a b. (a -> b) -> a -> b
    $ L -> String -> String -> Pat L
    forall l. l -> String -> String -> Pat l
    PQuasiQuote L
    l String
    n String
    q

        -- BangPatterns
        BangPat L
    l PExp L
    e -> do
            p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
            return $ PBangPat l p

        PreOp L
    l (QVarOp L
    _ (UnQual L
    _ (Symbol L
    _ String
    "!"))) PExp L
    e -> do
            KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    BangPatterns
            p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
            return $ PBangPat l p

        PExp L
    e -> String -> P (Pat L)
    forall a. String -> P a
    patFail (String -> P (Pat L)) -> String -> P (Pat L)
    forall a b. (a -> b) -> a -> b
    $ PExp L -> String
    forall a. Pretty a => a -> String
    prettyPrint PExp L
    e

    checkPat PExp L
    e [Pat L]
    _ = String -> P (Pat L)
    forall a. String -> P a
    patFail (String -> P (Pat L)) -> String -> P (Pat L)
    forall a b. (a -> b) -> a -> b
    $ PExp L -> String
    forall a. Pretty a => a -> String
    prettyPrint PExp L
    e

    isNegatableLiteral :: Literal a -> Bool
    isNegatableLiteral :: forall a. Literal a -> Bool
    isNegatableLiteral (Int a
    _ Integer
    _ String
    _) = Bool
    True
    isNegatableLiteral (Frac a
    _ Rational
    _ String
    _) = Bool
    True
    isNegatableLiteral (PrimInt a
    _ Integer
    _ String
    _) = Bool
    True
    isNegatableLiteral (PrimFloat a
    _ Rational
    _ String
    _) = Bool
    True
    isNegatableLiteral (PrimDouble a
    _ Rational
    _ String
    _) = Bool
    True
    isNegatableLiteral Literal a
    _ = Bool
    False

    splitBang :: PExp L -> [PExp L] -> (PExp L, [PExp L])
    splitBang :: PExp L -> [PExp L] -> (PExp L, [PExp L])
    splitBang (App L
    _ PExp L
    f PExp L
    x) [PExp L]
    es = PExp L -> [PExp L] -> (PExp L, [PExp L])
    splitBang PExp L
    f (PExp L
    xPExp L -> [PExp L] -> [PExp L]
    forall a. a -> [a] -> [a]
    :[PExp L]
    es)
    splitBang PExp L
    e [PExp L]
    es = (PExp L
    e, [PExp L]
    es)

    checkPatField :: PFieldUpdate L -> P (PatField L)
    checkPatField :: PFieldUpdate L -> P (PatField L)
    checkPatField (FieldUpdate L
    l QName L
    n PExp L
    e) = do
        p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    e []
        return (PFieldPat l n p)
    checkPatField (FieldPun L
    l QName L
    n) = PatField L -> P (PatField L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> QName L -> PatField L
    forall l. l -> QName l -> PatField l
    PFieldPun L
    l QName L
    n)
    checkPatField (FieldWildcard L
    l) = PatField L -> P (PatField L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> PatField L
    forall l. l -> PatField l
    PFieldWildcard L
    l)

    checkPAttr :: ParseXAttr L -> P (PXAttr L)
    checkPAttr :: ParseXAttr L -> P (PXAttr L)
    checkPAttr (XAttr L
    l XName L
    n PExp L
    v) = do p <- PExp L -> [Pat L] -> P (Pat L)
    checkPat PExp L
    v []
                                  return $ PXAttr l n p

    patFail :: String -> P a
    patFail :: forall a. String -> P a
    patFail String
    s = String -> P a
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P a) -> String -> P a
    forall a b. (a -> b) -> a -> b
    $ String
    "Parse error in pattern: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s

    checkRPattern :: PExp L -> P (RPat L)
    checkRPattern :: PExp L -> P (RPat L)
    checkRPattern PExp L
    e' = case PExp L
    e' of
        SeqRP L
    l [PExp L]
    es -> do
            rps <- (PExp L -> P (RPat L)) -> [PExp L] -> P [RPat L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PExp L -> P (RPat L)
    checkRPattern [PExp L]
    es
            return $ RPSeq l rps
        PostOp L
    l PExp L
    e QOp L
    op -> do
            rpop <- QOp L -> P (RPatOp L)
    checkRPatOp QOp L
    op
            rp   <- checkRPattern e
            return $ RPOp l rp rpop
        GuardRP L
    l PExp L
    e [Stmt L]
    gs -> do
            rp <- PExp L -> P (Pat L)
    checkPattern PExp L
    e
            return $ RPGuard l rp gs
        EitherRP L
    l PExp L
    e1 PExp L
    e2 -> do
            rp1 <- PExp L -> P (RPat L)
    checkRPattern PExp L
    e1
            rp2 <- checkRPattern e2
            return $ RPEither l rp1 rp2
        CAsRP L
    l Name L
    n PExp L
    e -> do
            rp <- PExp L -> P (RPat L)
    checkRPattern PExp L
    e
            return $ RPCAs l n rp
        AsPat L
    l Name L
    n PExp L
    e  -> do
            rp <- PExp L -> P (RPat L)
    checkRPattern PExp L
    e
            return $ RPAs l n rp
        Paren L
    l PExp L
    e -> do
            rp <- PExp L -> P (RPat L)
    checkRPattern PExp L
    e
            return $ RPParen l rp
        PExp L
    _          -> do
            p <- PExp L -> P (Pat L)
    checkPattern PExp L
    e'
            return $ RPPat (ann p) p

    checkRPatOp :: QOp L -> P (RPatOp L)
    checkRPatOp :: QOp L -> P (RPatOp L)
    checkRPatOp o :: QOp L
    o@(QVarOp L
    l (UnQual L
    _ (Symbol L
    _ String
    sym))) =
        case String
    sym of
         String
    "*"  -> RPatOp L -> P (RPatOp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RPatOp L -> P (RPatOp L)) -> RPatOp L -> P (RPatOp L)
    forall a b. (a -> b) -> a -> b
    $ L -> RPatOp L
    forall l. l -> RPatOp l
    RPStar L
    l
         String
    "*!" -> RPatOp L -> P (RPatOp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RPatOp L -> P (RPatOp L)) -> RPatOp L -> P (RPatOp L)
    forall a b. (a -> b) -> a -> b
    $ L -> RPatOp L
    forall l. l -> RPatOp l
    RPStarG L
    l
         String
    "+"  -> RPatOp L -> P (RPatOp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RPatOp L -> P (RPatOp L)) -> RPatOp L -> P (RPatOp L)
    forall a b. (a -> b) -> a -> b
    $ L -> RPatOp L
    forall l. l -> RPatOp l
    RPPlus L
    l
         String
    "+!" -> RPatOp L -> P (RPatOp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RPatOp L -> P (RPatOp L)) -> RPatOp L -> P (RPatOp L)
    forall a b. (a -> b) -> a -> b
    $ L -> RPatOp L
    forall l. l -> RPatOp l
    RPPlusG L
    l
         String
    "?"  -> RPatOp L -> P (RPatOp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RPatOp L -> P (RPatOp L)) -> RPatOp L -> P (RPatOp L)
    forall a b. (a -> b) -> a -> b
    $ L -> RPatOp L
    forall l. l -> RPatOp l
    RPOpt L
    l
         String
    "?!" -> RPatOp L -> P (RPatOp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RPatOp L -> P (RPatOp L)) -> RPatOp L -> P (RPatOp L)
    forall a b. (a -> b) -> a -> b
    $ L -> RPatOp L
    forall l. l -> RPatOp l
    RPOptG L
    l
         String
    _    -> QOp L -> P (RPatOp L)
    forall a b. Pretty a => a -> P b
    rpOpFail QOp L
    o
    checkRPatOp QOp L
    o = QOp L -> P (RPatOp L)
    forall a b. Pretty a => a -> P b
    rpOpFail QOp L
    o

    rpOpFail :: Pretty a => a -> P b
    rpOpFail :: forall a b. Pretty a => a -> P b
    rpOpFail a
    sym = String -> P b
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P b) -> String -> P b
    forall a b. (a -> b) -> a -> b
    $ String
    "Unrecognized regular pattern operator: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Pretty a => a -> String
    prettyPrint a
    sym

    fixRPOpPrec :: RPat L -> RPat L
    fixRPOpPrec :: RPat L -> RPat L
    fixRPOpPrec RPat L
    rp' = case RPat L
    rp' of
        RPOp L
    l RPat L
    rp RPatOp L
    rpop      -> RPat L -> (RPat L -> RPat L) -> RPat L
    fPrecOp RPat L
    rp ((RPat L -> RPatOp L -> RPat L) -> RPatOp L -> RPat L -> RPat L
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (L -> RPat L -> RPatOp L -> RPat L
    forall l. l -> RPat l -> RPatOp l -> RPat l
    RPOp L
    l) RPatOp L
    rpop)
        RPEither L
    l RPat L
    rp1 RPat L
    rp2  -> L -> RPat L -> RPat L -> RPat L
    forall l. l -> RPat l -> RPat l -> RPat l
    RPEither L
    l (RPat L -> RPat L
    fixRPOpPrec RPat L
    rp1) (RPat L -> RPat L
    fixRPOpPrec RPat L
    rp2)
        RPSeq L
    l [RPat L]
    rps         -> L -> [RPat L] -> RPat L
    forall l. l -> [RPat l] -> RPat l
    RPSeq L
    l ([RPat L] -> RPat L) -> [RPat L] -> RPat L
    forall a b. (a -> b) -> a -> b
    $ (RPat L -> RPat L) -> [RPat L] -> [RPat L]
    forall a b. (a -> b) -> [a] -> [b]
    map RPat L -> RPat L
    fixRPOpPrec [RPat L]
    rps
        RPCAs L
    l Name L
    n RPat L
    rp        -> L -> Name L -> RPat L -> RPat L
    forall l. l -> Name l -> RPat l -> RPat l
    RPCAs L
    l Name L
    n (RPat L -> RPat L) -> RPat L -> RPat L
    forall a b. (a -> b) -> a -> b
    $ RPat L -> RPat L
    fixRPOpPrec RPat L
    rp
        RPAs L
    l Name L
    n RPat L
    rp         -> L -> Name L -> RPat L -> RPat L
    forall l. l -> Name l -> RPat l -> RPat l
    RPAs L
    l Name L
    n (RPat L -> RPat L) -> RPat L -> RPat L
    forall a b. (a -> b) -> a -> b
    $ RPat L -> RPat L
    fixRPOpPrec RPat L
    rp
        RPParen L
    l RPat L
    rp        -> L -> RPat L -> RPat L
    forall l. l -> RPat l -> RPat l
    RPParen L
    l (RPat L -> RPat L) -> RPat L -> RPat L
    forall a b. (a -> b) -> a -> b
    $ RPat L -> RPat L
    fixRPOpPrec RPat L
    rp
        RPat L
    _                   -> RPat L
    rp'

      where fPrecOp :: RPat L -> (RPat L -> RPat L) -> RPat L
            fPrecOp :: RPat L -> (RPat L -> RPat L) -> RPat L
    fPrecOp (RPOp L
    l RPat L
    rp RPatOp L
    rpop) RPat L -> RPat L
    f = RPat L -> (RPat L -> RPat L) -> RPat L
    fPrecOp RPat L
    rp (RPat L -> RPat L
    f (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L -> RPat L
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RPat L -> RPatOp L -> RPat L) -> RPatOp L -> RPat L -> RPat L
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (L -> RPat L -> RPatOp L -> RPat L
    forall l. l -> RPat l -> RPatOp l -> RPat l
    RPOp L
    l) RPatOp L
    rpop)
            fPrecOp (RPCAs L
    l Name L
    n RPat L
    rp) RPat L -> RPat L
    f = RPat L -> (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L
    fPrecAs RPat L
    rp RPat L -> RPat L
    f (L -> Name L -> RPat L -> RPat L
    forall l. l -> Name l -> RPat l -> RPat l
    RPCAs L
    l Name L
    n)
            fPrecOp (RPAs  L
    l Name L
    n RPat L
    rp) RPat L -> RPat L
    f = RPat L -> (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L
    fPrecAs RPat L
    rp RPat L -> RPat L
    f (L -> Name L -> RPat L -> RPat L
    forall l. l -> Name l -> RPat l -> RPat l
    RPAs  L
    l Name L
    n)
            fPrecOp RPat L
    rp RPat L -> RPat L
    f = RPat L -> RPat L
    f (RPat L -> RPat L) -> RPat L -> RPat L
    forall a b. (a -> b) -> a -> b
    $ RPat L -> RPat L
    fixRPOpPrec RPat L
    rp
            fPrecAs :: RPat L -> (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L
            fPrecAs :: RPat L -> (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L
    fPrecAs (RPCAs L
    l Name L
    n RPat L
    rp) RPat L -> RPat L
    f RPat L -> RPat L
    g = RPat L -> (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L
    fPrecAs RPat L
    rp RPat L -> RPat L
    f (RPat L -> RPat L
    g (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L -> RPat L
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> Name L -> RPat L -> RPat L
    forall l. l -> Name l -> RPat l -> RPat l
    RPCAs L
    l Name L
    n)
            fPrecAs (RPAs  L
    l Name L
    n RPat L
    rp) RPat L -> RPat L
    f RPat L -> RPat L
    g = RPat L -> (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L
    fPrecAs RPat L
    rp RPat L -> RPat L
    f (RPat L -> RPat L
    g (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L -> RPat L
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> Name L -> RPat L -> RPat L
    forall l. l -> Name l -> RPat l -> RPat l
    RPAs  L
    l Name L
    n)
            fPrecAs RPat L
    rp RPat L -> RPat L
    f RPat L -> RPat L
    g = RPat L -> RPat L
    g (RPat L -> RPat L) -> (RPat L -> RPat L) -> RPat L -> RPat L
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RPat L -> RPat L
    f (RPat L -> RPat L) -> RPat L -> RPat L
    forall a b. (a -> b) -> a -> b
    $ RPat L -> RPat L
    fixRPOpPrec RPat L
    rp

    mkChildrenPat :: [Pat L] -> [Pat L]
    mkChildrenPat :: [Pat L] -> [Pat L]
    mkChildrenPat [Pat L]
    ps' = [Pat L] -> [Pat L] -> [Pat L]
    mkCPAux [Pat L]
    ps' []
      where mkCPAux :: [Pat L] -> [Pat L] -> [Pat L]
            mkCPAux :: [Pat L] -> [Pat L] -> [Pat L]
    mkCPAux [] [Pat L]
    qs = [Pat L] -> [Pat L]
    forall a. [a] -> [a]
    reverse [Pat L]
    qs
            mkCPAux (Pat L
    p:[Pat L]
    ps) [Pat L]
    qs = case Pat L
    p of
                (PRPat L
    l [RPat L]
    rps) -> [L -> [Pat L] -> [RPat L] -> Pat L
    mkCRP L
    l [Pat L]
    ps ([RPat L] -> [RPat L]
    forall a. [a] -> [a]
    reverse [RPat L]
    rps [RPat L] -> [RPat L] -> [RPat L]
    forall a. [a] -> [a] -> [a]
    ++ (Pat L -> RPat L) -> [Pat L] -> [RPat L]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Pat L
    q -> L -> Pat L -> RPat L
    forall l. l -> Pat l -> RPat l
    RPPat (Pat L -> L
    forall l. Pat l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Pat L
    q) Pat L
    q) [Pat L]
    qs)]
                Pat L
    _             -> [Pat L] -> [Pat L] -> [Pat L]
    mkCPAux [Pat L]
    ps (Pat L
    pPat L -> [Pat L] -> [Pat L]
    forall a. a -> [a] -> [a]
    :[Pat L]
    qs)

            mkCRP :: L -> [Pat L] -> [RPat L] -> Pat L
            mkCRP :: L -> [Pat L] -> [RPat L] -> Pat L
    mkCRP L
    l [] [RPat L]
    rps = L -> [RPat L] -> Pat L
    forall l. l -> [RPat l] -> Pat l
    PXRPats L
    l ([RPat L] -> Pat L) -> [RPat L] -> Pat L
    forall a b. (a -> b) -> a -> b
    $ [RPat L] -> [RPat L]
    forall a. [a] -> [a]
    reverse [RPat L]
    rps
            mkCRP L
    _ (Pat L
    p:[Pat L]
    ps) [RPat L]
    rps = case Pat L
    p of
                (PXRPats L
    l [RPat L]
    rqs) -> L -> [Pat L] -> [RPat L] -> Pat L
    mkCRP L
    l [Pat L]
    ps ([RPat L] -> [RPat L]
    forall a. [a] -> [a]
    reverse [RPat L]
    rqs [RPat L] -> [RPat L] -> [RPat L]
    forall a. [a] -> [a] -> [a]
    ++ [RPat L]
    rps)
                Pat L
    _               -> L -> [Pat L] -> [RPat L] -> Pat L
    mkCRP (Pat L -> L
    forall l. Pat l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Pat L
    p) [Pat L]
    ps (L -> Pat L -> RPat L
    forall l. l -> Pat l -> RPat l
    RPPat (Pat L -> L
    forall l. Pat l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Pat L
    p) Pat L
    p RPat L -> [RPat L] -> [RPat L]
    forall a. a -> [a] -> [a]
    : [RPat L]
    rps)

    -----------------------------------------------------------------------------
    -- Check Expression Syntax

    checkExpr :: PExp L -> P (S.Exp L)
    checkExpr :: PExp L -> P (Exp L)
    checkExpr PExp L
    e' = case PExp L
    e' of
        Var L
    l QName L
    v               -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> QName L -> Exp L
    forall l. l -> QName l -> Exp l
    S.Var L
    l QName L
    v
        OverloadedLabel L
    l String
    v   -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> String -> Exp L
    forall l. l -> String -> Exp l
    S.OverloadedLabel L
    l String
    v
        IPVar L
    l IPName L
    v             -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> IPName L -> Exp L
    forall l. l -> IPName l -> Exp l
    S.IPVar L
    l IPName L
    v
        Con L
    l QName L
    c               -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> QName L -> Exp L
    forall l. l -> QName l -> Exp l
    S.Con L
    l QName L
    c
        Lit L
    l Literal L
    lit             -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> Literal L -> Exp L
    forall l. l -> Literal l -> Exp l
    S.Lit L
    l Literal L
    lit
        InfixApp L
    l PExp L
    e1 QOp L
    op PExp L
    e2   -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 ((Exp L -> QOp L -> Exp L -> Exp L)
    -> QOp L -> Exp L -> Exp L -> Exp L
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (L -> Exp L -> QOp L -> Exp L -> Exp L
    forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
    S.InfixApp L
    l) QOp L
    op)
        App L
    l PExp L
    e1 PExp L
    e2           -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.App L
    l)
        NegApp L
    _ (Lit L
    _ (PrimWord L
    _ Integer
    _ String
    _))
                              -> String -> P (Exp L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P (Exp L)) -> String -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ String
    "Parse error: negative primitive word literal: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PExp L -> String
    forall a. Pretty a => a -> String
    prettyPrint PExp L
    e'
        NegApp L
    l PExp L
    e            -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l
    S.NegApp L
    l)
        Lambda L
    loc [Pat L]
    ps PExp L
    e       -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> [Pat L] -> Exp L -> Exp L
    forall l. l -> [Pat l] -> Exp l -> Exp l
    S.Lambda L
    loc [Pat L]
    ps)
        Let L
    l Binds L
    bs PExp L
    e            -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> Binds L -> Exp L -> Exp L
    forall l. l -> Binds l -> Exp l -> Exp l
    S.Let L
    l Binds L
    bs)
        If L
    l PExp L
    e1 PExp L
    e2 PExp L
    e3         -> PExp L
    -> PExp L
    -> PExp L
    -> (Exp L -> Exp L -> Exp L -> Exp L)
    -> P (Exp L)
    forall a.
    PExp L -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L -> a) -> P a
    check3Exprs PExp L
    e1 PExp L
    e2 PExp L
    e3 (L -> Exp L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l -> Exp l
    S.If L
    l)
        MultiIf L
    l [GuardedRhs L]
    alts        -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> [GuardedRhs L] -> Exp L
    forall l. l -> [GuardedRhs l] -> Exp l
    S.MultiIf L
    l [GuardedRhs L]
    alts)
        Case L
    l PExp L
    e [Alt L]
    alts         -> do
                         e1 <- PExp L -> P (Exp L)
    checkExpr PExp L
    e
                         return (S.Case l e1 alts)
        Do L
    l [Stmt L]
    stmts            -> [Stmt L] -> P ()
    forall t. [Stmt t] -> P ()
    checkDo [Stmt L]
    stmts P () -> P (Exp L) -> P (Exp L)
    forall a b. P a -> P b -> P b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> [Stmt L] -> Exp L
    forall l. l -> [Stmt l] -> Exp l
    S.Do L
    l [Stmt L]
    stmts)
        MDo L
    l [Stmt L]
    stmts           -> [Stmt L] -> P ()
    forall t. [Stmt t] -> P ()
    checkDo [Stmt L]
    stmts P () -> P (Exp L) -> P (Exp L)
    forall a b. P a -> P b -> P b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> [Stmt L] -> Exp L
    forall l. l -> [Stmt l] -> Exp l
    S.MDo L
    l [Stmt L]
    stmts)
        TupleSection L
    l Boxed
    bx [Maybe (PExp L)]
    mes -> if Maybe (PExp L)
    forall a. Maybe a
    Nothing Maybe (PExp L) -> [Maybe (PExp L)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Maybe (PExp L)]
    mes
                                 then [PExp L] -> ([Exp L] -> Exp L) -> P (Exp L)
    forall a. [PExp L] -> ([Exp L] -> a) -> P a
    checkManyExprs ((Maybe (PExp L) -> PExp L) -> [Maybe (PExp L)] -> [PExp L]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe (PExp L) -> PExp L
    forall a. HasCallStack => Maybe a -> a
    fromJust [Maybe (PExp L)]
    mes) (L -> Boxed -> [Exp L] -> Exp L
    forall l. l -> Boxed -> [Exp l] -> Exp l
    S.Tuple L
    l Boxed
    bx)
                                 else do KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    TupleSections
                                         mes' <- (Maybe (PExp L) -> P (Maybe (Exp L)))
    -> [Maybe (PExp L)] -> P [Maybe (Exp L)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Maybe (PExp L) -> P (Maybe (Exp L))
    mCheckExpr [Maybe (PExp L)]
    mes
                                         return $ S.TupleSection l bx mes'
        UnboxedSum L
    l Int
    before Int
    after PExp L
    e -> L -> Int -> Int -> Exp L -> Exp L
    forall l. l -> Int -> Int -> Exp l -> Exp l
    S.UnboxedSum L
    l Int
    before Int
    after (Exp L -> Exp L) -> P (Exp L) -> P (Exp L)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PExp L -> P (Exp L)
    checkExpr PExp L
    e

        List L
    l [PExp L]
    es         -> [PExp L] -> ([Exp L] -> Exp L) -> P (Exp L)
    forall a. [PExp L] -> ([Exp L] -> a) -> P a
    checkManyExprs [PExp L]
    es (L -> [Exp L] -> Exp L
    forall l. l -> [Exp l] -> Exp l
    S.List L
    l)
        ParArray L
    l [PExp L]
    es     -> [PExp L] -> ([Exp L] -> Exp L) -> P (Exp L)
    forall a. [PExp L] -> ([Exp L] -> a) -> P a
    checkManyExprs [PExp L]
    es (L -> [Exp L] -> Exp L
    forall l. l -> [Exp l] -> Exp l
    S.ParArray L
    l)
        -- Since we don't parse things as left or right sections, we need to mangle them into that.
        Paren L
    l PExp L
    e         -> case PExp L
    e of
                              PostOp L
    _ PExp L
    e1 QOp L
    op -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e1 ((Exp L -> QOp L -> Exp L) -> QOp L -> Exp L -> Exp L
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (L -> Exp L -> QOp L -> Exp L
    forall l. l -> Exp l -> QOp l -> Exp l
    S.LeftSection L
    l) QOp L
    op)
                              PreOp  L
    _ QOp L
    op PExp L
    e2 -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e2 (L -> QOp L -> Exp L -> Exp L
    forall l. l -> QOp l -> Exp l -> Exp l
    S.RightSection L
    l QOp L
    op)
                              PExp L
    _            -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l
    S.Paren L
    l)
        RecConstr L
    l QName L
    c [PFieldUpdate L]
    fields      -> do
                         fields1 <- (PFieldUpdate L -> P (FieldUpdate L))
    -> [PFieldUpdate L] -> P [FieldUpdate L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PFieldUpdate L -> P (FieldUpdate L)
    checkField [PFieldUpdate L]
    fields
                         return (S.RecConstr l c fields1)
        RecUpdate L
    l PExp L
    e [PFieldUpdate L]
    fields      -> do
                         fields1 <- (PFieldUpdate L -> P (FieldUpdate L))
    -> [PFieldUpdate L] -> P [FieldUpdate L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PFieldUpdate L -> P (FieldUpdate L)
    checkField [PFieldUpdate L]
    fields
                         e1 <- checkExpr e
                         return (S.RecUpdate l e1 fields1)
        EnumFrom L
    l PExp L
    e          -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l
    S.EnumFrom L
    l)
        EnumFromTo L
    l PExp L
    e1 PExp L
    e2    -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.EnumFromTo L
    l)
        EnumFromThen L
    l PExp L
    e1 PExp L
    e2      -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.EnumFromThen L
    l)
        EnumFromThenTo L
    l PExp L
    e1 PExp L
    e2 PExp L
    e3 -> PExp L
    -> PExp L
    -> PExp L
    -> (Exp L -> Exp L -> Exp L -> Exp L)
    -> P (Exp L)
    forall a.
    PExp L -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L -> a) -> P a
    check3Exprs PExp L
    e1 PExp L
    e2 PExp L
    e3 (L -> Exp L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l -> Exp l
    S.EnumFromThenTo L
    l)
        ParArrayFromTo L
    l PExp L
    e1 PExp L
    e2    -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.ParArrayFromTo L
    l)
        ParArrayFromThenTo L
    l PExp L
    e1 PExp L
    e2 PExp L
    e3 -> PExp L
    -> PExp L
    -> PExp L
    -> (Exp L -> Exp L -> Exp L -> Exp L)
    -> P (Exp L)
    forall a.
    PExp L -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L -> a) -> P a
    check3Exprs PExp L
    e1 PExp L
    e2 PExp L
    e3 (L -> Exp L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l -> Exp l
    S.ParArrayFromThenTo L
    l)
        -- a parallel list comprehension, which could be just a simple one
        ParComp L
    l PExp L
    e [[QualStmt L]]
    qualss        -> do
                         e1 <- PExp L -> P (Exp L)
    checkExpr PExp L
    e
                         case qualss of
                          [[QualStmt L]
    quals] -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Exp L -> [QualStmt L] -> Exp L
    forall l. l -> Exp l -> [QualStmt l] -> Exp l
    S.ListComp L
    l Exp L
    e1 [QualStmt L]
    quals)
                          [[QualStmt L]]
    _       -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Exp L -> [[QualStmt L]] -> Exp L
    forall l. l -> Exp l -> [[QualStmt l]] -> Exp l
    S.ParComp L
    l Exp L
    e1 [[QualStmt L]]
    qualss)
        ParArrayComp L
    l PExp L
    e [[QualStmt L]]
    qualss        -> do
                         e1 <- PExp L -> P (Exp L)
    checkExpr PExp L
    e
                         return (S.ParArrayComp l e1 qualss)
        ExpTypeSig L
    loc PExp L
    e Type L
    ty     -> do
                         e1 <- PExp L -> P (Exp L)
    checkExpr PExp L
    e
                         return (S.ExpTypeSig loc e1 ty)

        --Template Haskell
        BracketExp L
    l Bracket L
    e        -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> Bracket L -> Exp L
    forall l. l -> Bracket l -> Exp l
    S.BracketExp L
    l Bracket L
    e
        SpliceExp L
    l Splice L
    e         -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> Splice L -> Exp L
    forall l. l -> Splice l -> Exp l
    S.SpliceExp L
    l Splice L
    e
        TypQuote L
    l QName L
    q          -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> QName L -> Exp L
    forall l. l -> QName l -> Exp l
    S.TypQuote L
    l QName L
    q
        VarQuote L
    l QName L
    q          -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> QName L -> Exp L
    forall l. l -> QName l -> Exp l
    S.VarQuote L
    l QName L
    q
        QuasiQuote L
    l String
    n String
    q      -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> String -> String -> Exp L
    forall l. l -> String -> String -> Exp l
    S.QuasiQuote L
    l String
    n String
    q

        -- Hsx
        XTag L
    l XName L
    n [ParseXAttr L]
    attrs Maybe (PExp L)
    mattr [PExp L]
    cs -> do attrs1 <- (ParseXAttr L -> P (XAttr L)) -> [ParseXAttr L] -> P [XAttr L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ParseXAttr L -> P (XAttr L)
    checkAttr [ParseXAttr L]
    attrs
                                      cs1 <- mapM checkExpr cs
                                      mattr1 <- maybe (return Nothing)
                                                  (\PExp L
    e -> PExp L -> P (Exp L)
    checkExpr PExp L
    e P (Exp L) -> (Exp L -> P (Maybe (Exp L))) -> P (Maybe (Exp L))
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Exp L) -> P (Maybe (Exp L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Exp L) -> P (Maybe (Exp L)))
    -> (Exp L -> Maybe (Exp L)) -> Exp L -> P (Maybe (Exp L))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp L -> Maybe (Exp L)
    forall a. a -> Maybe a
    Just)
                                                  mattr
                                      return $ S.XTag l n attrs1 mattr1 cs1
        XETag L
    l XName L
    n [ParseXAttr L]
    attrs Maybe (PExp L)
    mattr   -> do attrs1 <- (ParseXAttr L -> P (XAttr L)) -> [ParseXAttr L] -> P [XAttr L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ParseXAttr L -> P (XAttr L)
    checkAttr [ParseXAttr L]
    attrs
                                      mattr1 <- maybe (return Nothing)
                                                  (\PExp L
    e -> PExp L -> P (Exp L)
    checkExpr PExp L
    e P (Exp L) -> (Exp L -> P (Maybe (Exp L))) -> P (Maybe (Exp L))
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Exp L) -> P (Maybe (Exp L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Exp L) -> P (Maybe (Exp L)))
    -> (Exp L -> Maybe (Exp L)) -> Exp L -> P (Maybe (Exp L))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp L -> Maybe (Exp L)
    forall a. a -> Maybe a
    Just)
                                                  mattr
                                      return $ S.XETag l n attrs1 mattr1
        XPcdata L
    l String
    p       -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> String -> Exp L
    forall l. l -> String -> Exp l
    S.XPcdata L
    l String
    p
        XExpTag L
    l PExp L
    e       -> do e1 <- PExp L -> P (Exp L)
    checkExpr PExp L
    e
                                return $ S.XExpTag l e1
        XChildTag L
    l [PExp L]
    es    -> do es1 <- (PExp L -> P (Exp L)) -> [PExp L] -> P [Exp L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PExp L -> P (Exp L)
    checkExpr [PExp L]
    es
                                return $ S.XChildTag l es1
        -- Pragmas
        CorePragma L
    l String
    s PExp L
    e  -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> String -> Exp L -> Exp L
    forall l. l -> String -> Exp l -> Exp l
    S.CorePragma L
    l String
    s)
        SCCPragma  L
    l String
    s PExp L
    e  -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> String -> Exp L -> Exp L
    forall l. l -> String -> Exp l -> Exp l
    S.SCCPragma L
    l String
    s)
        GenPragma L
    l String
    s (Int, Int)
    xx (Int, Int)
    yy PExp L
    e -> PExp L -> (Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> String -> (Int, Int) -> (Int, Int) -> Exp L -> Exp L
    forall l. l -> String -> (Int, Int) -> (Int, Int) -> Exp l -> Exp l
    S.GenPragma L
    l String
    s (Int, Int)
    xx (Int, Int)
    yy)
    --    UnknownExpPragma n s -> return $ S.UnknownExpPragma n s

        -- Arrows
        Proc L
    l Pat L
    p PExp L
    e              -> do e1 <- PExp L -> P (Exp L)
    checkExpr PExp L
    e
                                      return $ S.Proc l p e1
        LeftArrApp L
    l PExp L
    e1 PExp L
    e2      -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.LeftArrApp L
    l)
        RightArrApp L
    l PExp L
    e1 PExp L
    e2     -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.RightArrApp L
    l)
        LeftArrHighApp L
    l PExp L
    e1 PExp L
    e2  -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.LeftArrHighApp L
    l)
        RightArrHighApp L
    l PExp L
    e1 PExp L
    e2 -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L) -> P (Exp L)
    forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 (L -> Exp L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l -> Exp l
    S.RightArrHighApp L
    l)
        ArrOp L
    l PExp L
    e               -> L -> Exp L -> Exp L
    forall l. l -> Exp l -> Exp l
    S.ArrOp L
    l (Exp L -> Exp L) -> P (Exp L) -> P (Exp L)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PExp L -> P (Exp L)
    checkExpr PExp L
    e

        -- LamdaCase
        LCase L
    l [Alt L]
    alts -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> [Alt L] -> Exp L
    forall l. l -> [Alt l] -> Exp l
    S.LCase L
    l [Alt L]
    alts

        -- Hole
        TypeApp L
    l Type L
    ty   -> Exp L -> P (Exp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp L -> P (Exp L)) -> Exp L -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ L -> Type L -> Exp L
    forall l. l -> Type l -> Exp l
    S.TypeApp L
    l Type L
    ty

        PExp L
    _             -> String -> P (Exp L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P (Exp L)) -> String -> P (Exp L)
    forall a b. (a -> b) -> a -> b
    $ String
    "Parse error in expression: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PExp L -> String
    forall a. Pretty a => a -> String
    prettyPrint PExp L
    e'

    checkAttr :: ParseXAttr L -> P (S.XAttr L)
    checkAttr :: ParseXAttr L -> P (XAttr L)
    checkAttr (XAttr L
    l XName L
    n PExp L
    v) = do v' <- PExp L -> P (Exp L)
    checkExpr PExp L
    v
                                 return $ S.XAttr l n v'

    checkDo :: [Stmt t] -> P ()
    checkDo :: forall t. [Stmt t] -> P ()
    checkDo [] = String -> P ()
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Parse error: Last statement in a do-block must be an expression"
    checkDo [Qualifier t
    _ Exp t
    _] = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkDo (Stmt t
    _:[Stmt t]
    xs) = [Stmt t] -> P ()
    forall t. [Stmt t] -> P ()
    checkDo [Stmt t]
    xs

    -- type signature for polymorphic recursion!!
    check1Expr :: PExp L -> (S.Exp L -> a) -> P a
    check1Expr :: forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e1 Exp L -> a
    f = do
        e1' <- PExp L -> P (Exp L)
    checkExpr PExp L
    e1
        return (f e1')

    check2Exprs :: PExp L -> PExp L -> (S.Exp L -> S.Exp L -> a) -> P a
    check2Exprs :: forall a. PExp L -> PExp L -> (Exp L -> Exp L -> a) -> P a
    check2Exprs PExp L
    e1 PExp L
    e2 Exp L -> Exp L -> a
    f = do
        e1' <- PExp L -> P (Exp L)
    checkExpr PExp L
    e1
        e2' <- checkExpr e2
        return (f e1' e2')

    check3Exprs :: PExp L -> PExp L -> PExp L -> (S.Exp L -> S.Exp L -> S.Exp L -> a) -> P a
    check3Exprs :: forall a.
    PExp L -> PExp L -> PExp L -> (Exp L -> Exp L -> Exp L -> a) -> P a
    check3Exprs PExp L
    e1 PExp L
    e2 PExp L
    e3 Exp L -> Exp L -> Exp L -> a
    f = do
        e1' <- PExp L -> P (Exp L)
    checkExpr PExp L
    e1
        e2' <- checkExpr e2
        e3' <- checkExpr e3
        return (f e1' e2' e3')

    checkManyExprs :: [PExp L] -> ([S.Exp L] -> a) -> P a
    checkManyExprs :: forall a. [PExp L] -> ([Exp L] -> a) -> P a
    checkManyExprs [PExp L]
    es [Exp L] -> a
    f = do
        es' <- (PExp L -> P (Exp L)) -> [PExp L] -> P [Exp L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PExp L -> P (Exp L)
    checkExpr [PExp L]
    es
        return (f es')

    mCheckExpr :: Maybe (PExp L) -> P (Maybe (S.Exp L))
    mCheckExpr :: Maybe (PExp L) -> P (Maybe (Exp L))
    mCheckExpr Maybe (PExp L)
    Nothing = Maybe (Exp L) -> P (Maybe (Exp L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Exp L)
    forall a. Maybe a
    Nothing
    mCheckExpr (Just PExp L
    e) = PExp L -> P (Exp L)
    checkExpr PExp L
    e P (Exp L) -> (Exp L -> P (Maybe (Exp L))) -> P (Maybe (Exp L))
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Exp L) -> P (Maybe (Exp L))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Exp L) -> P (Maybe (Exp L)))
    -> (Exp L -> Maybe (Exp L)) -> Exp L -> P (Maybe (Exp L))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp L -> Maybe (Exp L)
    forall a. a -> Maybe a
    Just

    checkRuleExpr :: PExp L -> P (S.Exp L)
    checkRuleExpr :: PExp L -> P (Exp L)
    checkRuleExpr = PExp L -> P (Exp L)
    checkExpr

    readTool :: Maybe String -> Maybe Tool
    readTool :: Maybe String -> Maybe Tool
    readTool = (String -> Tool) -> Maybe String -> Maybe Tool
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Tool
    readC
     where readC :: String -> Tool
    readC String
    str = case String
    str of
            String
    "GHC" -> Tool
    GHC
            String
    "HUGS" -> Tool
    HUGS
            String
    "NHC98" -> Tool
    NHC98
            String
    "YHC" -> Tool
    YHC
            String
    "HADDOCK" -> Tool
    HADDOCK
            String
    _ -> String -> Tool
    UnknownTool String
    str

    checkField :: PFieldUpdate L -> P (S.FieldUpdate L)
    checkField :: PFieldUpdate L -> P (FieldUpdate L)
    checkField (FieldUpdate L
    l QName L
    n PExp L
    e) = PExp L -> (Exp L -> FieldUpdate L) -> P (FieldUpdate L)
    forall a. PExp L -> (Exp L -> a) -> P a
    check1Expr PExp L
    e (L -> QName L -> Exp L -> FieldUpdate L
    forall l. l -> QName l -> Exp l -> FieldUpdate l
    S.FieldUpdate L
    l QName L
    n)
    checkField (FieldPun L
    l QName L
    n) = FieldUpdate L -> P (FieldUpdate L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FieldUpdate L -> P (FieldUpdate L))
    -> FieldUpdate L -> P (FieldUpdate L)
    forall a b. (a -> b) -> a -> b
    $ L -> QName L -> FieldUpdate L
    forall l. l -> QName l -> FieldUpdate l
    S.FieldPun L
    l QName L
    n
    checkField (FieldWildcard L
    l) = FieldUpdate L -> P (FieldUpdate L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FieldUpdate L -> P (FieldUpdate L))
    -> FieldUpdate L -> P (FieldUpdate L)
    forall a b. (a -> b) -> a -> b
    $ L -> FieldUpdate L
    forall l. l -> FieldUpdate l
    S.FieldWildcard L
    l

    getGConName :: S.Exp L -> P (QName L)
    getGConName :: Exp L -> P (QName L)
    getGConName (S.Con L
    _ QName L
    n) = QName L -> P (QName L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName L
    n
    getGConName (S.List L
    l []) = QName L -> P (QName L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> QName L
    forall l. l -> QName l
    list_cons_name L
    l)
    getGConName Exp L
    _ = String -> P (QName L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Expression in reification is not a name"

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

    checkValDef :: L -> PExp L -> Maybe (S.Type L, S) -> Rhs L -> Maybe (Binds L) -> P (Decl L)
    checkValDef :: L
    -> PExp L
    -> Maybe (Type L, SrcSpan)
    -> Rhs L
    -> Maybe (Binds L)
    -> P (Decl L)
    checkValDef L
    l PExp L
    lhs Maybe (Type L, SrcSpan)
    optsig Rhs L
    rhs Maybe (Binds L)
    whereBinds = do
        mlhs <- PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    isFunLhs PExp L
    lhs []
        let whpt = L -> [SrcSpan]
    srcInfoPoints L
    l
        case mlhs of
         Just (Name L
    f,[PExp L]
    es,Bool
    b,[SrcSpan]
    pts) -> do
                ps <- (PExp L -> P (Pat L)) -> [PExp L] -> P [Pat L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PExp L -> P (Pat L)
    checkPattern [PExp L]
    es
                let l' = L
    l { srcInfoPoints = pts ++ whpt }
                case optsig of -- only pattern bindings can have signatures
                    Maybe (Type L, SrcSpan)
    Nothing -> Decl L -> P (Decl L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> [Match L] -> Decl L
    forall l. l -> [Match l] -> Decl l
    FunBind L
    l ([Match L] -> Decl L) -> [Match L] -> Decl L
    forall a b. (a -> b) -> a -> b
    $
                                if Bool
    b then [L -> Name L -> [Pat L] -> Rhs L -> Maybe (Binds L) -> Match L
    forall l.
    l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
    Match L
    l' Name L
    f [Pat L]
    ps Rhs L
    rhs Maybe (Binds L)
    whereBinds]
                                     else let (Pat L
    a:[Pat L]
    bs) = [Pat L]
    ps
                                           in [L
    -> Pat L
    -> Name L
    -> [Pat L]
    -> Rhs L
    -> Maybe (Binds L)
    -> Match L
    forall l.
    l
    -> Pat l
    -> Name l
    -> [Pat l]
    -> Rhs l
    -> Maybe (Binds l)
    -> Match l
    InfixMatch L
    l' Pat L
    a Name L
    f [Pat L]
    bs Rhs L
    rhs Maybe (Binds L)
    whereBinds])
                    Just (Type L, SrcSpan)
    _  -> String -> P (Decl L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot give an explicit type signature to a function binding"
         Maybe (Name L, [PExp L], Bool, [SrcSpan])
    Nothing     -> do
                lhs1 <- PExp L -> P (Pat L)
    checkPattern PExp L
    lhs
                let lhs' = case Maybe (Type L, SrcSpan)
    optsig of
                            Maybe (Type L, SrcSpan)
    Nothing -> Pat L
    lhs1
                            Just (Type L
    ty, SrcSpan
    pt) -> let lp :: L
    lp = (Pat L -> L
    forall l. Pat l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Pat L
    lhs1 L -> L -> L
    <++> Type L -> L
    forall l. Type l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Type L
    ty) L -> [SrcSpan] -> L
    <** [SrcSpan
    pt]
                                             in L -> Pat L -> Type L -> Pat L
    forall l. l -> Pat l -> Type l -> Pat l
    PatTypeSig L
    lp Pat L
    lhs1 Type L
    ty
                return (PatBind l lhs' rhs whereBinds)

    -- A variable binding is parsed as a PatBind.

    isFunLhs :: PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool, [S]))
    isFunLhs :: PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    isFunLhs (InfixApp L
    _ PExp L
    l (QVarOp L
    loc (UnQual L
    _ Name L
    op)) PExp L
    r) [PExp L]
    es
        | Name L
    op Name L -> Name () -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= () -> String -> Name ()
    forall l. l -> String -> Name l
    Symbol () String
    "!" = do
            exts <- P [KnownExtension]
    getExtensions
            if BangPatterns `elem` exts
             then let (b,bs) = splitBang r []
                      loc' = L -> L -> L
    combSpanInfo L
    loc (PExp L -> L
    forall l. PExp l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PExp L
    b)
                   in isFunLhs l (BangPat loc' b : bs ++ es)
             else return $ Just (op, l:r:es, False, []) -- It's actually a definition of the operator !
        | Bool
    otherwise =
            let infos :: [SrcSpan]
    infos = L -> [SrcSpan]
    srcInfoPoints L
    loc
                op' :: Name L
    op'   = (L -> L) -> Name L -> Name L
    forall l. (l -> l) -> Name l -> Name l
    forall (ast :: * -> *) l.
    Annotated ast =>
    (l -> l) -> ast l -> ast l
    amap (\L
    s -> L
    s { srcInfoPoints = infos }) Name L
    op
            in (Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Name L, [PExp L], Bool, [SrcSpan])
     -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan])))
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a b. (a -> b) -> a -> b
    $ (Name L, [PExp L], Bool, [SrcSpan])
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    forall a. a -> Maybe a
    Just (Name L
    op', PExp L
    lPExp L -> [PExp L] -> [PExp L]
    forall a. a -> [a] -> [a]
    :PExp L
    rPExp L -> [PExp L] -> [PExp L]
    forall a. a -> [a] -> [a]
    :[PExp L]
    es, Bool
    False, []))
    isFunLhs (App L
    _ (Var L
    l (UnQual L
    _ Name L
    f)) PExp L
    e) [PExp L]
    es = Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Name L, [PExp L], Bool, [SrcSpan])
     -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan])))
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a b. (a -> b) -> a -> b
    $ (Name L, [PExp L], Bool, [SrcSpan])
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    forall a. a -> Maybe a
    Just (Name L
    f, PExp L
    ePExp L -> [PExp L] -> [PExp L]
    forall a. a -> [a] -> [a]
    :[PExp L]
    es, Bool
    True, L -> [SrcSpan]
    srcInfoPoints L
    l)
    isFunLhs (App L
    _ PExp L
    f PExp L
    e) [PExp L]
    es = PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    isFunLhs PExp L
    f (PExp L
    ePExp L -> [PExp L] -> [PExp L]
    forall a. a -> [a] -> [a]
    :[PExp L]
    es)
    isFunLhs (Var L
    _ (UnQual L
    _ Name L
    f)) es :: [PExp L]
    es@(PExp L
    _:[PExp L]
    _) = Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Name L, [PExp L], Bool, [SrcSpan])
     -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan])))
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a b. (a -> b) -> a -> b
    $ (Name L, [PExp L], Bool, [SrcSpan])
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    forall a. a -> Maybe a
    Just (Name L
    f, [PExp L]
    es, Bool
    True, [])
    isFunLhs (Paren L
    l PExp L
    f) es :: [PExp L]
    es@(PExp L
    _:[PExp L]
    _) = do mlhs <- PExp L -> [PExp L] -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    isFunLhs PExp L
    f [PExp L]
    es
                                       case mlhs of
                                        Just (Name L
    f',[PExp L]
    es',Bool
    b,[SrcSpan]
    pts) ->
                                           let [SrcSpan
    x,SrcSpan
    y] = L -> [SrcSpan]
    srcInfoPoints L
    l
                                            in Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Name L, [PExp L], Bool, [SrcSpan])
     -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan])))
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a b. (a -> b) -> a -> b
    $ (Name L, [PExp L], Bool, [SrcSpan])
    -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    forall a. a -> Maybe a
    Just (Name L
    f',[PExp L]
    es',Bool
    b,SrcSpan
    xSrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    :[SrcSpan]
    pts[SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++[SrcSpan
    y])
                                        Maybe (Name L, [PExp L], Bool, [SrcSpan])
    _ -> Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Name L, [PExp L], Bool, [SrcSpan])
    forall a. Maybe a
    Nothing
    isFunLhs PExp L
    _ [PExp L]
    _ = Maybe (Name L, [PExp L], Bool, [SrcSpan])
    -> P (Maybe (Name L, [PExp L], Bool, [SrcSpan]))
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Name L, [PExp L], Bool, [SrcSpan])
    forall a. Maybe a
    Nothing

    -- Separating between signature declarations and value definitions in
    -- a post-processing step

    checkSigVar :: PExp L -> P (Name L)
    checkSigVar :: PExp L -> P (Name L)
    checkSigVar (Var L
    _ (UnQual L
    l Name L
    n)) = Name L -> P (Name L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name L -> P (Name L)) -> Name L -> P (Name L)
    forall a b. (a -> b) -> a -> b
    $ (L -> L) -> Name L -> Name L
    forall a b. (a -> b) -> Name a -> Name b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (L -> L -> L
    forall a b. a -> b -> a
    const L
    l) Name L
    n
    checkSigVar PExp L
    e = String -> P (Name L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P (Name L)) -> String -> P (Name L)
    forall a b. (a -> b) -> a -> b
    $ String
    "Left-hand side of type signature is not a variable: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PExp L -> String
    forall a. Pretty a => a -> String
    prettyPrint PExp L
    e

    checkExplicitPatSyn :: S -> S -> ([Decl L], [S]) -> S -> P (PatternSynDirection L)
    checkExplicitPatSyn :: SrcSpan
    -> SrcSpan
    -> ([Decl L], [SrcSpan])
    -> SrcSpan
    -> P (PatternSynDirection L)
    checkExplicitPatSyn SrcSpan
    whereLoc SrcSpan
    openLoc ([Decl L]
    decls, [SrcSpan]
    semis) SrcSpan
    closeLoc =
      let l :: L
    l = SrcSpan
    whereLoc SrcSpan -> SrcSpan -> L
    <^^> SrcSpan
    closeLoc  L -> [SrcSpan] -> L
    <** ([SrcSpan
    whereLoc, SrcSpan
    openLoc] [SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++ [SrcSpan]
    semis [SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++ [SrcSpan
    closeLoc])
      in  L -> [Decl L] -> PatternSynDirection L
    forall l. l -> [Decl l] -> PatternSynDirection l
    S.ExplicitBidirectional L
    l  ([Decl L] -> PatternSynDirection L)
    -> P [Decl L] -> P (PatternSynDirection L)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Decl L -> P (Decl L)) -> [Decl L] -> P [Decl L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Decl L -> P (Decl L)
    checkDecls [Decl L]
    decls
      where
        checkDecls :: Decl L -> P (Decl L)
        checkDecls :: Decl L -> P (Decl L)
    checkDecls p :: Decl L
    p@(PatBind L
    _ Pat L
    pat Rhs L
    _ Maybe (Binds L)
    _) =
          case Pat L
    pat of
            PApp L
    _ QName L
    _ [Pat L]
    _        -> Decl L -> P (Decl L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Decl L
    p
            PInfixApp L
    _ Pat L
    _ QName L
    _ Pat L
    _ ->  Decl L -> P (Decl L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Decl L
    p
            Pat L
    _ -> String -> P (Decl L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal pattern binding in PatternSynonym"
        checkDecls Decl L
    _                 = String -> P (Decl L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "pattern synonym 'where' clause must contain a PatBind"

    -----------------------------------------------------------------------------
    -- In a class or instance body, a pattern binding must be of a variable.

    checkClassBody :: [ClassDecl L] -> P [ClassDecl L]
    checkClassBody :: [ClassDecl L] -> P [ClassDecl L]
    checkClassBody [ClassDecl L]
    decls = do
        (ClassDecl L -> P ()) -> [ClassDecl L] -> P ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ClassDecl L -> P ()
    checkClassMethodDef [ClassDecl L]
    decls
        [ClassDecl L] -> P [ClassDecl L]
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ClassDecl L]
    decls
      where checkClassMethodDef :: ClassDecl L -> P ()
    checkClassMethodDef (ClsDecl L
    _ Decl L
    decl) = Decl L -> P ()
    checkMethodDef Decl L
    decl
            checkClassMethodDef ClassDecl L
    _ = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    checkInstBody :: [InstDecl L] -> P [InstDecl L]
    checkInstBody :: [InstDecl L] -> P [InstDecl L]
    checkInstBody [InstDecl L]
    decls = do
        (InstDecl L -> P ()) -> [InstDecl L] -> P ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ InstDecl L -> P ()
    checkInstMethodDef [InstDecl L]
    decls
        [InstDecl L] -> P [InstDecl L]
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [InstDecl L]
    decls
      where checkInstMethodDef :: InstDecl L -> P ()
    checkInstMethodDef (InsDecl L
    _ Decl L
    decl) = Decl L -> P ()
    checkMethodDef Decl L
    decl
            checkInstMethodDef InstDecl L
    _ = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    checkMethodDef :: Decl L -> P ()
    checkMethodDef :: Decl L -> P ()
    checkMethodDef (PatBind L
    _ (PVar L
    _ Name L
    _) Rhs L
    _ Maybe (Binds L)
    _) = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkMethodDef (PatBind L
    loc Pat L
    _ Rhs L
    _ Maybe (Binds L)
    _) =
        String -> P ()
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "illegal method definition" P () -> SrcLoc -> P ()
    forall a. P a -> SrcLoc -> P a
    `atSrcLoc` L -> SrcLoc
    forall si. SrcInfo si => L -> si
    fromSrcInfo L
    loc
    checkMethodDef Decl L
    _ = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    checkDefSigDef :: Decl L -> P (Name L,S.Type L,S)
    checkDefSigDef :: Decl L -> P (Name L, Type L, SrcSpan)
    checkDefSigDef (TypeSig L
    loc [Name L
    name] Type L
    typ) =
      let (SrcSpan
    b:[SrcSpan]
    _) = L -> [SrcSpan]
    srcInfoPoints L
    loc in (Name L, Type L, SrcSpan) -> P (Name L, Type L, SrcSpan)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name L
    name,Type L
    typ,SrcSpan
    b)
    checkDefSigDef (TypeSig L
    _ [Name L]
    _ Type L
    _) =
        String -> P (Name L, Type L, SrcSpan)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "default signature must be for a single name"
    checkDefSigDef Decl L
    _ =
        String -> P (Name L, Type L, SrcSpan)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "default signature must be a type signature"

    -----------------------------------------------------------------------------
    -- Check that an identifier or symbol is unqualified.
    -- For occasions when doing this in the grammar would cause conflicts.

    checkUnQual :: QName L -> P (Name L)
    checkUnQual :: QName L -> P (Name L)
    checkUnQual (Qual  L
    _ ModuleName L
    _ Name L
    _) = String -> P (Name L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal qualified name"
    checkUnQual (UnQual  L
    l Name L
    n) = Name L -> P (Name L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name L -> P (Name L)) -> Name L -> P (Name L)
    forall a b. (a -> b) -> a -> b
    $ (L -> L) -> Name L -> Name L
    forall a b. (a -> b) -> Name a -> Name b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (L -> L -> L
    forall a b. a -> b -> a
    const L
    l) Name L
    n
    checkUnQual (Special L
    _ SpecialCon L
    _) = String -> P (Name L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal special name"

    checkQualOrUnQual :: QName L -> P (QName L)
    checkQualOrUnQual :: QName L -> P (QName L)
    checkQualOrUnQual n :: QName L
    n@(Qual  L
    _ ModuleName L
    _ Name L
    _) = QName L -> P (QName L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName L
    n
    checkQualOrUnQual n :: QName L
    n@(UnQual  L
    _ Name L
    _) = QName L -> P (QName L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName L
    n
    checkQualOrUnQual (Special L
    _ SpecialCon L
    _)   = String -> P (QName L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal special name"

    -----------------------------------------------------------------------------
    -- Check that two xml tag names are equal
    checkEqNames :: XName L -> XName L -> P (XName L)
    checkEqNames :: XName L -> XName L -> P (XName L)
    checkEqNames n :: XName L
    n@(XName L
    _ String
    n1) (XName L
    _ String
    n2)
        | String
    n1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    n2  = XName L -> P (XName L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return XName L
    n
    checkEqNames n :: XName L
    n@(XDomName L
    _ String
    d1 String
    n1) (XDomName L
    _ String
    d2 String
    n2)
        | String
    n1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    n2 Bool -> Bool -> Bool
    && String
    d1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    d2 = XName L -> P (XName L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return XName L
    n
    checkEqNames XName L
    n XName L
    m = String -> P (XName L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P (XName L)) -> String -> P (XName L)
    forall a b. (a -> b) -> a -> b
    $ String
    "opening tag '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ XName L -> String
    forall {l}. XName l -> String
    showTag XName L
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                       String
    "' does not match closing tag '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ XName L -> String
    forall {l}. XName l -> String
    showTag XName L
    m String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
        where
            showTag :: XName l -> String
    showTag (XName l
    _ String
    n') = String
    n'
            showTag (XDomName l
    _ String
    d String
    n') = String
    d String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n'

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

    checkPrec :: Integer -> P Int
    checkPrec :: Integer -> P Int
    checkPrec Integer
    i | Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    i Bool -> Bool -> Bool
    && Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    9 = Int -> P Int
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    i)
                | Bool
    otherwise        = String -> P Int
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Illegal precedence " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    i)

    mkRecConstrOrUpdate :: PExp L -> [PFieldUpdate L] -> P (PExp L)
    mkRecConstrOrUpdate :: PExp L -> [PFieldUpdate L] -> P (PExp L)
    mkRecConstrOrUpdate (Con L
    l QName L
    c) [PFieldUpdate L]
    fs       = PExp L -> P (PExp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> QName L -> [PFieldUpdate L] -> PExp L
    forall l. l -> QName l -> [PFieldUpdate l] -> PExp l
    RecConstr L
    l QName L
    c [PFieldUpdate L]
    fs)
    mkRecConstrOrUpdate PExp L
    e         fs :: [PFieldUpdate L]
    fs@(PFieldUpdate L
    _:[PFieldUpdate L]
    _) = PExp L -> P (PExp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> PExp L -> [PFieldUpdate L] -> PExp L
    forall l. l -> PExp l -> [PFieldUpdate l] -> PExp l
    RecUpdate (PExp L -> L
    forall l. PExp l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PExp L
    e) PExp L
    e [PFieldUpdate L]
    fs)
    mkRecConstrOrUpdate PExp L
    _         [PFieldUpdate L]
    _        = String -> P (PExp L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Empty record update"

    updateQNameLoc :: l -> QName l -> QName l
    updateQNameLoc :: forall l. l -> QName l -> QName l
    updateQNameLoc l
    l (Qual l
    _ ModuleName l
    mn Name l
    n) = l -> ModuleName l -> Name l -> QName l
    forall l. l -> ModuleName l -> Name l -> QName l
    Qual l
    l ModuleName l
    mn Name l
    n
    updateQNameLoc l
    l (UnQual l
    _ Name l
    n)  = l -> Name l -> QName l
    forall l. l -> Name l -> QName l
    UnQual l
    l Name l
    n
    updateQNameLoc l
    l (Special l
    _ SpecialCon l
    s) = l -> SpecialCon l -> QName l
    forall l. l -> SpecialCon l -> QName l
    Special l
    l SpecialCon l
    s

    -----------------------------------------------------------------------------
    -- For standalone top level Decl parser, check that we actually only
    -- parsed one Decl. This is needed since we parse matches of the same
    -- FunBind as multiple separate declarations, and merge them after.
    -- This should be called *after* checkRevDecls.

    checkSingleDecl :: [Decl L] -> P (Decl L)
    checkSingleDecl :: [Decl L] -> P (Decl L)
    checkSingleDecl [Decl L
    d] = Decl L -> P (Decl L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Decl L
    d
    checkSingleDecl [Decl L]
    ds =
        String -> P (Decl L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P (Decl L)) -> String -> P (Decl L)
    forall a b. (a -> b) -> a -> b
    $ String
    "Expected a single declaration, found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([Decl L] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Decl L]
    ds)

    -- Reverse a list of declarations, merging adjacent FunBinds of the
    -- same name and checking that their arities match.

    checkRevDecls :: [Decl L] -> P [Decl L]
    checkRevDecls :: [Decl L] -> P [Decl L]
    checkRevDecls = [Decl L] -> [Decl L] -> P [Decl L]
    mergeFunBinds []
        where
        mergeFunBinds :: [Decl L] -> [Decl L] -> P [Decl L]
    mergeFunBinds [Decl L]
    revDs [] = [Decl L] -> P [Decl L]
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Decl L]
    revDs
        mergeFunBinds [Decl L]
    revDs (FunBind L
    l' ms1 :: [Match L]
    ms1@(Match L
    _ Name L
    name [Pat L]
    ps Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _):[Decl L]
    ds1) =
            [Match L] -> [Decl L] -> L -> P [Decl L]
    mergeMatches [Match L]
    ms1 [Decl L]
    ds1 L
    l'
            where
            arity :: Int
    arity = [Pat L] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat L]
    ps
            mergeMatches :: [Match L] -> [Decl L] -> L -> P [Decl L]
    mergeMatches [Match L]
    ms' (FunBind L
    _ ms :: [Match L]
    ms@(Match L
    loc Name L
    name' [Pat L]
    ps' Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _):[Decl L]
    ds) L
    l
                | Name L
    name' Name L -> Name L -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= Name L
    name = do
                ignoreArity <- P Bool
    getIgnoreFunctionArity
                if length ps' == arity || ignoreArity
                  then mergeMatches (ms++ms') ds (loc <++> l)
                  else fail ("arity mismatch for '" ++ prettyPrint name ++ "'")
                        `atSrcLoc` fromSrcInfo loc
            mergeMatches [Match L]
    ms' [Decl L]
    ds L
    l = [Decl L] -> [Decl L] -> P [Decl L]
    mergeFunBinds (L -> [Match L] -> Decl L
    forall l. l -> [Match l] -> Decl l
    FunBind L
    l [Match L]
    ms'Decl L -> [Decl L] -> [Decl L]
    forall a. a -> [a] -> [a]
    :[Decl L]
    revDs) [Decl L]
    ds
        mergeFunBinds [Decl L]
    revDs (FunBind L
    l' ims1 :: [Match L]
    ims1@(InfixMatch L
    _ Pat L
    _ Name L
    name [Pat L]
    _ Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _):[Decl L]
    ds1) =
            [Match L] -> [Decl L] -> L -> P [Decl L]
    mergeInfix [Match L]
    ims1 [Decl L]
    ds1 L
    l'
            where
            mergeInfix :: [Match L] -> [Decl L] -> L -> P [Decl L]
    mergeInfix [Match L]
    ims' (FunBind L
    _ ims :: [Match L]
    ims@(InfixMatch L
    loc Pat L
    _ Name L
    name' [Pat L]
    _ Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _):[Decl L]
    ds) L
    l
                | Name L
    name' Name L -> Name L -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= Name L
    name =
                [Match L] -> [Decl L] -> L -> P [Decl L]
    mergeInfix ([Match L]
    ims[Match L] -> [Match L] -> [Match L]
    forall a. [a] -> [a] -> [a]
    ++[Match L]
    ims') [Decl L]
    ds (L
    loc L -> L -> L
    <++> L
    l)
            mergeInfix [Match L]
    ms' [Decl L]
    ds L
    l = [Decl L] -> [Decl L] -> P [Decl L]
    mergeFunBinds (L -> [Match L] -> Decl L
    forall l. l -> [Match l] -> Decl l
    FunBind L
    l [Match L]
    ms'Decl L -> [Decl L] -> [Decl L]
    forall a. a -> [a] -> [a]
    :[Decl L]
    revDs) [Decl L]
    ds
        mergeFunBinds [Decl L]
    revDs (Decl L
    d:[Decl L]
    ds) = [Decl L] -> [Decl L] -> P [Decl L]
    mergeFunBinds (Decl L
    dDecl L -> [Decl L] -> [Decl L]
    forall a. a -> [a] -> [a]
    :[Decl L]
    revDs) [Decl L]
    ds

    checkRevClsDecls :: [ClassDecl L] -> P [ClassDecl L]
    checkRevClsDecls :: [ClassDecl L] -> P [ClassDecl L]
    checkRevClsDecls = [ClassDecl L] -> [ClassDecl L] -> P [ClassDecl L]
    mergeClsFunBinds []
        where
        mergeClsFunBinds :: [ClassDecl L] -> [ClassDecl L] -> P [ClassDecl L]
    mergeClsFunBinds [ClassDecl L]
    revDs [] = [ClassDecl L] -> P [ClassDecl L]
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ClassDecl L]
    revDs
        mergeClsFunBinds [ClassDecl L]
    revDs (ClsDecl L
    l' (FunBind L
    _ ms1 :: [Match L]
    ms1@(Match L
    _ Name L
    name [Pat L]
    ps Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[ClassDecl L]
    ds1) =
            [Match L] -> [ClassDecl L] -> L -> P [ClassDecl L]
    mergeMatches [Match L]
    ms1 [ClassDecl L]
    ds1 L
    l'
            where
            arity :: Int
    arity = [Pat L] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat L]
    ps
            mergeMatches :: [Match L] -> [ClassDecl L] -> L -> P [ClassDecl L]
    mergeMatches [Match L]
    ms' (ClsDecl L
    _ (FunBind L
    _ ms :: [Match L]
    ms@(Match L
    loc Name L
    name' [Pat L]
    ps' Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[ClassDecl L]
    ds) L
    l
                | Name L
    name' Name L -> Name L -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= Name L
    name = do
                ignoreArity <- P Bool
    getIgnoreFunctionArity
                if length ps' == arity || ignoreArity
                  then mergeMatches (ms++ms') ds (loc <++> l)
                  else fail ("arity mismatch for '" ++ prettyPrint name ++ "'")
                        `atSrcLoc` fromSrcInfo loc
            mergeMatches [Match L]
    ms' [ClassDecl L]
    ds L
    l = [ClassDecl L] -> [ClassDecl L] -> P [ClassDecl L]
    mergeClsFunBinds (L -> Decl L -> ClassDecl L
    forall l. l -> Decl l -> ClassDecl l
    ClsDecl L
    l (L -> [Match L] -> Decl L
    forall l. l -> [Match l] -> Decl l
    FunBind L
    l [Match L]
    ms')ClassDecl L -> [ClassDecl L] -> [ClassDecl L]
    forall a. a -> [a] -> [a]
    :[ClassDecl L]
    revDs) [ClassDecl L]
    ds
        mergeClsFunBinds [ClassDecl L]
    revDs (ClsDecl L
    l' (FunBind L
    _ ims1 :: [Match L]
    ims1@(InfixMatch L
    _ Pat L
    _ Name L
    name [Pat L]
    _ Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[ClassDecl L]
    ds1) =
            [Match L] -> [ClassDecl L] -> L -> P [ClassDecl L]
    mergeInfix [Match L]
    ims1 [ClassDecl L]
    ds1 L
    l'
            where
            mergeInfix :: [Match L] -> [ClassDecl L] -> L -> P [ClassDecl L]
    mergeInfix [Match L]
    ims' (ClsDecl L
    _ (FunBind L
    _ ims :: [Match L]
    ims@(InfixMatch L
    loc Pat L
    _ Name L
    name' [Pat L]
    _ Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[ClassDecl L]
    ds) L
    l
                | Name L
    name' Name L -> Name L -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= Name L
    name =
                [Match L] -> [ClassDecl L] -> L -> P [ClassDecl L]
    mergeInfix ([Match L]
    ims[Match L] -> [Match L] -> [Match L]
    forall a. [a] -> [a] -> [a]
    ++[Match L]
    ims') [ClassDecl L]
    ds (L
    loc L -> L -> L
    <++> L
    l)
            mergeInfix [Match L]
    ms' [ClassDecl L]
    ds L
    l = [ClassDecl L] -> [ClassDecl L] -> P [ClassDecl L]
    mergeClsFunBinds (L -> Decl L -> ClassDecl L
    forall l. l -> Decl l -> ClassDecl l
    ClsDecl L
    l (L -> [Match L] -> Decl L
    forall l. l -> [Match l] -> Decl l
    FunBind L
    l [Match L]
    ms')ClassDecl L -> [ClassDecl L] -> [ClassDecl L]
    forall a. a -> [a] -> [a]
    :[ClassDecl L]
    revDs) [ClassDecl L]
    ds
        mergeClsFunBinds [ClassDecl L]
    revDs (ClassDecl L
    d:[ClassDecl L]
    ds) = [ClassDecl L] -> [ClassDecl L] -> P [ClassDecl L]
    mergeClsFunBinds (ClassDecl L
    dClassDecl L -> [ClassDecl L] -> [ClassDecl L]
    forall a. a -> [a] -> [a]
    :[ClassDecl L]
    revDs) [ClassDecl L]
    ds

    checkRevInstDecls :: [InstDecl L] -> P [InstDecl L]
    checkRevInstDecls :: [InstDecl L] -> P [InstDecl L]
    checkRevInstDecls = [InstDecl L] -> [InstDecl L] -> P [InstDecl L]
    mergeInstFunBinds []
        where
        mergeInstFunBinds :: [InstDecl L] -> [InstDecl L] -> P [InstDecl L]
        mergeInstFunBinds :: [InstDecl L] -> [InstDecl L] -> P [InstDecl L]
    mergeInstFunBinds [InstDecl L]
    revDs [] = [InstDecl L] -> P [InstDecl L]
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [InstDecl L]
    revDs
        mergeInstFunBinds [InstDecl L]
    revDs (InsDecl L
    l' (FunBind L
    _ ms1 :: [Match L]
    ms1@(Match L
    _ Name L
    name [Pat L]
    ps Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[InstDecl L]
    ds1) =
            [Match L] -> [InstDecl L] -> L -> P [InstDecl L]
    mergeMatches [Match L]
    ms1 [InstDecl L]
    ds1 L
    l'
            where
            arity :: Int
    arity = [Pat L] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat L]
    ps
            mergeMatches :: [Match L] -> [InstDecl L] -> L -> P [InstDecl L]
    mergeMatches [Match L]
    ms' (InsDecl L
    _ (FunBind L
    _ ms :: [Match L]
    ms@(Match L
    loc Name L
    name' [Pat L]
    ps' Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[InstDecl L]
    ds) L
    l
                | Name L
    name' Name L -> Name L -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= Name L
    name = do
                ignoreArity <- P Bool
    getIgnoreFunctionArity
                if length ps' == arity || ignoreArity
                  then mergeMatches (ms++ms') ds (loc <++> l)
                  else fail ("arity mismatch for '" ++ prettyPrint name ++ "'")
                        `atSrcLoc` fromSrcInfo loc
            mergeMatches [Match L]
    ms' [InstDecl L]
    ds L
    l = [InstDecl L] -> [InstDecl L] -> P [InstDecl L]
    mergeInstFunBinds (L -> Decl L -> InstDecl L
    forall l. l -> Decl l -> InstDecl l
    InsDecl L
    l (L -> [Match L] -> Decl L
    forall l. l -> [Match l] -> Decl l
    FunBind L
    l [Match L]
    ms')InstDecl L -> [InstDecl L] -> [InstDecl L]
    forall a. a -> [a] -> [a]
    :[InstDecl L]
    revDs) [InstDecl L]
    ds
        mergeInstFunBinds [InstDecl L]
    revDs (InsDecl L
    l' (FunBind L
    _ ims1 :: [Match L]
    ims1@(InfixMatch L
    _ Pat L
    _ Name L
    name [Pat L]
    _ Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[InstDecl L]
    ds1) =
            [Match L] -> [InstDecl L] -> L -> P [InstDecl L]
    mergeInfix [Match L]
    ims1 [InstDecl L]
    ds1 L
    l'
            where
            mergeInfix :: [Match L] -> [InstDecl L] -> L -> P [InstDecl L]
    mergeInfix [Match L]
    ims' (InsDecl L
    _ (FunBind L
    _ ims :: [Match L]
    ims@(InfixMatch L
    loc Pat L
    _ Name L
    name' [Pat L]
    _ Rhs L
    _ Maybe (Binds L)
    _:[Match L]
    _)):[InstDecl L]
    ds) L
    l
                | Name L
    name' Name L -> Name L -> Bool
    forall (a :: * -> *) l1 l2.
    (Annotated a, Eq (a ())) =>
    a l1 -> a l2 -> Bool
    =~= Name L
    name =
                [Match L] -> [InstDecl L] -> L -> P [InstDecl L]
    mergeInfix ([Match L]
    ims[Match L] -> [Match L] -> [Match L]
    forall a. [a] -> [a] -> [a]
    ++[Match L]
    ims') [InstDecl L]
    ds (L
    loc L -> L -> L
    <++> L
    l)
            mergeInfix [Match L]
    ms' [InstDecl L]
    ds L
    l = [InstDecl L] -> [InstDecl L] -> P [InstDecl L]
    mergeInstFunBinds (L -> Decl L -> InstDecl L
    forall l. l -> Decl l -> InstDecl l
    InsDecl L
    l (L -> [Match L] -> Decl L
    forall l. l -> [Match l] -> Decl l
    FunBind L
    l [Match L]
    ms')InstDecl L -> [InstDecl L] -> [InstDecl L]
    forall a. a -> [a] -> [a]
    :[InstDecl L]
    revDs) [InstDecl L]
    ds
        mergeInstFunBinds [InstDecl L]
    revDs (InstDecl L
    d:[InstDecl L]
    ds) = [InstDecl L] -> [InstDecl L] -> P [InstDecl L]
    mergeInstFunBinds (InstDecl L
    dInstDecl L -> [InstDecl L] -> [InstDecl L]
    forall a. a -> [a] -> [a]
    :[InstDecl L]
    revDs) [InstDecl L]
    ds

    ----------------------------------------------------------------
    -- Check that newtype declarations have
    -- the right number (1) of constructors

    checkDataOrNew :: DataOrNew L -> [QualConDecl L] -> P ()
    checkDataOrNew :: DataOrNew L -> [QualConDecl L] -> P ()
    checkDataOrNew (DataType L
    _) [QualConDecl L]
    _  = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkDataOrNew (NewType L
    _) [QualConDecl L
    _ Maybe [TyVarBind L]
    _ Maybe (Context L)
    _ ConDecl L
    x] = ConDecl L -> P ()
    forall {m :: * -> *} {l}. MonadFail m => ConDecl l -> m ()
    cX ConDecl L
    x P () -> P () -> P ()
    forall a b. P a -> P b -> P b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where cX :: ConDecl l -> m ()
    cX (ConDecl l
    _ Name l
    _ [Type l
    _]) = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            cX (RecDecl l
    _ Name l
    _ [FieldDecl l
    _]) = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            cX ConDecl l
    _ = String -> m ()
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "newtype declaration constructor must have exactly one parameter."
    checkDataOrNew DataOrNew L
    _        [QualConDecl L]
    _  = String -> P ()
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "newtype declaration must have exactly one constructor."

    checkDataOrNewG :: DataOrNew L -> [GadtDecl L] -> P ()
    checkDataOrNewG :: DataOrNew L -> [GadtDecl L] -> P ()
    checkDataOrNewG (DataType L
    _) [GadtDecl L]
    _  = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkDataOrNewG (NewType L
    _) [GadtDecl L
    _] = () -> P ()
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkDataOrNewG DataOrNew L
    _        [GadtDecl L]
    _  = String -> P ()
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "newtype declaration must have exactly one constructor."

    checkSimpleType :: PType L -> P (DeclHead L)
    checkSimpleType :: PType L -> P (DeclHead L)
    checkSimpleType = String -> PType L -> P (DeclHead L)
    checkSimple String
    "test"

    ---------------------------------------
    -- Check actual types

    -- | Add a strictness/unpack annotation on a type.
    bangType :: Maybe (L -> BangType L, S) -> Maybe (Unpackedness L) -> PType L -> PType L
    bangType :: Maybe (L -> BangType L, SrcSpan)
    -> Maybe (Unpackedness L) -> PType L -> PType L
    bangType Maybe (L -> BangType L, SrcSpan)
    mstrict Maybe (Unpackedness L)
    munpack PType L
    ty =
      case (Maybe (L -> BangType L, SrcSpan)
    mstrict,Maybe (Unpackedness L)
    munpack) of
        (Maybe (L -> BangType L, SrcSpan)
    Nothing, Just Unpackedness L
    upack) -> L -> BangType L -> Unpackedness L -> PType L -> PType L
    forall l. l -> BangType l -> Unpackedness l -> PType l -> PType l
    TyBang (Unpackedness L -> L
    forall l. Unpackedness l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Unpackedness L
    upack L -> L -> L
    <++> PType L -> L
    forall l. PType l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PType L
    ty) (L -> BangType L
    forall l. l -> BangType l
    NoStrictAnnot L
    noSrcSpan) Unpackedness L
    upack PType L
    ty
        (Just (L -> BangType L
    strict, SrcSpan
    pos), Maybe (Unpackedness L)
    _)  ->
          L -> BangType L -> Unpackedness L -> PType L -> PType L
    forall l. l -> BangType l -> Unpackedness l -> PType l -> PType l
    TyBang ((Unpackedness L -> L) -> Maybe (Unpackedness L) -> Maybe L
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Unpackedness L -> L
    forall l. Unpackedness l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Maybe (Unpackedness L)
    munpack Maybe L -> L -> L
    <?+> SrcSpan -> L
    noInfoSpan SrcSpan
    pos L -> L -> L
    <++> PType L -> L
    forall l. PType l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PType L
    ty) (L -> BangType L
    strict (SrcSpan -> L
    noInfoSpan SrcSpan
    pos))
            (Unpackedness L -> Maybe (Unpackedness L) -> Unpackedness L
    forall a. a -> Maybe a -> a
    fromMaybe (L -> Unpackedness L
    forall l. l -> Unpackedness l
    NoUnpackPragma L
    noSrcSpan) Maybe (Unpackedness L)
    munpack) PType L
    ty
        (Maybe (L -> BangType L, SrcSpan)
    Nothing, Maybe (Unpackedness L)
    Nothing) -> PType L
    ty

    checkType :: PType L -> P (S.Type L)
    checkType :: PType L -> P (Type L)
    checkType PType L
    t = PType L -> Bool -> P (Type L)
    checkT PType L
    t Bool
    False

    checkT :: PType L -> Bool -> P (S.Type L)
    checkT :: PType L -> Bool -> P (Type L)
    checkT PType L
    t Bool
    simple = case PType L
    t of
        TyForall L
    l Maybe [TyVarBind L]
    Nothing Maybe (PContext L)
    cs PType L
    pt    -> do
                Bool -> P () -> P ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    simple (P () -> P ()) -> P () -> P ()
    forall a b. (a -> b) -> a -> b
    $ KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    ExplicitForAll
                ctxt <- Maybe (PContext L) -> P (Maybe (Context L))
    checkContext Maybe (PContext L)
    cs
                check1Type pt (S.TyForall l Nothing ctxt)
        TyForall L
    l Maybe [TyVarBind L]
    tvs Maybe (PContext L)
    cs PType L
    pt -> do
                KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    ExplicitForAll
                ctxt <- Maybe (PContext L) -> P (Maybe (Context L))
    checkContext Maybe (PContext L)
    cs
                check1Type pt (S.TyForall l tvs ctxt)
        TyStar  L
    l         -> Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L)) -> Type L -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ L -> Type L
    forall l. l -> Type l
    S.TyStar L
    l
        TyFun   L
    l PType L
    at PType L
    rt   -> PType L -> PType L -> (Type L -> Type L -> Type L) -> P (Type L)
    check2Types PType L
    at PType L
    rt (L -> Type L -> Type L -> Type L
    forall l. l -> Type l -> Type l -> Type l
    S.TyFun L
    l)
        TyTuple L
    l Boxed
    b [PType L]
    pts   -> [PType L] -> P [Type L]
    checkTypes [PType L]
    pts P [Type L] -> ([Type L] -> P (Type L)) -> P (Type L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L))
    -> ([Type L] -> Type L) -> [Type L] -> P (Type L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> Boxed -> [Type L] -> Type L
    forall l. l -> Boxed -> [Type l] -> Type l
    S.TyTuple L
    l Boxed
    b
        TyUnboxedSum L
    l [PType L]
    es -> [PType L] -> P [Type L]
    checkTypes [PType L]
    es P [Type L] -> ([Type L] -> P (Type L)) -> P (Type L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L))
    -> ([Type L] -> Type L) -> [Type L] -> P (Type L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . L -> [Type L] -> Type L
    forall l. l -> [Type l] -> Type l
    S.TyUnboxedSum L
    l
        TyList  L
    l PType L
    pt      -> PType L -> (Type L -> Type L) -> P (Type L)
    check1Type PType L
    pt (L -> Type L -> Type L
    forall l. l -> Type l -> Type l
    S.TyList L
    l)
        TyParArray L
    l PType L
    pt   -> PType L -> (Type L -> Type L) -> P (Type L)
    check1Type PType L
    pt (L -> Type L -> Type L
    forall l. l -> Type l -> Type l
    S.TyParArray L
    l)
        TyApp   L
    l PType L
    ft PType L
    at   -> PType L -> PType L -> (Type L -> Type L -> Type L) -> P (Type L)
    check2Types PType L
    ft PType L
    at (L -> Type L -> Type L -> Type L
    forall l. l -> Type l -> Type l -> Type l
    S.TyApp L
    l)
        TyVar   L
    l Name L
    n       -> Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L)) -> Type L -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ L -> Name L -> Type L
    forall l. l -> Name l -> Type l
    S.TyVar L
    l Name L
    n
        TyCon   L
    l QName L
    n       -> do
                QName L -> P ()
    checkAndWarnTypeOperators QName L
    n
                Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L)) -> Type L -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ L -> QName L -> Type L
    forall l. l -> QName l -> Type l
    S.TyCon L
    l QName L
    n
        TyParen L
    l PType L
    pt      -> PType L -> (Type L -> Type L) -> P (Type L)
    check1Type PType L
    pt (L -> Type L -> Type L
    forall l. l -> Type l -> Type l
    S.TyParen L
    l)
        -- Here we know that t will be used as an actual type (and not a data constructor)
        -- so we can check that TypeOperators are enabled.
        TyInfix L
    l PType L
    at MaybePromotedName L
    op PType L
    bt -> QName L -> P ()
    checkAndWarnTypeOperators (MaybePromotedName L -> QName L
    forall l. MaybePromotedName l -> QName l
    getMaybePromotedQName MaybePromotedName L
    op)
                               P () -> P (Type L) -> P (Type L)
    forall a b. P a -> P b -> P b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> PType L -> PType L -> (Type L -> Type L -> Type L) -> P (Type L)
    check2Types PType L
    at PType L
    bt ((Type L -> MaybePromotedName L -> Type L -> Type L)
    -> MaybePromotedName L -> Type L -> Type L -> Type L
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (L -> Type L -> MaybePromotedName L -> Type L -> Type L
    forall l. l -> Type l -> MaybePromotedName l -> Type l -> Type l
    S.TyInfix L
    l) MaybePromotedName L
    op)
        TyKind  L
    l PType L
    pt Type L
    k    -> PType L -> (Type L -> Type L) -> P (Type L)
    check1Type PType L
    pt ((Type L -> Type L -> Type L) -> Type L -> Type L -> Type L
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (L -> Type L -> Type L -> Type L
    forall l. l -> Type l -> Type l -> Type l
    S.TyKind L
    l) Type L
    k)

        TyPromoted L
    l Promoted L
    p -> Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L)) -> Type L -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ L -> Promoted L -> Type L
    forall l. l -> Promoted l -> Type l
    S.TyPromoted L
    l Promoted L
    p -- ??
        TyEquals L
    l PType L
    at PType L
    bt   -> PType L -> PType L -> (Type L -> Type L -> Type L) -> P (Type L)
    check2Types PType L
    at PType L
    bt (L -> Type L -> Type L -> Type L
    forall l. l -> Type l -> Type l -> Type l
    S.TyEquals L
    l)
        TySplice L
    l Splice L
    s        -> do
                                  KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    TemplateHaskell
                                  Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L)) -> Type L -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ L -> Splice L -> Type L
    forall l. l -> Splice l -> Type l
    S.TySplice L
    l Splice L
    s
        TyBang L
    l BangType L
    b Unpackedness L
    u PType L
    t' -> PType L -> (Type L -> Type L) -> P (Type L)
    check1Type PType L
    t' (L -> BangType L -> Unpackedness L -> Type L -> Type L
    forall l. l -> BangType l -> Unpackedness l -> Type l -> Type l
    S.TyBang L
    l BangType L
    b Unpackedness L
    u)
        TyWildCard L
    l Maybe (Name L)
    mn -> Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L)) -> Type L -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ L -> Maybe (Name L) -> Type L
    forall l. l -> Maybe (Name l) -> Type l
    S.TyWildCard L
    l Maybe (Name L)
    mn
        TyQuasiQuote L
    l String
    n String
    s -> do
                                  KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    QuasiQuotes
                                  Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L)) -> Type L -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ L -> String -> String -> Type L
    forall l. l -> String -> String -> Type l
    S.TyQuasiQuote L
    l String
    n String
    s
        PType L
    _   -> String -> P (Type L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> P (Type L)) -> String -> P (Type L)
    forall a b. (a -> b) -> a -> b
    $ String
    "Parse error in type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PType L -> String
    forall a. Pretty a => a -> String
    prettyPrint PType L
    t

    getMaybePromotedQName :: MaybePromotedName l -> QName l
    getMaybePromotedQName :: forall l. MaybePromotedName l -> QName l
    getMaybePromotedQName (PromotedName l
    _ QName l
    q) = QName l
    q
    getMaybePromotedQName (UnpromotedName l
    _ QName l
    q) = QName l
    q

    check1Type :: PType L -> (S.Type L -> S.Type L) -> P (S.Type L)
    check1Type :: PType L -> (Type L -> Type L) -> P (Type L)
    check1Type PType L
    pt Type L -> Type L
    f = PType L -> Bool -> P (Type L)
    checkT PType L
    pt Bool
    True P (Type L) -> (Type L -> P (Type L)) -> P (Type L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> P (Type L))
    -> (Type L -> Type L) -> Type L -> P (Type L)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type L -> Type L
    f

    check2Types :: PType L -> PType L -> (S.Type L -> S.Type L -> S.Type L) -> P (S.Type L)
    check2Types :: PType L -> PType L -> (Type L -> Type L -> Type L) -> P (Type L)
    check2Types PType L
    at PType L
    bt Type L -> Type L -> Type L
    f = PType L -> Bool -> P (Type L)
    checkT PType L
    at Bool
    True P (Type L) -> (Type L -> P (Type L)) -> P (Type L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Type L
    a -> PType L -> Bool -> P (Type L)
    checkT PType L
    bt Bool
    True P (Type L) -> (Type L -> P (Type L)) -> P (Type L)
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Type L
    b -> Type L -> P (Type L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type L -> Type L -> Type L
    f Type L
    a Type L
    b)

    checkTypes :: [PType L] -> P [S.Type L]
    checkTypes :: [PType L] -> P [Type L]
    checkTypes = (PType L -> P (Type L)) -> [PType L] -> P [Type L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((PType L -> Bool -> P (Type L)) -> Bool -> PType L -> P (Type L)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip PType L -> Bool -> P (Type L)
    checkT Bool
    True)

    checkTyVar ::  Name L -> P (PType L)
    checkTyVar :: Name L -> P (PType L)
    checkTyVar Name L
    n = do
      e <- P [KnownExtension]
    getExtensions
      return $
        case n of
          Ident L
    il (Char
    '_':String
    ident) | KnownExtension
    NamedWildCards KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    e ->
            L -> Maybe (Name L) -> PType L
    forall l. l -> Maybe (Name l) -> PType l
    TyWildCard L
    il (Name L -> Maybe (Name L)
    forall a. a -> Maybe a
    Just (L -> String -> Name L
    forall l. l -> String -> Name l
    Ident (L -> L
    reduceSrcSpanInfo L
    il) String
    ident))
          Name L
    _ ->
            L -> Name L -> PType L
    forall l. l -> Name l -> PType l
    TyVar (Name L -> L
    forall l. Name l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Name L
    n) Name L
    n
      where
        -- Reduces the length of the SrcSpanInfo by 1 so that it just covers the identifier.
        reduceSrcSpanInfo :: L -> L
    reduceSrcSpanInfo L
    spaninfo =
          let ss :: SrcSpan
    ss = L -> SrcSpan
    srcInfoSpan L
    spaninfo
              ss' :: SrcSpan
    ss' = SrcSpan
    ss { srcSpanStartColumn = srcSpanStartColumn ss + 1 }
          in  L
    spaninfo { srcInfoSpan = ss' }
    ---------------------------------------
    -- Check kinds

    -- ConstraintKinds allow the kind "Constraint", but not "Nat", etc. Specifically
    -- test for that.
    checkKind :: Kind l -> P ()
    checkKind :: forall l. Kind l -> P ()
    checkKind Kind l
    k = case Kind l
    k of
            S.TyVar l
    _ Name l
    q | Name l -> Bool
    forall {l}. Name l -> Bool
    constrKind Name l
    q -> [KnownExtension] -> P ()
    forall e. (Show e, Enabled e) => [e] -> P ()
    checkEnabledOneOf [KnownExtension
    ConstraintKinds, KnownExtension
    DataKinds]
                where constrKind :: Name l -> Bool
    constrKind Name l
    name = case Name l
    name of
                        Ident l
    _ String
    n -> String
    n String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "Constraint"
                        Name l
    _                      -> Bool
    False

            Kind l
    _ -> KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    DataKinds

    ---------------------------------------
    -- Converting a complete page

    checkPageModule :: PExp L -> ([ModulePragma L],[S],L) -> P (Module L)
    checkPageModule :: PExp L -> ([ModulePragma L], [SrcSpan], L) -> P (Module L)
    checkPageModule PExp L
    xml ([ModulePragma L]
    os,[SrcSpan]
    ss,L
    inf) = do
        mod <- P String
    getModuleName
        xml' <- checkExpr xml
        case xml' of
            S.XTag  L
    l XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr [Exp L]
    cs -> Module L -> P (Module L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Module L -> P (Module L)) -> Module L -> P (Module L)
    forall a b. (a -> b) -> a -> b
    $ L
    -> ModuleName L
    -> [ModulePragma L]
    -> XName L
    -> [XAttr L]
    -> Maybe (Exp L)
    -> [Exp L]
    -> Module L
    forall l.
    l
    -> ModuleName l
    -> [ModulePragma l]
    -> XName l
    -> [XAttr l]
    -> Maybe (Exp l)
    -> [Exp l]
    -> Module l
    XmlPage (L
    infL -> L -> L
    <++>L
    lL -> [SrcSpan] -> L
    <**(L -> [SrcSpan]
    srcInfoPoints L
    l [SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++ [SrcSpan]
    ss)) (L -> String -> ModuleName L
    forall l. l -> String -> ModuleName l
    ModuleName L
    l String
    mod) [ModulePragma L]
    os XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr [Exp L]
    cs
            S.XETag L
    l XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr    -> Module L -> P (Module L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Module L -> P (Module L)) -> Module L -> P (Module L)
    forall a b. (a -> b) -> a -> b
    $ L
    -> ModuleName L
    -> [ModulePragma L]
    -> XName L
    -> [XAttr L]
    -> Maybe (Exp L)
    -> [Exp L]
    -> Module L
    forall l.
    l
    -> ModuleName l
    -> [ModulePragma l]
    -> XName l
    -> [XAttr l]
    -> Maybe (Exp l)
    -> [Exp l]
    -> Module l
    XmlPage (L
    infL -> L -> L
    <++>L
    lL -> [SrcSpan] -> L
    <**(L -> [SrcSpan]
    srcInfoPoints L
    l [SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++ [SrcSpan]
    ss)) (L -> String -> ModuleName L
    forall l. l -> String -> ModuleName l
    ModuleName L
    l String
    mod) [ModulePragma L]
    os XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr []
            Exp L
    _ -> String -> P (Module L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unexpected expression; tag is expected"

    checkHybridModule :: PExp L -> Module L -> S -> S -> P (Module L)
    checkHybridModule :: PExp L -> Module L -> SrcSpan -> SrcSpan -> P (Module L)
    checkHybridModule PExp L
    xml (Module L
    inf Maybe (ModuleHead L)
    mh [ModulePragma L]
    os [ImportDecl L]
    is [Decl L]
    ds) SrcSpan
    s1 SrcSpan
    s2 = do
        xml' <- PExp L -> P (Exp L)
    checkExpr PExp L
    xml
        case xml' of
            S.XTag  L
    l XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr [Exp L]
    cs -> Module L -> P (Module L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Module L -> P (Module L)) -> Module L -> P (Module L)
    forall a b. (a -> b) -> a -> b
    $ L
    -> Maybe (ModuleHead L)
    -> [ModulePragma L]
    -> [ImportDecl L]
    -> [Decl L]
    -> XName L
    -> [XAttr L]
    -> Maybe (Exp L)
    -> [Exp L]
    -> Module L
    forall l.
    l
    -> Maybe (ModuleHead l)
    -> [ModulePragma l]
    -> [ImportDecl l]
    -> [Decl l]
    -> XName l
    -> [XAttr l]
    -> Maybe (Exp l)
    -> [Exp l]
    -> Module l
    XmlHybrid (L
    infL -> L -> L
    <++>L
    lL -> [SrcSpan] -> L
    <**(SrcSpan
    s1 SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : L -> [SrcSpan]
    srcInfoPoints L
    inf [SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++ SrcSpan
    s2 SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : L -> [SrcSpan]
    srcInfoPoints L
    l))
                                                    Maybe (ModuleHead L)
    mh [ModulePragma L]
    os [ImportDecl L]
    is [Decl L]
    ds XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr [Exp L]
    cs
            S.XETag L
    l XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr    -> Module L -> P (Module L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Module L -> P (Module L)) -> Module L -> P (Module L)
    forall a b. (a -> b) -> a -> b
    $ L
    -> Maybe (ModuleHead L)
    -> [ModulePragma L]
    -> [ImportDecl L]
    -> [Decl L]
    -> XName L
    -> [XAttr L]
    -> Maybe (Exp L)
    -> [Exp L]
    -> Module L
    forall l.
    l
    -> Maybe (ModuleHead l)
    -> [ModulePragma l]
    -> [ImportDecl l]
    -> [Decl l]
    -> XName l
    -> [XAttr l]
    -> Maybe (Exp l)
    -> [Exp l]
    -> Module l
    XmlHybrid (L
    infL -> L -> L
    <++>L
    lL -> [SrcSpan] -> L
    <**(SrcSpan
    s1 SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : L -> [SrcSpan]
    srcInfoPoints L
    inf [SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++ SrcSpan
    s2 SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : L -> [SrcSpan]
    srcInfoPoints L
    l))
                                                    Maybe (ModuleHead L)
    mh [ModulePragma L]
    os [ImportDecl L]
    is [Decl L]
    ds XName L
    xn [XAttr L]
    ats Maybe (Exp L)
    mattr []
            Exp L
    _ -> String -> P (Module L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unexpected expression; tag is expected"
    checkHybridModule PExp L
    _ Module L
    _ SrcSpan
    _ SrcSpan
    _ = String -> P (Module L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Hybrid module expected"

    ---------------------------------------
    -- Handle dash-identifiers

    mkDVar :: [String] -> String
    mkDVar :: [String] -> String
    mkDVar = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "-"

    ---------------------------------------
    -- Combine adjacent for-alls.
    --
    -- A valid type must have one for-all at the top of the type, or of the fn arg types

    mkTyForall :: L -> Maybe [TyVarBind L] -> Maybe (PContext L) -> PType L -> PType L
    mkTyForall :: L
    -> Maybe [TyVarBind L] -> Maybe (PContext L) -> PType L -> PType L
    mkTyForall L
    l Maybe [TyVarBind L]
    mtvs Maybe (PContext L)
    ctxt PType L
    ty =
        case (Maybe (PContext L)
    ctxt, PType L
    ty) of
            (Maybe (PContext L)
    Nothing, TyForall L
    _ Maybe [TyVarBind L]
    Nothing Maybe (PContext L)
    ctxt2 PType L
    ty2) -> L
    -> Maybe [TyVarBind L] -> Maybe (PContext L) -> PType L -> PType L
    forall l.
    l
    -> Maybe [TyVarBind l] -> Maybe (PContext l) -> PType l -> PType l
    TyForall L
    l Maybe [TyVarBind L]
    mtvs Maybe (PContext L)
    ctxt2 PType L
    ty2
            (Maybe (PContext L), PType L)
    _                                       -> L
    -> Maybe [TyVarBind L] -> Maybe (PContext L) -> PType L -> PType L
    forall l.
    l
    -> Maybe [TyVarBind l] -> Maybe (PContext l) -> PType l -> PType l
    TyForall L
    l Maybe [TyVarBind L]
    mtvs Maybe (PContext L)
    ctxt PType L
    ty

    -- Make a role annotation

    mkRoleAnnotDecl ::  S -> S -> QName L -> [(Maybe String, L)] -> P (Decl L)
    mkRoleAnnotDecl :: SrcSpan -> SrcSpan -> QName L -> [(Maybe String, L)] -> P (Decl L)
    mkRoleAnnotDecl SrcSpan
    l1 SrcSpan
    l2 QName L
    tycon [(Maybe String, L)]
    roles
      = do roles' <- ((Maybe String, L) -> P (Role L))
    -> [(Maybe String, L)] -> P [Role L]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Maybe String, L) -> P (Role L)
    forall {m :: * -> *} {l}.
    MonadFail m =>
    (Maybe String, l) -> m (Role l)
    parse_role [(Maybe String, L)]
    roles
           return (RoleAnnotDecl loc' tycon roles')
      where
        loc' :: L
    loc' =
          case [(Maybe String, L)]
    roles of
            [] -> (SrcSpan
    l1 SrcSpan -> SrcSpan -> L
    <^^> SrcSpan
    l2 L -> L -> L
    <++> QName L -> L
    forall l. QName l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann QName L
    tycon) L -> [SrcSpan] -> L
    <** [SrcSpan
    l1, SrcSpan
    l2]
            [(Maybe String, L)]
    _  -> (SrcSpan
    l1 SrcSpan -> SrcSpan -> L
    <^^> SrcSpan
    l2 L -> L -> L
    <++> QName L -> L
    forall l. QName l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann QName L
    tycon L -> L -> L
    <++> (L -> L -> L) -> [L] -> L
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 L -> L -> L
    (<++>) (((Maybe String, L) -> L) -> [(Maybe String, L)] -> [L]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe String, L) -> L
    forall a b. (a, b) -> b
    snd [(Maybe String, L)]
    roles)) L -> [SrcSpan] -> L
    <** [SrcSpan
    l1, SrcSpan
    l2]
        possible_roles :: [(String, l -> Role l)]
    possible_roles = [ (String
    "phantom", l -> Role l
    forall l. l -> Role l
    S.Phantom)
                         , (String
    "representational", l -> Role l
    forall l. l -> Role l
    S.Representational)
                         , (String
    "nominal", l -> Role l
    forall l. l -> Role l
    S.Nominal)]

        parse_role :: (Maybe String, l) -> m (Role l)
    parse_role (Maybe String
    Nothing, l
    loc_role) = Role l -> m (Role l)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Role l -> m (Role l)) -> Role l -> m (Role l)
    forall a b. (a -> b) -> a -> b
    $ l -> Role l
    forall l. l -> Role l
    S.RoleWildcard l
    loc_role
        parse_role (Just String
    role, l
    loc_role)
          = case String -> [(String, l -> Role l)] -> Maybe (l -> Role l)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    role [(String, l -> Role l)]
    forall {l}. [(String, l -> Role l)]
    possible_roles of
              Just l -> Role l
    found_role -> Role l -> m (Role l)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Role l -> m (Role l)) -> Role l -> m (Role l)
    forall a b. (a -> b) -> a -> b
    $ l -> Role l
    found_role l
    loc_role
              Maybe (l -> Role l)
    Nothing         ->
                String -> m (Role l)
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Illegal role name " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    role)

    mkAssocType :: S -> PType L -> (Maybe (ResultSig L), Maybe (S, S.Type L), Maybe (InjectivityInfo L)) -> P (ClassDecl L)
    mkAssocType :: SrcSpan
    -> PType L
    -> (Maybe (ResultSig L), Maybe (SrcSpan, Type L),
        Maybe (InjectivityInfo L))
    -> P (ClassDecl L)
    mkAssocType SrcSpan
    tyloc PType L
    ty (Maybe (ResultSig L)
    mres, Maybe (SrcSpan, Type L)
    mty, Maybe (InjectivityInfo L)
    minj)  =
      case (Maybe (ResultSig L)
    mres,Maybe (SrcSpan, Type L)
    mty, Maybe (InjectivityInfo L)
    minj) of
        -- No additional information
        (Maybe (ResultSig L)
    Nothing, Maybe (SrcSpan, Type L)
    Nothing, Maybe (InjectivityInfo L)
    Nothing) -> do
          dh <- PType L -> P (DeclHead L)
    checkSimpleType PType L
    ty
          return $ ClsTyFam (noInfoSpan tyloc <++> ann ty) dh Nothing Nothing
        -- Type default
        (Maybe (ResultSig L)
    _, Just (SrcSpan
    eqloc, Type L
    rhsty), Maybe (InjectivityInfo L)
    Nothing) -> do
          ty' <- PType L -> P (Type L)
    checkType PType L
    ty
          let tyeq = L -> Type L -> Type L -> TypeEqn L
    forall l. l -> Type l -> Type l -> TypeEqn l
    TypeEqn (PType L -> L
    forall l. PType l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PType L
    ty L -> L -> L
    <++> Type L -> L
    forall l. Type l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann Type L
    rhsty L -> [SrcSpan] -> L
    <** [SrcSpan
    eqloc]) Type L
    ty' Type L
    rhsty
          return $ ClsTyDef (noInfoSpan tyloc <++> ann ty <** [tyloc]) tyeq
        -- Declaration with kind sig
        (Just ResultSig L
    ressig, Maybe (SrcSpan, Type L)
    _, Maybe (InjectivityInfo L)
    _) -> do
          dh <- PType L -> P (DeclHead L)
    checkSimpleType PType L
    ty
          return $ ClsTyFam (noInfoSpan tyloc <++> ann ressig <** [tyloc]) dh (Just ressig) Nothing
        -- Decl with inj info
        (Maybe (ResultSig L)
    Nothing, Just (SrcSpan
    eqloc, Type L
    rhsty), Just InjectivityInfo L
    injinfo) -> do
          ressig <- SrcSpan -> Type L -> P (ResultSig L)
    checkKTyVar SrcSpan
    eqloc Type L
    rhsty
          dh <- checkSimpleType ty
          return $ ClsTyFam (noInfoSpan tyloc <++> ann injinfo <** [tyloc]) dh (Just ressig) minj
        (Maybe (ResultSig L), Maybe (SrcSpan, Type L),
     Maybe (InjectivityInfo L))
    _ -> String -> P (ClassDecl L)
    forall a. HasCallStack => String -> a
    error String
    "mkAssocType"

      where
        checkKTyVar :: S -> S.Type L -> P (ResultSig L)
        checkKTyVar :: SrcSpan -> Type L -> P (ResultSig L)
    checkKTyVar SrcSpan
    eqloc Type L
    rhsty =
          case Type L
    rhsty of
           S.TyVar L
    l Name L
    n -> ResultSig L -> P (ResultSig L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ResultSig L -> P (ResultSig L)) -> ResultSig L -> P (ResultSig L)
    forall a b. (a -> b) -> a -> b
    $ L -> TyVarBind L -> ResultSig L
    forall l. l -> TyVarBind l -> ResultSig l
    TyVarSig (SrcSpan -> L
    noInfoSpan SrcSpan
    eqloc L -> L -> L
    <++> L
    l L -> [SrcSpan] -> L
    <** [SrcSpan
    eqloc]) (L -> Name L -> TyVarBind L
    forall l. l -> Name l -> TyVarBind l
    UnkindedVar L
    l Name L
    n)
           S.TyKind L
    l (S.TyVar L
    _ Name L
    n) Type L
    k -> ResultSig L -> P (ResultSig L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ResultSig L -> P (ResultSig L)) -> ResultSig L -> P (ResultSig L)
    forall a b. (a -> b) -> a -> b
    $ L -> TyVarBind L -> ResultSig L
    forall l. l -> TyVarBind l -> ResultSig l
    TyVarSig (SrcSpan -> L
    noInfoSpan SrcSpan
    eqloc L -> L -> L
    <++> L
    l L -> [SrcSpan] -> L
    <** [SrcSpan
    eqloc]) (L -> Name L -> Type L -> TyVarBind L
    forall l. l -> Name l -> Kind l -> TyVarBind l
    KindedVar L
    l Name L
    n Type L
    k)
           Type L
    _ -> String -> P (ResultSig L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Result of type family must be a type variable")

    -- | Transform btype with strict_mark's into HsEqTy's
    -- (((~a) ~b) c) ~d ==> ((~a) ~ (b c)) ~ d
    splitTilde :: PType L -> PType L
    splitTilde :: PType L -> PType L
    splitTilde PType L
    t = PType L -> PType L
    go PType L
    t
      where go :: PType L -> PType L
    go (TyApp L
    loc PType L
    t1 PType L
    t2)
              | TyBang L
    _ (LazyTy L
    eqloc) (NoUnpackPragma L
    _) PType L
    t2' <- PType L
    t2
              = L -> PType L -> PType L -> PType L
    forall l. l -> PType l -> PType l -> PType l
    TyEquals (L
    loc L -> [SrcSpan] -> L
    <** [L -> SrcSpan
    srcInfoSpan L
    eqloc]) (PType L -> PType L
    go PType L
    t1) PType L
    t2'
              | Bool
    otherwise
              = case PType L -> PType L
    go PType L
    t1 of
                  TyEquals L
    eqloc PType L
    tl PType L
    tr ->
                    L -> PType L -> PType L -> PType L
    forall l. l -> PType l -> PType l -> PType l
    TyEquals (L
    eqloc L -> L -> L
    <++> PType L -> L
    forall l. PType l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PType L
    t2 L -> [SrcSpan] -> L
    <** L -> [SrcSpan]
    srcInfoPoints L
    eqloc) PType L
    tl (L -> PType L -> PType L -> PType L
    forall l. l -> PType l -> PType l -> PType l
    TyApp (PType L -> L
    forall l. PType l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PType L
    tr L -> L -> L
    <++> PType L -> L
    forall l. PType l -> l
    forall (ast :: * -> *) l. Annotated ast => ast l -> l
    ann PType L
    t2) PType L
    tr PType L
    t2)
                  PType L
    t' -> L -> PType L -> PType L -> PType L
    forall l. l -> PType l -> PType l -> PType l
    TyApp L
    loc PType L
    t' PType L
    t2

            go PType L
    t' = PType L
    t'

    -- Expects the arguments in the right order
    mkEThingWith :: L -> QName L -> [Either S (CName L)] -> P (ExportSpec L)
    mkEThingWith :: L -> QName L -> [Either SrcSpan (CName L)] -> P (ExportSpec L)
    mkEThingWith L
    loc QName L
    qn [Either SrcSpan (CName L)]
    mcns = do
      Bool -> P () -> P ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (EWildcard L -> Bool
    forall {l}. EWildcard l -> Bool
    isWc EWildcard L
    wc Bool -> Bool -> Bool
    && Bool -> Bool
    not ([CName L] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CName L]
    cnames)) (KnownExtension -> P ()
    forall e. (Show e, Enabled e) => e -> P ()
    checkEnabled KnownExtension
    PatternSynonyms)
      ExportSpec L -> P (ExportSpec L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExportSpec L -> P (ExportSpec L))
    -> ExportSpec L -> P (ExportSpec L)
    forall a b. (a -> b) -> a -> b
    $ L -> EWildcard L -> QName L -> [CName L] -> ExportSpec L
    forall l. l -> EWildcard l -> QName l -> [CName l] -> ExportSpec l
    EThingWith L
    loc EWildcard L
    wc QName L
    qn [CName L]
    cnames
      where
        isWc :: EWildcard l -> Bool
    isWc (NoWildcard {}) = Bool
    False
        isWc EWildcard l
    _ = Bool
    True

        wc :: EWildcard L
        wc :: EWildcard L
    wc = EWildcard L
    -> ((Int, Either SrcSpan (CName L)) -> EWildcard L)
    -> Maybe (Int, Either SrcSpan (CName L))
    -> EWildcard L
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (L -> EWildcard L
    forall l. l -> EWildcard l
    NoWildcard L
    noSrcSpan)
                   (\(Int
    n,Left SrcSpan
    s) -> L -> Int -> EWildcard L
    forall l. l -> Int -> EWildcard l
    EWildcard (SrcSpan -> L
    noInfoSpan SrcSpan
    s) Int
    n)
                   (Int
    -> (Either SrcSpan (CName L) -> Bool)
    -> [Either SrcSpan (CName L)]
    -> Maybe (Int, Either SrcSpan (CName L))
    forall a. Int -> (a -> Bool) -> [a] -> Maybe (Int, a)
    findWithIndex Int
    0 Either SrcSpan (CName L) -> Bool
    forall a b. Either a b -> Bool
    checkLeft [Either SrcSpan (CName L)]
    mcns)

        checkLeft :: Either a b -> Bool
        checkLeft :: forall a b. Either a b -> Bool
    checkLeft (Left a
    _) = Bool
    True
        checkLeft Either a b
    _ = Bool
    False

        cnames :: [CName L]
    cnames = [Either SrcSpan (CName L)] -> [CName L]
    forall a b. [Either a b] -> [b]
    rights [Either SrcSpan (CName L)]
    mcns

        findWithIndex :: Int -> (a -> Bool) -> [a] -> Maybe (Int, a)
        findWithIndex :: forall a. Int -> (a -> Bool) -> [a] -> Maybe (Int, a)
    findWithIndex Int
    _ a -> Bool
    _ [] = Maybe (Int, a)
    forall a. Maybe a
    Nothing
        findWithIndex Int
    n a -> Bool
    p (a
    x:[a]
    xs)
          | a -> Bool
    p a
    x = (Int, a) -> Maybe (Int, a)
    forall a. a -> Maybe a
    Just (Int
    n, a
    x)
          | Bool
    otherwise = Int -> (a -> Bool) -> [a] -> Maybe (Int, a)
    forall a. Int -> (a -> Bool) -> [a] -> Maybe (Int, a)
    findWithIndex (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) a -> Bool
    p [a]
    xs

    data SumOrTuple l = SSum Int Int (PExp l)
                      | STuple [Maybe (PExp l)]

    mkSumOrTuple :: Boxed -> L -> SumOrTuple L -> P (PExp L)
    mkSumOrTuple :: Boxed -> L -> SumOrTuple L -> P (PExp L)
    mkSumOrTuple Boxed
    Unboxed L
    s (SSum Int
    before Int
    after PExp L
    e) = PExp L -> P (PExp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (L -> Int -> Int -> PExp L -> PExp L
    forall l. l -> Int -> Int -> PExp l -> PExp l
    UnboxedSum L
    s Int
    before Int
    after PExp L
    e)
    mkSumOrTuple Boxed
    boxity L
    s (STuple [Maybe (PExp L)]
    ms) =
        PExp L -> P (PExp L)
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PExp L -> P (PExp L)) -> PExp L -> P (PExp L)
    forall a b. (a -> b) -> a -> b
    $ L -> Boxed -> [Maybe (PExp L)] -> PExp L
    forall l. l -> Boxed -> [Maybe (PExp l)] -> PExp l
    TupleSection L
    s Boxed
    boxity [Maybe (PExp L)]
    ms
    mkSumOrTuple Boxed
    Boxed L
    _s (SSum {}) = String -> P (PExp L)
    forall a. String -> P a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Boxed sums are not implemented"