{-# LANGUAGE OverloadedStrings #-}

module Futhark.Analysis.PrimExp.Parse
  ( pPrimExp,
    pPrimValue,

    -- * Module reexport
    module Futhark.Analysis.PrimExp,
  )
where

import Data.Functor
import qualified Data.Text as T
import Data.Void
import Futhark.Analysis.PrimExp
import Futhark.IR.Primitive.Parse
import Futhark.Util.Pretty (prettyText)
import Text.Megaparsec

type Parser = Parsec Void T.Text

pBinOp :: Parser BinOp
pBinOp :: Parser BinOp
pBinOp = [Parser BinOp] -> Parser BinOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser BinOp] -> Parser BinOp) -> [Parser BinOp] -> Parser BinOp
forall a b. (a -> b) -> a -> b
$ (BinOp -> Parser BinOp) -> [BinOp] -> [Parser BinOp]
forall a b. (a -> b) -> [a] -> [b]
map BinOp -> Parser BinOp
forall b. Pretty b => b -> ParsecT Void Text Identity b
p [BinOp]
allBinOps
  where
    p :: b -> ParsecT Void Text Identity b
p b
op = Text -> Parser ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parser () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

pCmpOp :: Parser CmpOp
pCmpOp :: Parser CmpOp
pCmpOp = [Parser CmpOp] -> Parser CmpOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser CmpOp] -> Parser CmpOp) -> [Parser CmpOp] -> Parser CmpOp
forall a b. (a -> b) -> a -> b
$ (CmpOp -> Parser CmpOp) -> [CmpOp] -> [Parser CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map CmpOp -> Parser CmpOp
forall b. Pretty b => b -> ParsecT Void Text Identity b
p [CmpOp]
allCmpOps
  where
    p :: b -> ParsecT Void Text Identity b
p b
op = Text -> Parser ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parser () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

pUnOp :: Parser UnOp
pUnOp :: Parser UnOp
pUnOp = [Parser UnOp] -> Parser UnOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser UnOp] -> Parser UnOp) -> [Parser UnOp] -> Parser UnOp
forall a b. (a -> b) -> a -> b
$ (UnOp -> Parser UnOp) -> [UnOp] -> [Parser UnOp]
forall a b. (a -> b) -> [a] -> [b]
map UnOp -> Parser UnOp
forall b. Pretty b => b -> ParsecT Void Text Identity b
p [UnOp]
allUnOps
  where
    p :: b -> ParsecT Void Text Identity b
p b
op = Text -> Parser ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parser () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

pConvOp :: Parser ConvOp
pConvOp :: Parser ConvOp
pConvOp = [Parser ConvOp] -> Parser ConvOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser ConvOp] -> Parser ConvOp)
-> [Parser ConvOp] -> Parser ConvOp
forall a b. (a -> b) -> a -> b
$ (ConvOp -> Parser ConvOp) -> [ConvOp] -> [Parser ConvOp]
forall a b. (a -> b) -> [a] -> [b]
map ConvOp -> Parser ConvOp
forall b. Pretty b => b -> ParsecT Void Text Identity b
p [ConvOp]
allConvOps
  where
    p :: b -> ParsecT Void Text Identity b
p b
op = Text -> Parser ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parser () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

parens :: Parser a -> Parser a
parens :: Parser a -> Parser a
parens = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"(") (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
")")

pPrimExp :: Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp :: Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf =
  [Parser (PrimExp v)] -> Parser (PrimExp v)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ (v -> PrimType -> PrimExp v) -> (v, PrimType) -> PrimExp v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry v -> PrimType -> PrimExp v
forall v. v -> PrimType -> PrimExp v
LeafExp ((v, PrimType) -> PrimExp v)
-> Parser (v, PrimType) -> Parser (PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (v, PrimType)
pLeaf,
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> ParsecT Void Text Identity PrimValue -> Parser (PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity PrimValue
pPrimValue,
      BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (BinOp -> PrimExp v -> PrimExp v -> PrimExp v)
-> Parser BinOp
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BinOp
pBinOp ParsecT Void Text Identity (PrimExp v -> PrimExp v -> PrimExp v)
-> Parser (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (v, PrimType) -> Parser (PrimExp v)
forall v. Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf ParsecT Void Text Identity (PrimExp v -> PrimExp v)
-> Parser (PrimExp v) -> Parser (PrimExp v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (v, PrimType) -> Parser (PrimExp v)
forall v. Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf,
      CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp (CmpOp -> PrimExp v -> PrimExp v -> PrimExp v)
-> Parser CmpOp
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CmpOp
pCmpOp ParsecT Void Text Identity (PrimExp v -> PrimExp v -> PrimExp v)
-> Parser (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (v, PrimType) -> Parser (PrimExp v)
forall v. Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf ParsecT Void Text Identity (PrimExp v -> PrimExp v)
-> Parser (PrimExp v) -> Parser (PrimExp v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (v, PrimType) -> Parser (PrimExp v)
forall v. Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf,
      ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (ConvOp -> PrimExp v -> PrimExp v)
-> Parser ConvOp
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConvOp
pConvOp ParsecT Void Text Identity (PrimExp v -> PrimExp v)
-> Parser (PrimExp v) -> Parser (PrimExp v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (v, PrimType) -> Parser (PrimExp v)
forall v. Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf,
      UnOp -> PrimExp v -> PrimExp v
forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (UnOp -> PrimExp v -> PrimExp v)
-> Parser UnOp
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UnOp
pUnOp ParsecT Void Text Identity (PrimExp v -> PrimExp v)
-> Parser (PrimExp v) -> Parser (PrimExp v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (v, PrimType) -> Parser (PrimExp v)
forall v. Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf,
      Parser (PrimExp v) -> Parser (PrimExp v)
forall a. Parser a -> Parser a
parens (Parser (PrimExp v) -> Parser (PrimExp v))
-> Parser (PrimExp v) -> Parser (PrimExp v)
forall a b. (a -> b) -> a -> b
$ Parser (v, PrimType) -> Parser (PrimExp v)
forall v. Parser (v, PrimType) -> Parser (PrimExp v)
pPrimExp Parser (v, PrimType)
pLeaf
    ]