    -- | Utility functions and definitions used in the Happy-generated
    -- parser.  They are defined here because the @.y@ file is opaque to
    -- linters and other tools.  In particular, we cannot enable warnings
    -- for that file, because Happy-generated code is very dirty by GHC's
    -- standards.
    module Language.Futhark.Parser.Monad
      ( ParserMonad,
        ParserState,
        Comment (..),
        parse,
        parseWithComments,
        lexer,
        mustBeEmpty,
        arrayFromList,
        binOp,
        binOpName,
        mustBe,
        primNegate,
        applyExp,
        arrayLitExp,
        addDocSpec,
        addAttrSpec,
        addDoc,
        addAttr,
        twoDotsRange,
        SyntaxError (..),
        emptyArrayError,
        parseError,
        parseErrorAt,
        backOneCol,

        -- * Reexports
        L,
        Token,
      )
    where

    import Control.Monad
    import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)
    import Control.Monad.Trans.Class (lift)
    import Control.Monad.Trans.State
    import Data.Array hiding (index)
    import Data.ByteString.Lazy qualified as BS
    import Data.List.NonEmpty qualified as NE
    import Data.Monoid
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Futhark.Util.Loc
    import Futhark.Util.Pretty hiding (line, line')
    import Language.Futhark.Parser.Lexer
    import Language.Futhark.Parser.Lexer.Wrapper (AlexInput, LexerError (..), initialLexerState)
    import Language.Futhark.Pretty ()
    import Language.Futhark.Prop
    import Language.Futhark.Syntax
    import Prelude hiding (mod)

    addDoc :: DocComment -> UncheckedDec -> UncheckedDec
    addDoc :: DocComment -> UncheckedDec -> UncheckedDec
    addDoc DocComment
    doc (ValDec ValBindBase NoInfo Name
    val) = ValBindBase NoInfo Name -> UncheckedDec
    forall (f :: * -> *) vn. ValBindBase f vn -> DecBase f vn
    ValDec (ValBindBase NoInfo Name
    val {valBindDoc = Just doc})
    addDoc DocComment
    doc (TypeDec TypeBindBase NoInfo Name
    tp) = TypeBindBase NoInfo Name -> UncheckedDec
    forall (f :: * -> *) vn. TypeBindBase f vn -> DecBase f vn
    TypeDec (TypeBindBase NoInfo Name
    tp {typeDoc = Just doc})
    addDoc DocComment
    doc (ModTypeDec ModTypeBindBase NoInfo Name
    sig) = ModTypeBindBase NoInfo Name -> UncheckedDec
    forall (f :: * -> *) vn. ModTypeBindBase f vn -> DecBase f vn
    ModTypeDec (ModTypeBindBase NoInfo Name
    sig {modTypeDoc = Just doc})
    addDoc DocComment
    doc (ModDec ModBindBase NoInfo Name
    mod) = ModBindBase NoInfo Name -> UncheckedDec
    forall (f :: * -> *) vn. ModBindBase f vn -> DecBase f vn
    ModDec (ModBindBase NoInfo Name
    mod {modDoc = Just doc})
    addDoc DocComment
    doc (LocalDec UncheckedDec
    dec SrcLoc
    loc) = UncheckedDec -> SrcLoc -> UncheckedDec
    forall (f :: * -> *) vn. DecBase f vn -> SrcLoc -> DecBase f vn
    LocalDec (DocComment -> UncheckedDec -> UncheckedDec
    addDoc DocComment
    doc UncheckedDec
    dec) SrcLoc
    loc
    addDoc DocComment
    _ UncheckedDec
    dec = UncheckedDec
    dec

    addDocSpec :: DocComment -> SpecBase NoInfo Name -> SpecBase NoInfo Name
    addDocSpec :: DocComment -> SpecBase NoInfo Name -> SpecBase NoInfo Name
    addDocSpec DocComment
    doc (TypeAbbrSpec TypeBindBase NoInfo Name
    tpsig) = TypeBindBase NoInfo Name -> SpecBase NoInfo Name
    forall (f :: * -> *) vn. TypeBindBase f vn -> SpecBase f vn
    TypeAbbrSpec (TypeBindBase NoInfo Name
    tpsig {typeDoc = Just doc})
    addDocSpec DocComment
    doc (ValSpec Name
    name [TypeParamBase Name]
    ps TypeExp UncheckedExp Name
    t NoInfo StructType
    NoInfo Maybe DocComment
    _ SrcLoc
    loc) = Name
    -> [TypeParamBase Name]
    -> TypeExp UncheckedExp Name
    -> NoInfo StructType
    -> Maybe DocComment
    -> SrcLoc
    -> SpecBase NoInfo Name
    forall (f :: * -> *) vn.
    vn
    -> [TypeParamBase vn]
    -> TypeExp (ExpBase f vn) vn
    -> f StructType
    -> Maybe DocComment
    -> SrcLoc
    -> SpecBase f vn
    ValSpec Name
    name [TypeParamBase Name]
    ps TypeExp UncheckedExp Name
    t NoInfo StructType
    forall {k} (a :: k). NoInfo a
    NoInfo (DocComment -> Maybe DocComment
    forall a. a -> Maybe a
    Just DocComment
    doc) SrcLoc
    loc
    addDocSpec DocComment
    doc (TypeSpec Liftedness
    l Name
    name [TypeParamBase Name]
    ps Maybe DocComment
    _ SrcLoc
    loc) = Liftedness
    -> Name
    -> [TypeParamBase Name]
    -> Maybe DocComment
    -> SrcLoc
    -> SpecBase NoInfo Name
    forall (f :: * -> *) vn.
    Liftedness
    -> vn
    -> [TypeParamBase vn]
    -> Maybe DocComment
    -> SrcLoc
    -> SpecBase f vn
    TypeSpec Liftedness
    l Name
    name [TypeParamBase Name]
    ps (DocComment -> Maybe DocComment
    forall a. a -> Maybe a
    Just DocComment
    doc) SrcLoc
    loc
    addDocSpec DocComment
    doc (ModSpec Name
    name ModTypeExpBase NoInfo Name
    se Maybe DocComment
    _ SrcLoc
    loc) = Name
    -> ModTypeExpBase NoInfo Name
    -> Maybe DocComment
    -> SrcLoc
    -> SpecBase NoInfo Name
    forall (f :: * -> *) vn.
    vn
    -> ModTypeExpBase f vn
    -> Maybe DocComment
    -> SrcLoc
    -> SpecBase f vn
    ModSpec Name
    name ModTypeExpBase NoInfo Name
    se (DocComment -> Maybe DocComment
    forall a. a -> Maybe a
    Just DocComment
    doc) SrcLoc
    loc
    addDocSpec DocComment
    _ spec :: SpecBase NoInfo Name
    spec@IncludeSpec {} = SpecBase NoInfo Name
    spec

    addAttr :: AttrInfo Name -> UncheckedDec -> UncheckedDec
    addAttr :: AttrInfo Name -> UncheckedDec -> UncheckedDec
    addAttr AttrInfo Name
    attr (ValDec ValBindBase NoInfo Name
    val) =
      ValBindBase NoInfo Name -> UncheckedDec
    forall (f :: * -> *) vn. ValBindBase f vn -> DecBase f vn
    ValDec (ValBindBase NoInfo Name -> UncheckedDec)
    -> ValBindBase NoInfo Name -> UncheckedDec
    forall a b. (a -> b) -> a -> b
    $ ValBindBase NoInfo Name
    val {valBindAttrs = attr : valBindAttrs val}
    addAttr AttrInfo Name
    _ UncheckedDec
    dec = UncheckedDec
    dec

    -- We will extend this function once we actually start tracking these.
    addAttrSpec :: AttrInfo Name -> UncheckedSpec -> UncheckedSpec
    addAttrSpec :: AttrInfo Name -> SpecBase NoInfo Name -> SpecBase NoInfo Name
    addAttrSpec AttrInfo Name
    _attr SpecBase NoInfo Name
    dec = SpecBase NoInfo Name
    dec

    mustBe :: L Token -> T.Text -> ParserMonad ()
    mustBe :: L Token -> Text -> ParserMonad ()
    mustBe (L Loc
    _ (ID Name
    got)) Text
    expected
      | Name -> Text
    nameToText Name
    got Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    expected = () -> ParserMonad ()
    forall a. a -> ExceptT SyntaxError (State ParserState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    mustBe (L Loc
    loc Token
    _) Text
    expected =
      Loc -> Maybe Text -> ParserMonad ()
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt Loc
    loc (Maybe Text -> ParserMonad ())
    -> (Text -> Maybe Text) -> Text -> ParserMonad ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> ParserMonad ()) -> Text -> ParserMonad ()
    forall a b. (a -> b) -> a -> b
    $
        Text
    "Only the keyword '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    expected Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "' may appear here."

    mustBeEmpty :: (Located loc) => loc -> ValueType -> ParserMonad ()
    mustBeEmpty :: forall loc. Located loc => loc -> ValueType -> ParserMonad ()
    mustBeEmpty loc
    _ (Array NoUniqueness
    _ (Shape [Int64]
    dims) ScalarTypeBase Int64 NoUniqueness
    _)
      | Int64
    0 Int64 -> [Int64] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Int64]
    dims = () -> ParserMonad ()
    forall a. a -> ExceptT SyntaxError (State ParserState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    mustBeEmpty loc
    loc ValueType
    t =
      loc -> Maybe Text -> ParserMonad ()
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt loc
    loc (Maybe Text -> ParserMonad ()) -> Maybe Text -> ParserMonad ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ ValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText ValueType
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " is not an empty array."

    -- | A comment consists of its starting and end position, as well as
    -- its text.  The contents include the comment start marker.
    data Comment = Comment {Comment -> Loc
    commentLoc :: Loc, Comment -> Text
    commentText :: T.Text}
      deriving (Comment -> Comment -> Bool
    (Comment -> Comment -> Bool)
    -> (Comment -> Comment -> Bool) -> Eq Comment
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Comment -> Comment -> Bool
    == :: Comment -> Comment -> Bool
    $c/= :: Comment -> Comment -> Bool
    /= :: Comment -> Comment -> Bool
    Eq, Eq Comment
    Eq Comment =>
    (Comment -> Comment -> Ordering)
    -> (Comment -> Comment -> Bool)
    -> (Comment -> Comment -> Bool)
    -> (Comment -> Comment -> Bool)
    -> (Comment -> Comment -> Bool)
    -> (Comment -> Comment -> Comment)
    -> (Comment -> Comment -> Comment)
    -> Ord Comment
    Comment -> Comment -> Bool
    Comment -> Comment -> Ordering
    Comment -> Comment -> Comment
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Comment -> Comment -> Ordering
    compare :: Comment -> Comment -> Ordering
    $c< :: Comment -> Comment -> Bool
    < :: Comment -> Comment -> Bool
    $c<= :: Comment -> Comment -> Bool
    <= :: Comment -> Comment -> Bool
    $c> :: Comment -> Comment -> Bool
    > :: Comment -> Comment -> Bool
    $c>= :: Comment -> Comment -> Bool
    >= :: Comment -> Comment -> Bool
    $cmax :: Comment -> Comment -> Comment
    max :: Comment -> Comment -> Comment
    $cmin :: Comment -> Comment -> Comment
    min :: Comment -> Comment -> Comment
    Ord, Int -> Comment -> ShowS
    [Comment] -> ShowS
    Comment -> [Char]
    (Int -> Comment -> ShowS)
    -> (Comment -> [Char]) -> ([Comment] -> ShowS) -> Show Comment
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Comment -> ShowS
    showsPrec :: Int -> Comment -> ShowS
    $cshow :: Comment -> [Char]
    show :: Comment -> [Char]
    $cshowList :: [Comment] -> ShowS
    showList :: [Comment] -> ShowS
    Show)

    instance Located Comment where
      locOf :: Comment -> Loc
    locOf = Comment -> Loc
    commentLoc

    data ParserState = ParserState
      { ParserState -> [Char]
    _parserFile :: FilePath,
        ParserState -> Text
    parserInput :: T.Text,
        -- | Note: reverse order.
        ParserState -> [Comment]
    parserComments :: [Comment],
        ParserState -> AlexInput
    parserLexerState :: AlexInput
      }

    type ParserMonad = ExceptT SyntaxError (State ParserState)

    arrayFromList :: [a] -> Array Int a
    arrayFromList :: forall a. [a] -> Array Int a
    arrayFromList [a]
    l = (Int, Int) -> [a] -> Array Int a
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0, [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [a]
    l

    arrayLitExp :: [UncheckedExp] -> SrcLoc -> UncheckedExp
    arrayLitExp :: [UncheckedExp] -> SrcLoc -> UncheckedExp
    arrayLitExp [UncheckedExp]
    es SrcLoc
    loc
      | Just (PrimValue
    v : [PrimValue]
    vs) <- (UncheckedExp -> Maybe PrimValue)
    -> [UncheckedExp] -> Maybe [PrimValue]
    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 UncheckedExp -> Maybe PrimValue
    forall {f :: * -> *} {vn}. ExpBase f vn -> Maybe PrimValue
    isLiteral [UncheckedExp]
    es,
        (PrimValue -> Bool) -> [PrimValue] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((PrimValue -> PrimType
    primValueType PrimValue
    v ==) (PrimType -> Bool) -> (PrimValue -> PrimType) -> PrimValue -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrimValue -> PrimType
    primValueType) [PrimValue]
    vs =
          [PrimValue] -> PrimType -> SrcLoc -> UncheckedExp
    forall (f :: * -> *) vn.
    [PrimValue] -> PrimType -> SrcLoc -> ExpBase f vn
    ArrayVal (PrimValue
    v PrimValue -> [PrimValue] -> [PrimValue]
    forall a. a -> [a] -> [a]
    : [PrimValue]
    vs) (PrimValue -> PrimType
    primValueType PrimValue
    v) SrcLoc
    loc
      | Bool
    otherwise =
          [UncheckedExp] -> NoInfo StructType -> SrcLoc -> UncheckedExp
    forall (f :: * -> *) vn.
    [ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
    ArrayLit [UncheckedExp]
    es NoInfo StructType
    forall {k} (a :: k). NoInfo a
    NoInfo SrcLoc
    loc
      where
        isLiteral :: ExpBase f vn -> Maybe PrimValue
    isLiteral (Literal PrimValue
    v SrcLoc
    _) = PrimValue -> Maybe PrimValue
    forall a. a -> Maybe a
    Just PrimValue
    v
        isLiteral ExpBase f vn
    _ = Maybe PrimValue
    forall a. Maybe a
    Nothing

    applyExp :: NE.NonEmpty UncheckedExp -> ParserMonad UncheckedExp
    applyExp :: NonEmpty UncheckedExp -> ParserMonad UncheckedExp
    applyExp all_es :: NonEmpty UncheckedExp
    all_es@((Constr Name
    n [] NoInfo StructType
    _ SrcLoc
    loc1) NE.:| [UncheckedExp]
    es) =
      UncheckedExp -> ParserMonad UncheckedExp
    forall a. a -> ExceptT SyntaxError (State ParserState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (UncheckedExp -> ParserMonad UncheckedExp)
    -> UncheckedExp -> ParserMonad UncheckedExp
    forall a b. (a -> b) -> a -> b
    $ Name
    -> [UncheckedExp] -> NoInfo StructType -> SrcLoc -> UncheckedExp
    forall (f :: * -> *) vn.
    Name -> [ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
    Constr Name
    n [UncheckedExp]
    es NoInfo StructType
    forall {k} (a :: k). NoInfo a
    NoInfo (SrcLoc -> UncheckedExp -> SrcLoc
    forall a b. (Located a, Located b) => a -> b -> SrcLoc
    srcspan SrcLoc
    loc1 (NonEmpty UncheckedExp -> UncheckedExp
    forall a. NonEmpty a -> a
    NE.last NonEmpty UncheckedExp
    all_es))
    applyExp NonEmpty UncheckedExp
    es =
      (UncheckedExp -> UncheckedExp -> ParserMonad UncheckedExp)
    -> UncheckedExp -> [UncheckedExp] -> ParserMonad UncheckedExp
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM UncheckedExp -> UncheckedExp -> ParserMonad UncheckedExp
    forall {vn}.
    IsName vn =>
    ExpBase NoInfo vn
    -> ExpBase NoInfo vn -> ParserMonad (ExpBase NoInfo vn)
    op (NonEmpty UncheckedExp -> UncheckedExp
    forall a. NonEmpty a -> a
    NE.head NonEmpty UncheckedExp
    es) (NonEmpty UncheckedExp -> [UncheckedExp]
    forall a. NonEmpty a -> [a]
    NE.tail NonEmpty UncheckedExp
    es)
      where
        op :: ExpBase NoInfo vn
    -> ExpBase NoInfo vn -> ParserMonad (ExpBase NoInfo vn)
    op (AppExp (Index ExpBase NoInfo vn
    e SliceBase NoInfo vn
    is SrcLoc
    floc) NoInfo AppRes
    _) (ArrayLit [ExpBase NoInfo vn]
    xs NoInfo StructType
    _ SrcLoc
    xloc) =
          SrcLoc -> Maybe Text -> ParserMonad (ExpBase NoInfo vn)
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt (SrcLoc -> SrcLoc -> SrcLoc
    forall a b. (Located a, Located b) => a -> b -> SrcLoc
    srcspan SrcLoc
    floc SrcLoc
    xloc) (Maybe Text -> ParserMonad (ExpBase NoInfo vn))
    -> (Doc Any -> Maybe Text)
    -> Doc Any
    -> ParserMonad (ExpBase NoInfo vn)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> (Doc Any -> Text) -> Doc Any -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc Any -> Text
    forall a. Doc a -> Text
    docText (Doc Any -> ParserMonad (ExpBase NoInfo vn))
    -> Doc Any -> ParserMonad (ExpBase NoInfo vn)
    forall a b. (a -> b) -> a -> b
    $
            Doc Any
    "Incorrect syntax for multi-dimensional indexing."
              Doc Any -> Doc Any -> Doc Any
    forall a. Doc a -> Doc a -> Doc a
    </> Doc Any
    "Use"
              Doc Any -> Doc Any -> Doc Any
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc Any -> Doc Any
    forall ann. Doc ann -> Doc ann
    align (ExpBase NoInfo vn -> Doc Any
    forall a ann. Pretty a => a -> Doc ann
    forall ann. ExpBase NoInfo vn -> Doc ann
    pretty ExpBase NoInfo vn
    index)
          where
            index :: ExpBase NoInfo vn
    index = AppExpBase NoInfo vn -> NoInfo AppRes -> ExpBase NoInfo vn
    forall (f :: * -> *) vn.
    AppExpBase f vn -> f AppRes -> ExpBase f vn
    AppExp (ExpBase NoInfo vn
    -> SliceBase NoInfo vn -> SrcLoc -> AppExpBase NoInfo vn
    forall (f :: * -> *) vn.
    ExpBase f vn -> SliceBase f vn -> SrcLoc -> AppExpBase f vn
    Index ExpBase NoInfo vn
    e (SliceBase NoInfo vn
    is SliceBase NoInfo vn -> SliceBase NoInfo vn -> SliceBase NoInfo vn
    forall a. [a] -> [a] -> [a]
    ++ (ExpBase NoInfo vn -> DimIndexBase NoInfo vn)
    -> [ExpBase NoInfo vn] -> SliceBase NoInfo vn
    forall a b. (a -> b) -> [a] -> [b]
    map ExpBase NoInfo vn -> DimIndexBase NoInfo vn
    forall (f :: * -> *) vn. ExpBase f vn -> DimIndexBase f vn
    DimFix [ExpBase NoInfo vn]
    xs) SrcLoc
    xloc) NoInfo AppRes
    forall {k} (a :: k). NoInfo a
    NoInfo
        op ExpBase NoInfo vn
    f ExpBase NoInfo vn
    x = ExpBase NoInfo vn -> ParserMonad (ExpBase NoInfo vn)
    forall a. a -> ExceptT SyntaxError (State ParserState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpBase NoInfo vn -> ParserMonad (ExpBase NoInfo vn))
    -> ExpBase NoInfo vn -> ParserMonad (ExpBase NoInfo vn)
    forall a b. (a -> b) -> a -> b
    $ ExpBase NoInfo vn -> ExpBase NoInfo vn -> ExpBase NoInfo vn
    forall vn.
    ExpBase NoInfo vn -> ExpBase NoInfo vn -> ExpBase NoInfo vn
    mkApplyUT ExpBase NoInfo vn
    f ExpBase NoInfo vn
    x

    binOpName :: L Token -> (QualName Name, Loc)
    binOpName :: L Token -> (QualName Name, Loc)
    binOpName (L Loc
    loc (SYMBOL BinOp
    _ [Name]
    qs Name
    op)) = ([Name] -> Name -> QualName Name
    forall vn. [vn] -> vn -> QualName vn
    QualName [Name]
    qs Name
    op, Loc
    loc)
    binOpName L Token
    t = [Char] -> (QualName Name, Loc)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (QualName Name, Loc)) -> [Char] -> (QualName Name, Loc)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "binOpName: unexpected " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ L Token -> [Char]
    forall a. Show a => a -> [Char]
    show L Token
    t

    binOp :: UncheckedExp -> L Token -> UncheckedExp -> UncheckedExp
    binOp :: UncheckedExp -> L Token -> UncheckedExp -> UncheckedExp
    binOp UncheckedExp
    x (L Loc
    loc (SYMBOL BinOp
    _ [Name]
    qs Name
    op)) UncheckedExp
    y =
      AppExpBase NoInfo Name -> NoInfo AppRes -> UncheckedExp
    forall (f :: * -> *) vn.
    AppExpBase f vn -> f AppRes -> ExpBase f vn
    AppExp ((QualName Name, SrcLoc)
    -> NoInfo StructType
    -> (UncheckedExp, NoInfo (Maybe VName))
    -> (UncheckedExp, NoInfo (Maybe VName))
    -> SrcLoc
    -> AppExpBase NoInfo Name
    forall (f :: * -> *) vn.
    (QualName vn, SrcLoc)
    -> f StructType
    -> (ExpBase f vn, f (Maybe VName))
    -> (ExpBase f vn, f (Maybe VName))
    -> SrcLoc
    -> AppExpBase f vn
    BinOp ([Name] -> Name -> QualName Name
    forall vn. [vn] -> vn -> QualName vn
    QualName [Name]
    qs Name
    op, Loc -> SrcLoc
    forall a. Located a => a -> SrcLoc
    srclocOf Loc
    loc) NoInfo StructType
    forall {k} (a :: k). NoInfo a
    NoInfo (UncheckedExp
    x, NoInfo (Maybe VName)
    forall {k} (a :: k). NoInfo a
    NoInfo) (UncheckedExp
    y, NoInfo (Maybe VName)
    forall {k} (a :: k). NoInfo a
    NoInfo) (UncheckedExp -> UncheckedExp -> SrcLoc
    forall a b. (Located a, Located b) => a -> b -> SrcLoc
    srcspan UncheckedExp
    x UncheckedExp
    y)) NoInfo AppRes
    forall {k} (a :: k). NoInfo a
    NoInfo
    binOp UncheckedExp
    _ L Token
    t UncheckedExp
    _ = [Char] -> UncheckedExp
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> UncheckedExp) -> [Char] -> UncheckedExp
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "binOp: unexpected " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ L Token -> [Char]
    forall a. Show a => a -> [Char]
    show L Token
    t

    putComment :: Comment -> ParserMonad ()
    putComment :: Comment -> ParserMonad ()
    putComment Comment
    c = State ParserState () -> ParserMonad ()
    forall (m :: * -> *) a. Monad m => m a -> ExceptT SyntaxError m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (State ParserState () -> ParserMonad ())
    -> State ParserState () -> ParserMonad ()
    forall a b. (a -> b) -> a -> b
    $ (ParserState -> ParserState) -> State ParserState ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify ((ParserState -> ParserState) -> State ParserState ())
    -> (ParserState -> ParserState) -> State ParserState ()
    forall a b. (a -> b) -> a -> b
    $ \ParserState
    env ->
      ParserState
    env {parserComments = c : parserComments env}

    intNegate :: IntValue -> IntValue
    intNegate :: IntValue -> IntValue
    intNegate (Int8Value Int8
    v) = Int8 -> IntValue
    Int8Value (-Int8
    v)
    intNegate (Int16Value Int16
    v) = Int16 -> IntValue
    Int16Value (-Int16
    v)
    intNegate (Int32Value Int32
    v) = Int32 -> IntValue
    Int32Value (-Int32
    v)
    intNegate (Int64Value Int64
    v) = Int64 -> IntValue
    Int64Value (-Int64
    v)

    floatNegate :: FloatValue -> FloatValue
    floatNegate :: FloatValue -> FloatValue
    floatNegate (Float16Value Half
    v) = Half -> FloatValue
    Float16Value (-Half
    v)
    floatNegate (Float32Value Float
    v) = Float -> FloatValue
    Float32Value (-Float
    v)
    floatNegate (Float64Value Double
    v) = Double -> FloatValue
    Float64Value (-Double
    v)

    primNegate :: PrimValue -> PrimValue
    primNegate :: PrimValue -> PrimValue
    primNegate (FloatValue FloatValue
    v) = FloatValue -> PrimValue
    FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
    forall a b. (a -> b) -> a -> b
    $ FloatValue -> FloatValue
    floatNegate FloatValue
    v
    primNegate (SignedValue IntValue
    v) = IntValue -> PrimValue
    SignedValue (IntValue -> PrimValue) -> IntValue -> PrimValue
    forall a b. (a -> b) -> a -> b
    $ IntValue -> IntValue
    intNegate IntValue
    v
    primNegate (UnsignedValue IntValue
    v) = IntValue -> PrimValue
    UnsignedValue (IntValue -> PrimValue) -> IntValue -> PrimValue
    forall a b. (a -> b) -> a -> b
    $ IntValue -> IntValue
    intNegate IntValue
    v
    primNegate (BoolValue Bool
    v) = Bool -> PrimValue
    BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not Bool
    v

    lexer :: (L Token -> ParserMonad a) -> ParserMonad a
    lexer :: forall a. (L Token -> ParserMonad a) -> ParserMonad a
    lexer L Token -> ParserMonad a
    cont = do
      AlexInput
    ls <- State ParserState AlexInput
    -> ExceptT SyntaxError (State ParserState) AlexInput
    forall (m :: * -> *) a. Monad m => m a -> ExceptT SyntaxError m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (State ParserState AlexInput
     -> ExceptT SyntaxError (State ParserState) AlexInput)
    -> State ParserState AlexInput
    -> ExceptT SyntaxError (State ParserState) AlexInput
    forall a b. (a -> b) -> a -> b
    $ (ParserState -> AlexInput) -> State ParserState AlexInput
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets ParserState -> AlexInput
    parserLexerState
      case AlexInput -> Either LexerError (AlexInput, (Pos, Pos, Token))
    getToken AlexInput
    ls of
        Left LexerError
    e ->
          SyntaxError -> ParserMonad a
    forall a. SyntaxError -> ExceptT SyntaxError (State ParserState) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (SyntaxError -> ParserMonad a) -> SyntaxError -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $ LexerError -> SyntaxError
    lexerErrToParseErr LexerError
    e
        Right (AlexInput
    ls', (Pos
    start, Pos
    end, Token
    tok)) -> do
          let loc :: Loc
    loc = Pos -> Pos -> Loc
    Loc Pos
    start Pos
    end
          State ParserState () -> ParserMonad ()
    forall (m :: * -> *) a. Monad m => m a -> ExceptT SyntaxError m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (State ParserState () -> ParserMonad ())
    -> State ParserState () -> ParserMonad ()
    forall a b. (a -> b) -> a -> b
    $ (ParserState -> ParserState) -> State ParserState ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify ((ParserState -> ParserState) -> State ParserState ())
    -> (ParserState -> ParserState) -> State ParserState ()
    forall a b. (a -> b) -> a -> b
    $ \ParserState
    s -> ParserState
    s {parserLexerState = ls'}
          case Token
    tok of
            COMMENT Text
    text -> do
              Comment -> ParserMonad ()
    putComment (Comment -> ParserMonad ()) -> Comment -> ParserMonad ()
    forall a b. (a -> b) -> a -> b
    $ Loc -> Text -> Comment
    Comment Loc
    loc Text
    text
              (L Token -> ParserMonad a) -> ParserMonad a
    forall a. (L Token -> ParserMonad a) -> ParserMonad a
    lexer L Token -> ParserMonad a
    cont
            Token
    _ ->
              L Token -> ParserMonad a
    cont (L Token -> ParserMonad a) -> L Token -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $ Loc -> Token -> L Token
    forall a. Loc -> a -> L a
    L Loc
    loc Token
    tok

    parseError :: (L Token, [String]) -> ParserMonad a
    parseError :: forall a. (L Token, [[Char]]) -> ParserMonad a
    parseError (L Loc
    loc Token
    EOF, [[Char]]
    expected) =
      Loc -> Maybe Text -> ParserMonad a
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt (Loc -> Loc
    forall a. Located a => a -> Loc
    locOf Loc
    loc) (Maybe Text -> ParserMonad a)
    -> ([Text] -> Maybe Text) -> [Text] -> ParserMonad a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    T.unlines ([Text] -> ParserMonad a) -> [Text] -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $
        [ Text
    "Unexpected end of file.",
          Text
    "Expected one of the following: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    T.unwords (([Char] -> Text) -> [[Char]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Text
    T.pack [[Char]]
    expected)
        ]
    parseError (L Loc
    loc DOC {}, [[Char]]
    _) =
      Loc -> Maybe Text -> ParserMonad a
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt (Loc -> Loc
    forall a. Located a => a -> Loc
    locOf Loc
    loc) (Maybe Text -> ParserMonad a) -> Maybe Text -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "Documentation comments ('-- |') are only permitted when preceding declarations."
    parseError (L Loc
    loc (ERROR Text
    "\""), [[Char]]
    _) =
      Loc -> Maybe Text -> ParserMonad a
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt (Loc -> Loc
    forall a. Located a => a -> Loc
    locOf Loc
    loc) (Maybe Text -> ParserMonad a) -> Maybe Text -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "Unclosed string literal."
    parseError (L Loc
    loc Token
    _, [[Char]]
    expected) = do
      Text
    input <- State ParserState Text
    -> ExceptT SyntaxError (State ParserState) Text
    forall (m :: * -> *) a. Monad m => m a -> ExceptT SyntaxError m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (State ParserState Text
     -> ExceptT SyntaxError (State ParserState) Text)
    -> State ParserState Text
    -> ExceptT SyntaxError (State ParserState) Text
    forall a b. (a -> b) -> a -> b
    $ (ParserState -> Text) -> State ParserState Text
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets ParserState -> Text
    parserInput
      let ~(Loc (Pos [Char]
    _ Int
    _ Int
    _ Int
    beg) (Pos [Char]
    _ Int
    _ Int
    _ Int
    end)) = Loc -> Loc
    forall a. Located a => a -> Loc
    locOf Loc
    loc
          tok_src :: Text
    tok_src = Int -> Text -> Text
    T.take (Int
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    beg) (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    beg Text
    input
      Loc -> Maybe Text -> ParserMonad a
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt Loc
    loc (Maybe Text -> ParserMonad a)
    -> ([Text] -> Maybe Text) -> [Text] -> ParserMonad a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    T.unlines ([Text] -> ParserMonad a) -> [Text] -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $
        [ Text
    "Unexpected token: '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    tok_src Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'",
          Text
    "Expected one of the following: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    T.unwords (([Char] -> Text) -> [[Char]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Text
    T.pack [[Char]]
    expected)
        ]

    parseErrorAt :: (Located loc) => loc -> Maybe T.Text -> ParserMonad a
    parseErrorAt :: forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt loc
    loc Maybe Text
    Nothing = SyntaxError -> ExceptT SyntaxError (State ParserState) a
    forall a. SyntaxError -> ExceptT SyntaxError (State ParserState) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (SyntaxError -> ExceptT SyntaxError (State ParserState) a)
    -> SyntaxError -> ExceptT SyntaxError (State ParserState) a
    forall a b. (a -> b) -> a -> b
    $ Loc -> Text -> SyntaxError
    SyntaxError (loc -> Loc
    forall a. Located a => a -> Loc
    locOf loc
    loc) Text
    "Syntax error."
    parseErrorAt loc
    loc (Just Text
    s) = SyntaxError -> ExceptT SyntaxError (State ParserState) a
    forall a. SyntaxError -> ExceptT SyntaxError (State ParserState) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (SyntaxError -> ExceptT SyntaxError (State ParserState) a)
    -> SyntaxError -> ExceptT SyntaxError (State ParserState) a
    forall a b. (a -> b) -> a -> b
    $ Loc -> Text -> SyntaxError
    SyntaxError (loc -> Loc
    forall a. Located a => a -> Loc
    locOf loc
    loc) Text
    s

    emptyArrayError :: Loc -> ParserMonad a
    emptyArrayError :: forall a. Loc -> ParserMonad a
    emptyArrayError Loc
    loc =
      Loc -> Maybe Text -> ParserMonad a
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt Loc
    loc (Maybe Text -> ParserMonad a) -> Maybe Text -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "write empty arrays as 'empty(t)', for element type 't'.\n"

    twoDotsRange :: Loc -> ParserMonad a
    twoDotsRange :: forall a. Loc -> ParserMonad a
    twoDotsRange Loc
    loc = Loc -> Maybe Text -> ParserMonad a
    forall loc a. Located loc => loc -> Maybe Text -> ParserMonad a
    parseErrorAt Loc
    loc (Maybe Text -> ParserMonad a) -> Maybe Text -> ParserMonad a
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "use '...' for ranges, not '..'.\n"

    -- | Move the end position back one column.
    backOneCol :: Loc -> Loc
    backOneCol :: Loc -> Loc
    backOneCol (Loc Pos
    start (Pos [Char]
    f Int
    l Int
    c Int
    o)) = Pos -> Pos -> Loc
    Loc Pos
    start (Pos -> Loc) -> Pos -> Loc
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int -> Int -> Int -> Pos
    Pos [Char]
    f Int
    l (Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
    backOneCol Loc
    NoLoc = Loc
    NoLoc

    --- Now for the parser interface.

    -- | A syntax error.
    data SyntaxError = SyntaxError {SyntaxError -> Loc
    syntaxErrorLoc :: Loc, SyntaxError -> Text
    syntaxErrorMsg :: T.Text}

    lexerErrToParseErr :: LexerError -> SyntaxError
    lexerErrToParseErr :: LexerError -> SyntaxError
    lexerErrToParseErr (LexerError Loc
    loc Text
    msg) = Loc -> Text -> SyntaxError
    SyntaxError Loc
    loc Text
    msg

    parseWithComments ::
      ParserMonad a ->
      FilePath ->
      T.Text ->
      Either SyntaxError (a, [Comment])
    parseWithComments :: forall a.
    ParserMonad a
    -> [Char] -> Text -> Either SyntaxError (a, [Comment])
    parseWithComments ParserMonad a
    p [Char]
    file Text
    program =
      (Either SyntaxError a, ParserState)
    -> Either SyntaxError (a, [Comment])
    forall {a} {a}.
    (Either a a, ParserState) -> Either a (a, [Comment])
    onRes ((Either SyntaxError a, ParserState)
     -> Either SyntaxError (a, [Comment]))
    -> (Either SyntaxError a, ParserState)
    -> Either SyntaxError (a, [Comment])
    forall a b. (a -> b) -> a -> b
    $ State ParserState (Either SyntaxError a)
    -> ParserState -> (Either SyntaxError a, ParserState)
    forall s a. State s a -> s -> (a, s)
    runState (ParserMonad a -> State ParserState (Either SyntaxError a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT ParserMonad a
    p) ParserState
    env
      where
        env :: ParserState
    env =
          [Char] -> Text -> [Comment] -> AlexInput -> ParserState
    ParserState
            [Char]
    file
            Text
    program
            []
            (Pos -> ByteString -> AlexInput
    initialLexerState Pos
    start (ByteString -> AlexInput) -> ByteString -> AlexInput
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BS.fromStrict (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text
    program)
        start :: Pos
    start = [Char] -> Int -> Int -> Int -> Pos
    Pos [Char]
    file Int
    1 Int
    1 Int
    0
        onRes :: (Either a a, ParserState) -> Either a (a, [Comment])
    onRes (Left a
    err, ParserState
    _) = a -> Either a (a, [Comment])
    forall a b. a -> Either a b
    Left a
    err
        onRes (Right a
    x, ParserState
    s) = (a, [Comment]) -> Either a (a, [Comment])
    forall a b. b -> Either a b
    Right (a
    x, [Comment] -> [Comment]
    forall a. [a] -> [a]
    reverse ([Comment] -> [Comment]) -> [Comment] -> [Comment]
    forall a b. (a -> b) -> a -> b
    $ ParserState -> [Comment]
    parserComments ParserState
    s)

    parse :: ParserMonad a -> FilePath -> T.Text -> Either SyntaxError a
    parse :: forall a. ParserMonad a -> [Char] -> Text -> Either SyntaxError a
    parse ParserMonad a
    p [Char]
    file Text
    program = (a, [Comment]) -> a
    forall a b. (a, b) -> a
    fst ((a, [Comment]) -> a)
    -> Either SyntaxError (a, [Comment]) -> Either SyntaxError a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParserMonad a
    -> [Char] -> Text -> Either SyntaxError (a, [Comment])
    forall a.
    ParserMonad a
    -> [Char] -> Text -> Either SyntaxError (a, [Comment])
    parseWithComments ParserMonad a
    p [Char]
    file Text
    program