-- | Building blocks for parsing prim primexpressions.  *Not* an infix
-- representation.
module Futhark.Analysis.PrimExp.Parse
  ( pPrimExp,
    pPrimValue,

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

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

pBinOp :: Parsec Void T.Text BinOp
pBinOp :: Parsec Void Text BinOp
pBinOp = [Parsec Void Text BinOp] -> Parsec Void Text BinOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parsec Void Text BinOp] -> Parsec Void Text BinOp)
-> [Parsec Void Text BinOp] -> Parsec Void Text BinOp
forall a b. (a -> b) -> a -> b
$ (BinOp -> Parsec Void Text BinOp)
-> [BinOp] -> [Parsec Void Text BinOp]
forall a b. (a -> b) -> [a] -> [b]
map BinOp -> Parsec Void Text 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 -> Parsec Void Text ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parsec Void Text () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

pCmpOp :: Parsec Void T.Text CmpOp
pCmpOp :: Parsec Void Text CmpOp
pCmpOp = [Parsec Void Text CmpOp] -> Parsec Void Text CmpOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parsec Void Text CmpOp] -> Parsec Void Text CmpOp)
-> [Parsec Void Text CmpOp] -> Parsec Void Text CmpOp
forall a b. (a -> b) -> a -> b
$ (CmpOp -> Parsec Void Text CmpOp)
-> [CmpOp] -> [Parsec Void Text CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map CmpOp -> Parsec Void Text 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 -> Parsec Void Text ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parsec Void Text () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

pUnOp :: Parsec Void T.Text UnOp
pUnOp :: Parsec Void Text UnOp
pUnOp = [Parsec Void Text UnOp] -> Parsec Void Text UnOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parsec Void Text UnOp] -> Parsec Void Text UnOp)
-> [Parsec Void Text UnOp] -> Parsec Void Text UnOp
forall a b. (a -> b) -> a -> b
$ (UnOp -> Parsec Void Text UnOp)
-> [UnOp] -> [Parsec Void Text UnOp]
forall a b. (a -> b) -> [a] -> [b]
map UnOp -> Parsec Void Text 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 -> Parsec Void Text ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parsec Void Text () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

pConvOp :: Parsec Void T.Text ConvOp
pConvOp :: Parsec Void Text ConvOp
pConvOp = [Parsec Void Text ConvOp] -> Parsec Void Text ConvOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parsec Void Text ConvOp] -> Parsec Void Text ConvOp)
-> [Parsec Void Text ConvOp] -> Parsec Void Text ConvOp
forall a b. (a -> b) -> a -> b
$ (ConvOp -> Parsec Void Text ConvOp)
-> [ConvOp] -> [Parsec Void Text ConvOp]
forall a b. (a -> b) -> [a] -> [b]
map ConvOp -> Parsec Void Text 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 -> Parsec Void Text ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
op) Parsec Void Text () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
op

parens :: Parsec Void T.Text a -> Parsec Void T.Text a
parens :: forall a. Parsec Void Text a -> Parsec Void Text a
parens = Parsec Void Text Text
-> Parsec Void Text Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (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
forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
")")

-- | Parse a 'PrimExp' given a leaf parser.
pPrimExp :: PrimType -> Parsec Void T.Text v -> Parsec Void T.Text (PrimExp v)
pPrimExp :: forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp PrimType
t Parsec Void Text v
pLeaf =
  [ParsecT Void Text Identity (PrimExp v)]
-> ParsecT Void Text Identity (PrimExp v)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ (v -> PrimType -> PrimExp v) -> PrimType -> v -> PrimExp v
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> PrimType -> PrimExp v
forall v. v -> PrimType -> PrimExp v
LeafExp PrimType
t (v -> PrimExp v)
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text v
pLeaf,
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> ParsecT Void Text Identity PrimValue
-> ParsecT Void Text Identity (PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity PrimValue
pPrimValue,
      Parsec Void Text BinOp
pBinOp Parsec Void Text BinOp
-> (BinOp -> ParsecT Void Text Identity (PrimExp v))
-> ParsecT Void Text Identity (PrimExp v)
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BinOp -> ParsecT Void Text Identity (PrimExp v)
binOpExp,
      Parsec Void Text CmpOp
pCmpOp Parsec Void Text CmpOp
-> (CmpOp -> ParsecT Void Text Identity (PrimExp v))
-> ParsecT Void Text Identity (PrimExp v)
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CmpOp -> ParsecT Void Text Identity (PrimExp v)
cmpOpExp,
      Parsec Void Text ConvOp
pConvOp Parsec Void Text ConvOp
-> (ConvOp -> ParsecT Void Text Identity (PrimExp v))
-> ParsecT Void Text Identity (PrimExp v)
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConvOp -> ParsecT Void Text Identity (PrimExp v)
convOpExp,
      Parsec Void Text UnOp
pUnOp Parsec Void Text UnOp
-> (UnOp -> ParsecT Void Text Identity (PrimExp v))
-> ParsecT Void Text Identity (PrimExp v)
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnOp -> ParsecT Void Text Identity (PrimExp v)
unOpExp,
      ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
forall a. Parsec Void Text a -> Parsec Void Text a
parens (ParsecT Void Text Identity (PrimExp v)
 -> ParsecT Void Text Identity (PrimExp v))
-> ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
forall a b. (a -> b) -> a -> b
$ PrimType
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp PrimType
t Parsec Void Text v
pLeaf
    ]
  where
    binOpExp :: BinOp -> ParsecT Void Text Identity (PrimExp v)
binOpExp BinOp
op =
      BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op
        (PrimExp v -> PrimExp v -> PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimType
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp (BinOp -> PrimType
binOpType BinOp
op) Parsec Void Text v
pLeaf
        ParsecT Void Text Identity (PrimExp v -> PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PrimType
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp (BinOp -> PrimType
binOpType BinOp
op) Parsec Void Text v
pLeaf
    cmpOpExp :: CmpOp -> ParsecT Void Text Identity (PrimExp v)
cmpOpExp CmpOp
op =
      CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp CmpOp
op
        (PrimExp v -> PrimExp v -> PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v -> PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimType
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp (CmpOp -> PrimType
cmpOpType CmpOp
op) Parsec Void Text v
pLeaf
        ParsecT Void Text Identity (PrimExp v -> PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PrimType
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp (CmpOp -> PrimType
cmpOpType CmpOp
op) Parsec Void Text v
pLeaf
    convOpExp :: ConvOp -> ParsecT Void Text Identity (PrimExp v)
convOpExp ConvOp
op =
      ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp ConvOp
op (PrimExp v -> PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimType
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp ((PrimType, PrimType) -> PrimType
forall a b. (a, b) -> a
fst (ConvOp -> (PrimType, PrimType)
convOpType ConvOp
op)) Parsec Void Text v
pLeaf
    unOpExp :: UnOp -> ParsecT Void Text Identity (PrimExp v)
unOpExp UnOp
op =
      UnOp -> PrimExp v -> PrimExp v
forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp UnOp
op (PrimExp v -> PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
-> ParsecT Void Text Identity (PrimExp v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimType
-> Parsec Void Text v -> ParsecT Void Text Identity (PrimExp v)
forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp (UnOp -> PrimType
unOpType UnOp
op) Parsec Void Text v
pLeaf