    -- | Parsers for primitive values and types.
    module Language.Futhark.Primitive.Parse
      ( pPrimValue,
        pPrimType,
        pFloatType,
        pIntType,

        -- * Building blocks
        constituent,
        lexeme,
        keyword,
        whitespace,
      )
    where

    import Data.Char (isAlphaNum)
    import Data.Functor
    import Data.Text qualified as T
    import Data.Void
    import Futhark.Util.Pretty
    import Language.Futhark.Primitive
    import Text.Megaparsec
    import Text.Megaparsec.Char
    import Text.Megaparsec.Char.Lexer qualified as L

    -- | Is this character a valid member of an identifier?
    constituent :: Char -> Bool
    constituent :: Char -> Bool
    constituent Char
    c = Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || (Char
    c Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    "_/'+-=!&^.<>*|%" :: String))

    -- | Consume whitespace (including skipping line comments).
    whitespace :: Parsec Void T.Text ()
    whitespace :: Parsec Void Text ()
    whitespace = Parsec Void Text ()
    -> Parsec Void Text ()
    -> Parsec Void Text ()
    -> Parsec Void Text ()
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    m () -> m () -> m () -> m ()
    L.space Parsec Void Text ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    space1 (Tokens Text -> Parsec Void Text ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Tokens s -> m ()
    L.skipLineComment Tokens Text
    "--") Parsec Void Text ()
    forall a. ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a
    empty

    -- | Consume whitespace after the provided parser, if it succeeds.
    lexeme :: Parsec Void T.Text a -> Parsec Void T.Text a
    lexeme :: forall a. Parsec Void Text a -> Parsec Void Text a
    lexeme = ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall a. Parsec Void Text a -> Parsec Void Text a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
    -> (ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
    -> ParsecT Void Text Identity a
    -> ParsecT Void Text Identity a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Parsec Void Text ()
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
    L.lexeme Parsec Void Text ()
    whitespace

    -- | @keyword k@ parses @k@, which must not be immediately followed by
    -- a 'constituent' character.  This ensures that @iff@ is not seen as
    -- the @if@ keyword followed by @f@.  Sometimes called the "maximum
    -- munch" rule.
    keyword :: T.Text -> Parsec Void T.Text ()
    keyword :: Text -> Parsec Void Text ()
    keyword Text
    s = Parsec Void Text () -> Parsec Void Text ()
    forall a. Parsec Void Text a -> Parsec Void Text a
    lexeme (Parsec Void Text () -> Parsec Void Text ())
    -> Parsec Void Text () -> Parsec Void Text ()
    forall a b. (a -> b) -> a -> b
    $ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    chunk Text
    Tokens Text
    s ParsecT Void Text Identity (Tokens Text)
    -> Parsec Void Text () -> Parsec Void Text ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity (Token Text) -> Parsec Void Text ()
    forall a. ParsecT Void Text Identity a -> Parsec Void Text ()
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
    notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    (Token s -> Bool) -> m (Token s)
    satisfy Char -> Bool
    Token Text -> Bool
    constituent)

    -- | Parse an integer value.
    pIntValue :: Parsec Void T.Text IntValue
    pIntValue :: Parsec Void Text IntValue
    pIntValue = Parsec Void Text IntValue -> Parsec Void Text IntValue
    forall a. Parsec Void Text a -> Parsec Void Text a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parsec Void Text IntValue -> Parsec Void Text IntValue)
    -> Parsec Void Text IntValue -> Parsec Void Text IntValue
    forall a b. (a -> b) -> a -> b
    $ do
      Integer
    x <- Parsec Void Text ()
    -> ParsecT Void Text Identity Integer
    -> ParsecT Void Text Identity Integer
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m () -> m a -> m a
    L.signed (() -> Parsec Void Text ()
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()) ParsecT Void Text Identity Integer
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    L.decimal
      IntType
    t <- Parsec Void Text IntType
    pIntType
      IntValue -> Parsec Void Text IntValue
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IntValue -> Parsec Void Text IntValue)
    -> IntValue -> Parsec Void Text IntValue
    forall a b. (a -> b) -> a -> b
    $ IntType -> Integer -> IntValue
    forall int. Integral int => IntType -> int -> IntValue
    intValue IntType
    t (Integer
    x :: Integer)

    -- | Parse a floating-point value.
    pFloatValue :: Parsec Void T.Text FloatValue
    pFloatValue :: Parsec Void Text FloatValue
    pFloatValue =
      [Parsec Void Text FloatValue] -> Parsec Void Text FloatValue
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
        [ Parsec Void Text FloatValue
    pNum,
          Text -> Parsec Void Text ()
    keyword Text
    "f16.nan" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Half -> FloatValue
    Float16Value (Half
    0 Half -> Half -> Half
    forall a. Fractional a => a -> a -> a
    / Half
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "f16.inf" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Half -> FloatValue
    Float16Value (Half
    1 Half -> Half -> Half
    forall a. Fractional a => a -> a -> a
    / Half
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "-f16.inf" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Half -> FloatValue
    Float16Value (-Half
    1 Half -> Half -> Half
    forall a. Fractional a => a -> a -> a
    / Half
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "f32.nan" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Float -> FloatValue
    Float32Value (Float
    0 Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    / Float
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "f32.inf" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Float -> FloatValue
    Float32Value (Float
    1 Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    / Float
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "-f32.inf" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Float -> FloatValue
    Float32Value (-Float
    1 Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    / Float
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "f64.nan" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Double -> FloatValue
    Float64Value (Double
    0 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "f64.inf" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Double -> FloatValue
    Float64Value (Double
    1 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    0),
          Text -> Parsec Void Text ()
    keyword Text
    "-f64.inf" Parsec Void Text () -> FloatValue -> Parsec Void Text FloatValue
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Double -> FloatValue
    Float64Value (-Double
    1 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    0)
        ]
      where
        pNum :: Parsec Void Text FloatValue
    pNum = Parsec Void Text FloatValue -> Parsec Void Text FloatValue
    forall a. Parsec Void Text a -> Parsec Void Text a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parsec Void Text FloatValue -> Parsec Void Text FloatValue)
    -> Parsec Void Text FloatValue -> Parsec Void Text FloatValue
    forall a b. (a -> b) -> a -> b
    $ do
          Double
    x <- Parsec Void Text ()
    -> ParsecT Void Text Identity Double
    -> ParsecT Void Text Identity Double
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m () -> m a -> m a
    L.signed (() -> Parsec Void Text ()
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()) ParsecT Void Text Identity Double
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, RealFloat a) =>
    m a
    L.float
          FloatType
    t <- Parsec Void Text FloatType
    pFloatType
          FloatValue -> Parsec Void Text FloatValue
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FloatValue -> Parsec Void Text FloatValue)
    -> FloatValue -> Parsec Void Text FloatValue
    forall a b. (a -> b) -> a -> b
    $ FloatType -> Double -> FloatValue
    forall num. Real num => FloatType -> num -> FloatValue
    floatValue FloatType
    t (Double
    x :: Double)

    -- | Parse a boolean value.
    pBoolValue :: Parsec Void T.Text Bool
    pBoolValue :: Parsec Void Text Bool
    pBoolValue =
      [Parsec Void Text Bool] -> Parsec Void Text Bool
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
        [ Text -> Parsec Void Text ()
    keyword Text
    "true" Parsec Void Text () -> Bool -> Parsec Void Text Bool
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Bool
    True,
          Text -> Parsec Void Text ()
    keyword Text
    "false" Parsec Void Text () -> Bool -> Parsec Void Text Bool
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Bool
    False
        ]

    -- | Defined in this module for convenience.
    pPrimValue :: Parsec Void T.Text PrimValue
    pPrimValue :: Parsec Void Text PrimValue
    pPrimValue =
      [Parsec Void Text PrimValue] -> Parsec Void Text PrimValue
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
        [ FloatValue -> PrimValue
    FloatValue (FloatValue -> PrimValue)
    -> Parsec Void Text FloatValue -> Parsec Void Text PrimValue
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parsec Void Text FloatValue
    pFloatValue,
          IntValue -> PrimValue
    IntValue (IntValue -> PrimValue)
    -> Parsec Void Text IntValue -> Parsec Void Text PrimValue
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parsec Void Text IntValue
    pIntValue,
          Bool -> PrimValue
    BoolValue (Bool -> PrimValue)
    -> Parsec Void Text Bool -> Parsec Void Text PrimValue
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parsec Void Text Bool
    pBoolValue,
          PrimValue
    UnitValue PrimValue -> Parsec Void Text Text -> Parsec Void Text PrimValue
    forall a b.
    a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Parsec Void Text Text -> Parsec Void Text Text
    forall a. Parsec Void Text a -> Parsec Void Text a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parsec Void Text Text -> Parsec Void Text Text
    forall a. Parsec Void Text a -> Parsec Void Text a
    lexeme Parsec Void Text Text
    "(" Parsec Void Text Text
    -> Parsec Void Text Text -> Parsec Void Text Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parsec Void Text Text -> Parsec Void Text Text
    forall a. Parsec Void Text a -> Parsec Void Text a
    lexeme Parsec Void Text Text
    ")")
        ]
        Parsec Void Text PrimValue -> [Char] -> Parsec Void Text PrimValue
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    m a -> [Char] -> m a
    <?> [Char]
    "primitive value"

    -- | Parse a floating-point type.
    pFloatType :: Parsec Void T.Text FloatType
    pFloatType :: Parsec Void Text FloatType
    pFloatType = [Parsec Void Text FloatType] -> Parsec Void Text FloatType
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice ([Parsec Void Text FloatType] -> Parsec Void Text FloatType)
    -> [Parsec Void Text FloatType] -> Parsec Void Text FloatType
    forall a b. (a -> b) -> a -> b
    $ (FloatType -> Parsec Void Text FloatType)
    -> [FloatType] -> [Parsec Void Text FloatType]
    forall a b. (a -> b) -> [a] -> [b]
    map FloatType -> Parsec Void Text FloatType
    forall {b}. Pretty b => b -> ParsecT Void Text Identity b
    p [FloatType]
    allFloatTypes
      where
        p :: b -> ParsecT Void Text Identity b
    p b
    t = Text -> Parsec Void Text ()
    keyword (b -> Text
    forall a. Pretty a => a -> Text
    prettyText b
    t) Parsec Void Text () -> b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> b
    t

    -- | Parse an integer type.
    pIntType :: Parsec Void T.Text IntType
    pIntType :: Parsec Void Text IntType
    pIntType = [Parsec Void Text IntType] -> Parsec Void Text IntType
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice ([Parsec Void Text IntType] -> Parsec Void Text IntType)
    -> [Parsec Void Text IntType] -> Parsec Void Text IntType
    forall a b. (a -> b) -> a -> b
    $ (IntType -> Parsec Void Text IntType)
    -> [IntType] -> [Parsec Void Text IntType]
    forall a b. (a -> b) -> [a] -> [b]
    map IntType -> Parsec Void Text IntType
    forall {b}. Pretty b => b -> ParsecT Void Text Identity b
    p [IntType]
    allIntTypes
      where
        p :: b -> ParsecT Void Text Identity b
    p b
    t = Text -> Parsec Void Text ()
    keyword (b -> Text
    forall a. Pretty a => a -> Text
    prettyText b
    t) Parsec Void Text () -> b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> b
    t

    -- | Parse a primitive type.
    pPrimType :: Parsec Void T.Text PrimType
    pPrimType :: Parsec Void Text PrimType
    pPrimType =
      [Parsec Void Text PrimType] -> Parsec Void Text PrimType
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [PrimType -> Parsec Void Text PrimType
    forall {b}. Pretty b => b -> ParsecT Void Text Identity b
    p PrimType
    Bool, PrimType -> Parsec Void Text PrimType
    forall {b}. Pretty b => b -> ParsecT Void Text Identity b
    p PrimType
    Unit, FloatType -> PrimType
    FloatType (FloatType -> PrimType)
    -> Parsec Void Text FloatType -> Parsec Void Text PrimType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parsec Void Text FloatType
    pFloatType, IntType -> PrimType
    IntType (IntType -> PrimType)
    -> Parsec Void Text IntType -> Parsec Void Text PrimType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parsec Void Text IntType
    pIntType]
      where
        p :: b -> ParsecT Void Text Identity b
    p b
    t = Text -> Parsec Void Text ()
    keyword (b -> Text
    forall a. Pretty a => a -> Text
    prettyText b
    t) Parsec Void Text () -> b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> b
    t