-- | Parser for the Futhark core language.
module Futhark.IR.Parse
  ( parseSOACS,
    parseGPU,
    parseGPUMem,
    parseMC,
    parseMCMem,
    parseSeq,
    parseSeqMem,
  )
where

import Data.Char (isAlpha)
import Data.Functor
import Data.List (zipWith4)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Void
import Futhark.Analysis.PrimExp.Parse
import Futhark.IR
import Futhark.IR.GPU (GPU)
import Futhark.IR.GPU.Op qualified as GPU
import Futhark.IR.GPUMem (GPUMem)
import Futhark.IR.MC (MC)
import Futhark.IR.MC.Op qualified as MC
import Futhark.IR.MCMem (MCMem)
import Futhark.IR.Mem
import Futhark.IR.Mem.IxFun qualified as IxFun
import Futhark.IR.SOACS (SOACS)
import Futhark.IR.SOACS.SOAC qualified as SOAC
import Futhark.IR.SegOp qualified as SegOp
import Futhark.IR.Seq (Seq)
import Futhark.IR.SeqMem (SeqMem)
import Language.Futhark.Primitive.Parse
import Text.Megaparsec
import Text.Megaparsec.Char hiding (space)
import Text.Megaparsec.Char.Lexer qualified as L

type Parser = Parsec Void T.Text

pStringLiteral :: Parser T.Text
pStringLiteral :: Parsec Void Text Text
pStringLiteral =
  forall a. Parsec Void Text a -> Parsec Void Text a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"')

pName :: Parser Name
pName :: Parser Name
pName =
  forall a. Parsec Void Text a -> Parsec Void Text a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Name
nameFromString forall a b. (a -> b) -> a -> b
$
    (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
leading forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
constituent)
  where
    leading :: Char -> Bool
leading Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"_+-*/%=!<>|&^." :: String)

pVName :: Parser VName
pVName :: Parser VName
pVName = forall a. Parsec Void Text a -> Parsec Void Text a
lexeme forall a b. (a -> b) -> a -> b
$ do
  (String
s, Int
tag) <-
    forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
constituent
      forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
`manyTill_` forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Int
pTag
      forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"variable name"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Int -> VName
VName (String -> Name
nameFromString String
s) Int
tag
  where
    pTag :: ParsecT Void Text Identity Int
pTag =
      Parsec Void Text Text
"_" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
constituent)

pBool :: Parser Bool
pBool :: Parser Bool
pBool = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Text -> Parsec Void Text ()
keyword Text
"true" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True, Text -> Parsec Void Text ()
keyword Text
"false" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False]

pInt :: Parser Int
pInt :: ParsecT Void Text Identity Int
pInt = forall a. Parsec Void Text a -> Parsec Void Text a
lexeme forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

pInt64 :: Parser Int64
pInt64 :: Parser Int64
pInt64 = forall a. Parsec Void Text a -> Parsec Void Text a
lexeme forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

braces, brackets, parens :: Parser a -> Parser a
braces :: forall a. Parsec Void Text a -> Parsec Void Text a
braces = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"{") (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"}")
brackets :: forall a. Parsec Void Text a -> Parsec Void Text a
brackets = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"[") (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"]")
parens :: forall a. Parsec Void Text a -> Parsec Void Text a
parens = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"(") (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
")")

pComma, pColon, pSemi, pEqual, pSlash, pAsterisk, pArrow :: Parser ()
pComma :: Parsec Void Text ()
pComma = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
","
pColon :: Parsec Void Text ()
pColon = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
":"
pSemi :: Parsec Void Text ()
pSemi = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
";"
pEqual :: Parsec Void Text ()
pEqual = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"="
pSlash :: Parsec Void Text ()
pSlash = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"/"
pAsterisk :: Parsec Void Text ()
pAsterisk = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"*"
pArrow :: Parsec Void Text ()
pArrow = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"->"

pNonArray :: Parser (TypeBase shape NoUniqueness)
pNonArray :: forall shape. Parser (TypeBase shape NoUniqueness)
pNonArray =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall shape u. PrimType -> TypeBase shape u
Prim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text PrimType
pPrimType,
      Parsec Void Text Text
"acc"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( forall shape u. VName -> Shape -> [Type] -> u -> TypeBase shape u
Acc
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Shape
pShape
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Type]
pTypes
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness
          )
    ]

pTypeBase ::
  ArrayShape shape =>
  Parser shape ->
  Parser u ->
  Parser (TypeBase shape u)
pTypeBase :: forall shape u.
ArrayShape shape =>
Parser shape -> Parser u -> Parser (TypeBase shape u)
pTypeBase Parser shape
ps Parser u
pu = do
  u
u <- Parser u
pu
  shape
shape <- Parser shape
ps
  forall shape u_unused u.
ArrayShape shape =>
TypeBase shape u_unused -> shape -> u -> TypeBase shape u
arrayOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall shape. Parser (TypeBase shape NoUniqueness)
pNonArray forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure shape
shape forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u

pShape :: Parser Shape
pShape :: Parser Shape
pShape = forall d. [d] -> ShapeBase d
Shape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall a. Parsec Void Text a -> Parsec Void Text a
brackets Parser SubExp
pSubExp)

pExt :: Parser a -> Parser (Ext a)
pExt :: forall a. Parser a -> Parser (Ext a)
pExt Parser a
p =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme forall a b. (a -> b) -> a -> b
$ Parsec Void Text Text
"?" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Int -> Ext a
Ext forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal,
      forall a. a -> Ext a
Free forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p
    ]

pExtSize :: Parser ExtSize
pExtSize :: Parser ExtSize
pExtSize = forall a. Parser a -> Parser (Ext a)
pExt Parser SubExp
pSubExp

pExtShape :: Parser ExtShape
pExtShape :: Parser ExtShape
pExtShape = forall d. [d] -> ShapeBase d
Shape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall a. Parsec Void Text a -> Parsec Void Text a
brackets Parser ExtSize
pExtSize)

pType :: Parser Type
pType :: Parser Type
pType = forall shape u.
ArrayShape shape =>
Parser shape -> Parser u -> Parser (TypeBase shape u)
pTypeBase Parser Shape
pShape (forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness)

pTypes :: Parser [Type]
pTypes :: Parser [Type]
pTypes = forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ Parser Type
pType forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma

pExtType :: Parser ExtType
pExtType :: Parser ExtType
pExtType = forall shape u.
ArrayShape shape =>
Parser shape -> Parser u -> Parser (TypeBase shape u)
pTypeBase Parser ExtShape
pExtShape (forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness)

pRank :: Parser Rank
pRank :: Parser Rank
pRank = Int -> Rank
Rank forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parsec Void Text Text
"[]"

pUniqueness :: Parser Uniqueness
pUniqueness :: Parser Uniqueness
pUniqueness = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parsec Void Text ()
pAsterisk forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Uniqueness
Unique, forall (f :: * -> *) a. Applicative f => a -> f a
pure Uniqueness
Nonunique]

pDeclBase ::
  Parser (TypeBase shape NoUniqueness) ->
  Parser (TypeBase shape Uniqueness)
pDeclBase :: forall shape.
Parser (TypeBase shape NoUniqueness)
-> Parser (TypeBase shape Uniqueness)
pDeclBase Parser (TypeBase shape NoUniqueness)
p = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall shape.
TypeBase shape NoUniqueness
-> Uniqueness -> TypeBase shape Uniqueness
toDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Uniqueness
pUniqueness forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TypeBase shape NoUniqueness)
p

pDeclType :: Parser DeclType
pDeclType :: Parser DeclType
pDeclType = forall shape.
Parser (TypeBase shape NoUniqueness)
-> Parser (TypeBase shape Uniqueness)
pDeclBase Parser Type
pType

pDeclExtType :: Parser DeclExtType
pDeclExtType :: Parser DeclExtType
pDeclExtType = forall shape.
Parser (TypeBase shape NoUniqueness)
-> Parser (TypeBase shape Uniqueness)
pDeclBase Parser ExtType
pExtType

pSubExp :: Parser SubExp
pSubExp :: Parser SubExp
pSubExp = VName -> SubExp
Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrimValue -> SubExp
Constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text PrimValue
pPrimValue

pSubExps :: Parser [SubExp]
pSubExps :: Parser [SubExp]
pSubExps = forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pVNames :: Parser [VName]
pVNames :: Parser [VName]
pVNames = forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pConvOp ::
  T.Text -> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp :: forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
s t1 -> t2 -> ConvOp
op Parser t1
t1 Parser t2
t2 =
  Text -> Parsec Void Text ()
keyword Text
s forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> t1 -> SubExp -> t2 -> BasicOp
op' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser t1
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parsec Void Text ()
keyword Text
"to" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser t2
t2)
  where
    op' :: t1 -> SubExp -> t2 -> BasicOp
op' t1
f SubExp
se t2
t = ConvOp -> SubExp -> BasicOp
ConvOp (t1 -> t2 -> ConvOp
op t1
f t2
t) SubExp
se

pBinOp :: Parser BasicOp
pBinOp :: Parser BasicOp
pBinOp = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall a b. (a -> b) -> [a] -> [b]
map BinOp -> Parser BasicOp
p [BinOp]
allBinOps) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"binary op"
  where
    p :: BinOp -> Parser BasicOp
p BinOp
bop =
      Text -> Parsec Void Text ()
keyword (forall a. Pretty a => a -> Text
prettyText BinOp
bop)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (BinOp -> SubExp -> SubExp -> BasicOp
BinOp BinOp
bop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp)

pCmpOp :: Parser BasicOp
pCmpOp :: Parser BasicOp
pCmpOp = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall a b. (a -> b) -> [a] -> [b]
map CmpOp -> Parser BasicOp
p [CmpOp]
allCmpOps) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"comparison op"
  where
    p :: CmpOp -> Parser BasicOp
p CmpOp
op =
      Text -> Parsec Void Text ()
keyword (forall a. Pretty a => a -> Text
prettyText CmpOp
op)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (CmpOp -> SubExp -> SubExp -> BasicOp
CmpOp CmpOp
op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp)

pUnOp :: Parser BasicOp
pUnOp :: Parser BasicOp
pUnOp = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall a b. (a -> b) -> [a] -> [b]
map UnOp -> Parser BasicOp
p [UnOp]
allUnOps) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"unary op"
  where
    p :: UnOp -> Parser BasicOp
p UnOp
bop = Text -> Parsec Void Text ()
keyword (forall a. Pretty a => a -> Text
prettyText UnOp
bop) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UnOp -> SubExp -> BasicOp
UnOp UnOp
bop forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp

pDimIndex :: Parser (DimIndex SubExp)
pDimIndex :: Parser (DimIndex SubExp)
pDimIndex =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
        forall d. d -> d -> d -> DimIndex d
DimSlice
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
":+"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"*"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp,
      forall d. d -> DimIndex d
DimFix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
    ]

pSlice :: Parser (Slice SubExp)
pSlice :: Parser (Slice SubExp)
pSlice = forall d. [DimIndex d] -> Slice d
Slice forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
brackets (Parser (DimIndex SubExp)
pDimIndex forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pIndex :: Parser BasicOp
pIndex :: Parser BasicOp
pIndex = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ VName -> Slice SubExp -> BasicOp
Index forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Slice SubExp)
pSlice

pFlatDimIndex :: Parser (FlatDimIndex SubExp)
pFlatDimIndex :: Parser (FlatDimIndex SubExp)
pFlatDimIndex =
  forall d. d -> d -> FlatDimIndex d
FlatDimIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp

pFlatSlice :: Parser (FlatSlice SubExp)
pFlatSlice :: Parser (FlatSlice SubExp)
pFlatSlice =
  forall a. Parsec Void Text a -> Parsec Void Text a
brackets forall a b. (a -> b) -> a -> b
$ forall d. d -> [FlatDimIndex d] -> FlatSlice d
FlatSlice forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSemi forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (FlatDimIndex SubExp)
pFlatDimIndex forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pFlatIndex :: Parser BasicOp
pFlatIndex :: Parser BasicOp
pFlatIndex = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ VName -> FlatSlice SubExp -> BasicOp
FlatIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (FlatSlice SubExp)
pFlatSlice

pErrorMsgPart :: Parser (ErrorMsgPart SubExp)
pErrorMsgPart :: Parser (ErrorMsgPart SubExp)
pErrorMsgPart =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. Text -> ErrorMsgPart a
ErrorString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Text
pStringLiteral,
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. PrimType -> a -> ErrorMsgPart a
ErrorVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text PrimType
pPrimType
    ]

pErrorMsg :: Parser (ErrorMsg SubExp)
pErrorMsg :: Parser (ErrorMsg SubExp)
pErrorMsg = forall a. [ErrorMsgPart a] -> ErrorMsg a
ErrorMsg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser (ErrorMsgPart SubExp)
pErrorMsgPart forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pSrcLoc :: Parser SrcLoc
pSrcLoc :: Parser SrcLoc
pSrcLoc = Parsec Void Text Text
pStringLiteral forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty -- FIXME

pErrorLoc :: Parser (SrcLoc, [SrcLoc])
pErrorLoc :: Parser (SrcLoc, [SrcLoc])
pErrorLoc = (,forall a. Monoid a => a
mempty) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SrcLoc
pSrcLoc

pIota :: Parser BasicOp
pIota :: Parser BasicOp
pIota =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map IntType -> Parser BasicOp
p [IntType]
allIntTypes
  where
    p :: IntType -> Parser BasicOp
p IntType
t =
      Text -> Parsec Void Text ()
keyword (Text
"iota" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText (PrimType -> Int
primBitSize (IntType -> PrimType
IntType IntType
t)))
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( SubExp -> SubExp -> SubExp -> IntType -> BasicOp
Iota
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure IntType
t
          )

pBasicOp :: Parser BasicOp
pBasicOp :: Parser BasicOp
pBasicOp =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"opaque" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OpaqueOp -> SubExp -> BasicOp
Opaque OpaqueOp
OpaqueNil forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
parens Parser SubExp
pSubExp,
      Text -> Parsec Void Text ()
keyword Text
"trace"
        forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (OpaqueOp -> SubExp -> BasicOp
Opaque forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OpaqueOp
OpaqueTrace)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
parens ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Text
pStringLiteral forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp),
      Text -> Parsec Void Text ()
keyword Text
"copy" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VName -> BasicOp
Copy forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
parens Parser VName
pVName,
      Text -> Parsec Void Text ()
keyword Text
"assert"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( SubExp -> ErrorMsg SubExp -> (SrcLoc, [SrcLoc]) -> BasicOp
Assert
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ErrorMsg SubExp)
pErrorMsg
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SrcLoc, [SrcLoc])
pErrorLoc
          ),
      Text -> Parsec Void Text ()
keyword Text
"rotate"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ([SubExp] -> VName -> BasicOp
Rotate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
parens (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName),
      Text -> Parsec Void Text ()
keyword Text
"replicate"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (Shape -> SubExp -> BasicOp
Replicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp),
      Text -> Parsec Void Text ()
keyword Text
"reshape"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ReshapeKind -> Shape -> VName -> BasicOp
Reshape ReshapeKind
ReshapeArbitrary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName),
      Text -> Parsec Void Text ()
keyword Text
"coerce"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ReshapeKind -> Shape -> VName -> BasicOp
Reshape ReshapeKind
ReshapeCoerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName),
      Text -> Parsec Void Text ()
keyword Text
"scratch"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (PrimType -> [SubExp] -> BasicOp
Scratch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text PrimType
pPrimType forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SubExp
pSubExp)),
      Text -> Parsec Void Text ()
keyword Text
"rearrange"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ([Int] -> VName -> BasicOp
Rearrange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ParsecT Void Text Identity Int
pInt forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName),
      Text -> Parsec Void Text ()
keyword Text
"manifest"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ([Int] -> VName -> BasicOp
Manifest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ParsecT Void Text Identity Int
pInt forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName),
      Text -> Parsec Void Text ()
keyword Text
"concat" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
        Int
d <- Parsec Void Text Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
        forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$ do
          SubExp
w <- Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          VName
x <- Parser VName
pVName
          [VName]
ys <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser VName
pVName)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> NonEmpty VName -> SubExp -> BasicOp
Concat Int
d (VName
x forall a. a -> [a] -> NonEmpty a
:| [VName]
ys) SubExp
w,
      Parser BasicOp
pIota,
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip Safety -> VName -> Slice SubExp -> SubExp -> BasicOp
Update
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parsec Void Text ()
keyword Text
"with"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"?" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Safety
Safe, forall (f :: * -> *) a. Applicative f => a -> f a
pure Safety
Unsafe]
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Slice SubExp)
pSlice
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"="
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp,
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
        VName -> FlatSlice SubExp -> VName -> BasicOp
FlatUpdate
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parsec Void Text ()
keyword Text
"with"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (FlatSlice SubExp)
pFlatSlice
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"="
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName,
      [SubExp] -> Type -> BasicOp
ArrayLit
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
brackets (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Text
"[]" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Type
pType),
      Text -> Parsec Void Text ()
keyword Text
"update_acc"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          (VName -> [SubExp] -> [SubExp] -> BasicOp
UpdateAcc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [SubExp]
pSubExps forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [SubExp]
pSubExps),
      --
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"sext" IntType -> IntType -> ConvOp
SExt Parsec Void Text IntType
pIntType Parsec Void Text IntType
pIntType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"zext" IntType -> IntType -> ConvOp
ZExt Parsec Void Text IntType
pIntType Parsec Void Text IntType
pIntType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"fpconv" FloatType -> FloatType -> ConvOp
FPConv Parsec Void Text FloatType
pFloatType Parsec Void Text FloatType
pFloatType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"fptoui" FloatType -> IntType -> ConvOp
FPToUI Parsec Void Text FloatType
pFloatType Parsec Void Text IntType
pIntType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"fptosi" FloatType -> IntType -> ConvOp
FPToSI Parsec Void Text FloatType
pFloatType Parsec Void Text IntType
pIntType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"uitofp" IntType -> FloatType -> ConvOp
UIToFP Parsec Void Text IntType
pIntType Parsec Void Text FloatType
pFloatType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"sitofp" IntType -> FloatType -> ConvOp
SIToFP Parsec Void Text IntType
pIntType Parsec Void Text FloatType
pFloatType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"itob" (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntType -> ConvOp
IToB) Parsec Void Text IntType
pIntType (Text -> Parsec Void Text ()
keyword Text
"bool"),
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"btoi" (forall a b. a -> b -> a
const IntType -> ConvOp
BToI) (Text -> Parsec Void Text ()
keyword Text
"bool") Parsec Void Text IntType
pIntType,
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"ftob" (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatType -> ConvOp
FToB) Parsec Void Text FloatType
pFloatType (Text -> Parsec Void Text ()
keyword Text
"bool"),
      forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
"btof" (forall a b. a -> b -> a
const FloatType -> ConvOp
BToF) (Text -> Parsec Void Text ()
keyword Text
"bool") Parsec Void Text FloatType
pFloatType,
      --
      Parser BasicOp
pIndex,
      Parser BasicOp
pFlatIndex,
      Parser BasicOp
pBinOp,
      Parser BasicOp
pCmpOp,
      Parser BasicOp
pUnOp,
      SubExp -> BasicOp
SubExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
    ]

pAttr :: Parser Attr
pAttr :: Parser Attr
pAttr =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Integer -> Attr
AttrInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
pInt,
      do
        Name
v <- Parser Name
pName
        forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ Name -> [Attr] -> Attr
AttrComp Name
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
parens (Parser Attr
pAttr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma),
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Attr
AttrName Name
v
          ]
    ]

pAttrs :: Parser Attrs
pAttrs :: Parser Attrs
pAttrs = Set Attr -> Attrs
Attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Attr
pAttr'
  where
    pAttr' :: Parser Attr
pAttr' = forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"#[" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Attr
pAttr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"]"

pComm :: Parser Commutativity
pComm :: Parser Commutativity
pComm =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"commutative" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Commutativity
Commutative,
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Commutativity
Noncommutative
    ]

-- | This record contains parser for all the representation-specific
-- bits.  Essentially a manually passed-around type class dictionary,
-- because ambiguities make it impossible to write this with actual
-- type classes.
data PR rep = PR
  { forall {k} (rep :: k). PR rep -> Parser (RetType rep)
pRetType :: Parser (RetType rep),
    forall {k} (rep :: k). PR rep -> Parser (BranchType rep)
pBranchType :: Parser (BranchType rep),
    forall {k} (rep :: k). PR rep -> Parser (FParamInfo rep)
pFParamInfo :: Parser (FParamInfo rep),
    forall {k} (rep :: k). PR rep -> Parser (LParamInfo rep)
pLParamInfo :: Parser (LParamInfo rep),
    forall {k} (rep :: k). PR rep -> Parser (LetDec rep)
pLetDec :: Parser (LetDec rep),
    forall {k} (rep :: k). PR rep -> Parser (Op rep)
pOp :: Parser (Op rep),
    forall {k} (rep :: k). PR rep -> BodyDec rep
pBodyDec :: BodyDec rep,
    forall {k} (rep :: k). PR rep -> ExpDec rep
pExpDec :: ExpDec rep
  }

pRetTypes :: PR rep -> Parser [RetType rep]
pRetTypes :: forall {k} (rep :: k). PR rep -> Parser [RetType rep]
pRetTypes PR rep
pr = forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k). PR rep -> Parser (RetType rep)
pRetType PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma

pBranchTypes :: PR rep -> Parser [BranchType rep]
pBranchTypes :: forall {k} (rep :: k). PR rep -> Parser [BranchType rep]
pBranchTypes PR rep
pr = forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k). PR rep -> Parser (BranchType rep)
pBranchType PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma

pParam :: Parser t -> Parser (Param t)
pParam :: forall t. Parser t -> Parser (Param t)
pParam Parser t
p = forall dec. Attrs -> VName -> dec -> Param dec
Param forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Attrs
pAttrs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parsec Void Text ()
pColon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser t
p)

pFParam :: PR rep -> Parser (FParam rep)
pFParam :: forall {k} (rep :: k). PR rep -> Parser (FParam rep)
pFParam = forall t. Parser t -> Parser (Param t)
pParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (rep :: k). PR rep -> Parser (FParamInfo rep)
pFParamInfo

pFParams :: PR rep -> Parser [FParam rep]
pFParams :: forall {k} (rep :: k). PR rep -> Parser [FParam rep]
pFParams PR rep
pr = forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k). PR rep -> Parser (FParam rep)
pFParam PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma

pLParam :: PR rep -> Parser (LParam rep)
pLParam :: forall {k} (rep :: k). PR rep -> Parser (LParam rep)
pLParam = forall t. Parser t -> Parser (Param t)
pParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (rep :: k). PR rep -> Parser (LParamInfo rep)
pLParamInfo

pLParams :: PR rep -> Parser [LParam rep]
pLParams :: forall {k} (rep :: k). PR rep -> Parser [LParam rep]
pLParams PR rep
pr = forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k). PR rep -> Parser (LParam rep)
pLParam PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma

pPatElem :: PR rep -> Parser (PatElem (LetDec rep))
pPatElem :: forall {k} (rep :: k). PR rep -> Parser (PatElem (LetDec rep))
pPatElem PR rep
pr =
  (forall dec. VName -> dec -> PatElem dec
PatElem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parsec Void Text ()
pColon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} (rep :: k). PR rep -> Parser (LetDec rep)
pLetDec PR rep
pr)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"pattern element"

pPat :: PR rep -> Parser (Pat (LetDec rep))
pPat :: forall {k} (rep :: k). PR rep -> Parser (Pat (LetDec rep))
pPat PR rep
pr = forall dec. [PatElem dec] -> Pat dec
Pat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (PatElem (LetDec rep))
pPatElem PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pResult :: Parser Result
pResult :: Parser Result
pResult = forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ Parser SubExpRes
pSubExpRes forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma

pMatchSort :: Parser MatchSort
pMatchSort :: Parser MatchSort
pMatchSort =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"<fallback>" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MatchSort
MatchFallback,
      forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"<equiv>" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MatchSort
MatchEquiv,
      forall (f :: * -> *) a. Applicative f => a -> f a
pure MatchSort
MatchNormal
    ]

pBranchBody :: PR rep -> Parser (Body rep)
pBranchBody :: forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBranchBody PR rep
pr =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
BodyDec rep -> Stms rep -> Result -> Body rep
Body (forall {k} (rep :: k). PR rep -> BodyDec rep
pBodyDec PR rep
pr) forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Result
pResult,
      forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBody PR rep
pr)
    ]

pIf :: PR rep -> Parser (Exp rep)
pIf :: forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pIf PR rep
pr =
  Text -> Parsec Void Text ()
keyword Text
"if"
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} {rep :: k}.
MatchSort
-> SubExp -> Body rep -> Body rep -> [BranchType rep] -> Exp rep
f
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MatchSort
pMatchSort
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parsec Void Text ()
keyword Text
"then" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBranchBody PR rep
pr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parsec Void Text ()
keyword Text
"else" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBranchBody PR rep
pr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} (rep :: k). PR rep -> Parser [BranchType rep]
pBranchTypes PR rep
pr)
  where
    f :: MatchSort
-> SubExp -> Body rep -> Body rep -> [BranchType rep] -> Exp rep
f MatchSort
sort SubExp
cond Body rep
tbranch Body rep
fbranch [BranchType rep]
t =
      forall {k} (rep :: k).
[SubExp]
-> [Case (Body rep)]
-> Body rep
-> MatchDec (BranchType rep)
-> Exp rep
Match [SubExp
cond] [forall body. [Maybe PrimValue] -> body -> Case body
Case [forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue Bool
True] Body rep
tbranch] Body rep
fbranch forall a b. (a -> b) -> a -> b
$ forall rt. [rt] -> MatchSort -> MatchDec rt
MatchDec [BranchType rep]
t MatchSort
sort

pMatch :: PR rep -> Parser (Exp rep)
pMatch :: forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pMatch PR rep
pr =
  Text -> Parsec Void Text ()
keyword Text
"match"
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} {rep :: k}.
MatchSort
-> [SubExp]
-> [Case (Body rep)]
-> Body rep
-> [BranchType rep]
-> Exp rep
f
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MatchSort
pMatchSort
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity (Case (Body rep))
pCase
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parsec Void Text ()
keyword Text
"default" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"->" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBranchBody PR rep
pr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} (rep :: k). PR rep -> Parser [BranchType rep]
pBranchTypes PR rep
pr)
  where
    f :: MatchSort
-> [SubExp]
-> [Case (Body rep)]
-> Body rep
-> [BranchType rep]
-> Exp rep
f MatchSort
sort [SubExp]
cond [Case (Body rep)]
cases Body rep
defbody [BranchType rep]
t =
      forall {k} (rep :: k).
[SubExp]
-> [Case (Body rep)]
-> Body rep
-> MatchDec (BranchType rep)
-> Exp rep
Match [SubExp]
cond [Case (Body rep)]
cases Body rep
defbody forall a b. (a -> b) -> a -> b
$ forall rt. [rt] -> MatchSort -> MatchDec rt
MatchDec [BranchType rep]
t MatchSort
sort
    pCase :: ParsecT Void Text Identity (Case (Body rep))
pCase =
      Text -> Parsec Void Text ()
keyword Text
"case"
        forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall body. [Maybe PrimValue] -> body -> Case body
Case
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (ParsecT Void Text Identity (Maybe PrimValue)
pMaybeValue forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"->"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBranchBody PR rep
pr
    pMaybeValue :: ParsecT Void Text Identity (Maybe PrimValue)
pMaybeValue =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"_" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text PrimValue
pPrimValue]

pApply :: PR rep -> Parser (Exp rep)
pApply :: forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pApply PR rep
pr =
  Text -> Parsec Void Text ()
keyword Text
"apply" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Safety -> ParsecT Void Text Identity (Exp rep)
p forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"<unsafe>" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Safety
Unsafe, forall (f :: * -> *) a. Applicative f => a -> f a
pure Safety
Safe])
  where
    p :: Safety -> ParsecT Void Text Identity (Exp rep)
p Safety
safety =
      forall {k} (rep :: k).
Name
-> [(SubExp, Diet)]
-> [RetType rep]
-> (Safety, SrcLoc, [SrcLoc])
-> Exp rep
Apply
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ParsecT Void Text Identity (SubExp, Diet)
pArg forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser [RetType rep]
pRetTypes PR rep
pr
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Safety
safety, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)

    pArg :: ParsecT Void Text Identity (SubExp, Diet)
pArg =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"*" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (,Diet
Consume) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp,
          (,Diet
Observe) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
        ]

pLoop :: PR rep -> Parser (Exp rep)
pLoop :: forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pLoop PR rep
pr =
  Text -> Parsec Void Text ()
keyword Text
"loop"
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (rep :: k).
[(FParam rep, SubExp)] -> LoopForm rep -> Body rep -> Exp rep
DoLoop
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [(Param (FParamInfo rep), SubExp)]
pLoopParams
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (LoopForm rep)
pLoopForm
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parsec Void Text ()
keyword Text
"do"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBody PR rep
pr)
  where
    pLoopParams :: ParsecT Void Text Identity [(Param (FParamInfo rep), SubExp)]
pLoopParams = do
      [Param (FParamInfo rep)]
params <- forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k). PR rep -> Parser (FParam rep)
pFParam PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"="
      [SubExp]
args <- forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. [a] -> [b] -> [(a, b)]
zip [Param (FParamInfo rep)]
params [SubExp]
args)

    pLoopForm :: ParsecT Void Text Identity (LoopForm rep)
pLoopForm =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Text -> Parsec Void Text ()
keyword Text
"for"
            forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (rep :: k).
VName -> IntType -> SubExp -> [(LParam rep, VName)] -> LoopForm rep
ForLoop
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
":"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text IntType
pIntType
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"<"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (LParam rep)
pLParam PR rep
pr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parsec Void Text ()
keyword Text
"in" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName),
          Text -> Parsec Void Text ()
keyword Text
"while" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (rep :: k). VName -> LoopForm rep
WhileLoop forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName
        ]

pLambda :: PR rep -> Parser (Lambda rep)
pLambda :: forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"\\"
        forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} {rep :: k}.
[Param (LParamInfo rep)] -> [Type] -> Body rep -> Lambda rep
lam
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser [LParam rep]
pLParams PR rep
pr
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Type]
pTypes
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pArrow
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBody PR rep
pr,
      Text -> Parsec Void Text ()
keyword Text
"nilFn" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (rep :: k).
[LParam rep] -> Body rep -> [Type] -> Lambda rep
Lambda forall a. Monoid a => a
mempty (forall {k} (rep :: k).
BodyDec rep -> Stms rep -> Result -> Body rep
Body (forall {k} (rep :: k). PR rep -> BodyDec rep
pBodyDec PR rep
pr) forall a. Monoid a => a
mempty []) []
    ]
  where
    lam :: [Param (LParamInfo rep)] -> [Type] -> Body rep -> Lambda rep
lam [Param (LParamInfo rep)]
params [Type]
ret Body rep
body = forall {k} (rep :: k).
[LParam rep] -> Body rep -> [Type] -> Lambda rep
Lambda [Param (LParamInfo rep)]
params Body rep
body [Type]
ret

pReduce :: PR rep -> Parser (SOAC.Reduce rep)
pReduce :: forall {k} (rep :: k). PR rep -> Parser (Reduce rep)
pReduce PR rep
pr =
  forall {k} (rep :: k).
Commutativity -> Lambda rep -> [SubExp] -> Reduce rep
SOAC.Reduce
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Commutativity
pComm
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pScan :: PR rep -> Parser (SOAC.Scan rep)
pScan :: forall {k} (rep :: k). PR rep -> Parser (Scan rep)
pScan PR rep
pr =
  forall {k} (rep :: k). Lambda rep -> [SubExp] -> Scan rep
SOAC.Scan
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pWithAcc :: PR rep -> Parser (Exp rep)
pWithAcc :: forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pWithAcc PR rep
pr =
  Text -> Parsec Void Text ()
keyword Text
"with_acc"
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (forall {k} (rep :: k). [WithAccInput rep] -> Lambda rep -> Exp rep
WithAcc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser (WithAccInput rep)
pInput forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr)
  where
    pInput :: Parser (WithAccInput rep)
pInput =
      forall a. Parsec Void Text a -> Parsec Void Text a
parens
        ( (,,)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VName]
pVNames
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Lambda rep, [SubExp])
pCombFun)
        )
    pCombFun :: ParsecT Void Text Identity (Lambda rep, [SubExp])
pCombFun = forall a. Parsec Void Text a -> Parsec Void Text a
parens ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [SubExp]
pSubExps)

pExp :: PR rep -> Parser (Exp rep)
pExp :: forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pExp PR rep
pr =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pIf PR rep
pr,
      forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pMatch PR rep
pr,
      forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pApply PR rep
pr,
      forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pLoop PR rep
pr,
      forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pWithAcc PR rep
pr,
      forall {k} (rep :: k). Op rep -> Exp rep
Op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Op rep)
pOp PR rep
pr,
      forall {k} (rep :: k). BasicOp -> Exp rep
BasicOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BasicOp
pBasicOp
    ]

pCerts :: Parser Certs
pCerts :: Parser Certs
pCerts =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"#"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
braces ([VName] -> Certs
Certs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"certificates",
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    ]

pSubExpRes :: Parser SubExpRes
pSubExpRes :: Parser SubExpRes
pSubExpRes = Certs -> SubExp -> SubExpRes
SubExpRes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Certs
pCerts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp

pStm :: PR rep -> Parser (Stm rep)
pStm :: forall {k} (rep :: k). PR rep -> Parser (Stm rep)
pStm PR rep
pr =
  Text -> Parsec Void Text ()
keyword Text
"let" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (rep :: k).
Pat (LetDec rep) -> StmAux (ExpDec rep) -> Exp rep -> Stm rep
Let forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Pat (LetDec rep))
pPat PR rep
pr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pEqual forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (StmAux (ExpDec rep))
pStmAux forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Exp rep)
pExp PR rep
pr
  where
    pStmAux :: ParsecT Void Text Identity (StmAux (ExpDec rep))
pStmAux = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall dec. Certs -> Attrs -> dec -> StmAux dec
StmAux forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Attrs
pAttrs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Certs
pCerts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} (rep :: k). PR rep -> ExpDec rep
pExpDec PR rep
pr)

pStms :: PR rep -> Parser (Stms rep)
pStms :: forall {k} (rep :: k). PR rep -> Parser (Stms rep)
pStms PR rep
pr = forall {k} (rep :: k). [Stm rep] -> Stms rep
stmsFromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall {k} (rep :: k). PR rep -> Parser (Stm rep)
pStm PR rep
pr)

pBody :: PR rep -> Parser (Body rep)
pBody :: forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBody PR rep
pr =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall {k} (rep :: k).
BodyDec rep -> Stms rep -> Result -> Body rep
Body (forall {k} (rep :: k). PR rep -> BodyDec rep
pBodyDec PR rep
pr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Stms rep)
pStms PR rep
pr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parsec Void Text ()
keyword Text
"in" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Result
pResult,
      forall {k} (rep :: k).
BodyDec rep -> Stms rep -> Result -> Body rep
Body (forall {k} (rep :: k). PR rep -> BodyDec rep
pBodyDec PR rep
pr) forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Result
pResult
    ]

pValueType :: Parser ValueType
pValueType :: Parser ValueType
pValueType = Rank -> (Signedness, PrimType) -> ValueType
comb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Rank
pRank forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Signedness, PrimType)
pSignedType
  where
    comb :: Rank -> (Signedness, PrimType) -> ValueType
comb Rank
r (Signedness
s, PrimType
t) = Signedness -> Rank -> PrimType -> ValueType
ValueType Signedness
s Rank
r PrimType
t
    pSignedType :: ParsecT Void Text Identity (Signedness, PrimType)
pSignedType =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Text -> Parsec Void Text ()
keyword Text
"u8" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Signedness
Unsigned, IntType -> PrimType
IntType IntType
Int8),
          Text -> Parsec Void Text ()
keyword Text
"u16" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Signedness
Unsigned, IntType -> PrimType
IntType IntType
Int16),
          Text -> Parsec Void Text ()
keyword Text
"u32" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Signedness
Unsigned, IntType -> PrimType
IntType IntType
Int32),
          Text -> Parsec Void Text ()
keyword Text
"u64" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Signedness
Unsigned, IntType -> PrimType
IntType IntType
Int64),
          (Signedness
Signed,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text PrimType
pPrimType
        ]

pEntryPointType :: Parser EntryPointType
pEntryPointType :: Parser EntryPointType
pEntryPointType =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"opaque" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> EntryPointType
TypeOpaque forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text Text
pStringLiteral,
      ValueType -> EntryPointType
TypeTransparent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ValueType
pValueType
    ]

pEntry :: Parser EntryPoint
pEntry :: Parser EntryPoint
pEntry =
  forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$
    (,,)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Name
nameFromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Text
pStringLiteral)
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [EntryParam]
pEntryPointInputs
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [EntryResult]
pEntryPointResults
  where
    pEntryPointInputs :: Parser [EntryParam]
pEntryPointInputs = forall a. Parsec Void Text a -> Parsec Void Text a
braces (ParsecT Void Text Identity EntryParam
pEntryPointInput forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
    pEntryPointResults :: Parser [EntryResult]
pEntryPointResults = forall a. Parsec Void Text a -> Parsec Void Text a
braces (ParsecT Void Text Identity EntryResult
pEntryPointResult forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
    pEntryPointInput :: ParsecT Void Text Identity EntryParam
pEntryPointInput =
      Name -> Uniqueness -> EntryPointType -> EntryParam
EntryParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Uniqueness
pUniqueness forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EntryPointType
pEntryPointType
    pEntryPointResult :: ParsecT Void Text Identity EntryResult
pEntryPointResult =
      Uniqueness -> EntryPointType -> EntryResult
EntryResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Uniqueness
pUniqueness forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EntryPointType
pEntryPointType

pFunDef :: PR rep -> Parser (FunDef rep)
pFunDef :: forall {k} (rep :: k). PR rep -> Parser (FunDef rep)
pFunDef PR rep
pr = do
  Attrs
attrs <- Parser Attrs
pAttrs
  Maybe EntryPoint
entry <-
    forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ Text -> Parsec Void Text ()
keyword Text
"entry" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EntryPoint
pEntry,
        Text -> Parsec Void Text ()
keyword Text
"fun" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing
      ]
  Name
fname <- Parser Name
pName
  [Param (FParamInfo rep)]
fparams <- forall {k} (rep :: k). PR rep -> Parser [FParam rep]
pFParams PR rep
pr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon
  [RetType rep]
ret <- forall {k} (rep :: k). PR rep -> Parser [RetType rep]
pRetTypes PR rep
pr
  forall {k} (rep :: k).
Maybe EntryPoint
-> Attrs
-> Name
-> [RetType rep]
-> [FParam rep]
-> Body rep
-> FunDef rep
FunDef Maybe EntryPoint
entry Attrs
attrs Name
fname [RetType rep]
ret [Param (FParamInfo rep)]
fparams
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parsec Void Text ()
pEqual forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBody PR rep
pr))

pOpaqueType :: Parser (String, OpaqueType)
pOpaqueType :: Parser (String, OpaqueType)
pOpaqueType =
  (,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parsec Void Text ()
keyword Text
"type" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Text
pStringLiteral) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pEqual)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void Text Identity OpaqueType
pRecord, ParsecT Void Text Identity OpaqueType
pOpaque]
  where
    pFieldName :: Parser Name
pFieldName = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser Name
pName, String -> Name
nameFromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
pInt]
    pField :: ParsecT Void Text Identity (Name, EntryPointType)
pField = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pFieldName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EntryPointType
pEntryPointType
    pRecord :: ParsecT Void Text Identity OpaqueType
pRecord = Text -> Parsec Void Text ()
keyword Text
"record" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [(Name, EntryPointType)] -> OpaqueType
OpaqueRecord forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity (Name, EntryPointType)
pField)
    pOpaque :: ParsecT Void Text Identity OpaqueType
pOpaque = Text -> Parsec Void Text ()
keyword Text
"opaque" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [ValueType] -> OpaqueType
OpaqueType forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ValueType
pValueType)

pOpaqueTypes :: Parser OpaqueTypes
pOpaqueTypes :: Parser OpaqueTypes
pOpaqueTypes = Text -> Parsec Void Text ()
keyword Text
"types" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [(String, OpaqueType)] -> OpaqueTypes
OpaqueTypes forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser (String, OpaqueType)
pOpaqueType)

pProg :: PR rep -> Parser (Prog rep)
pProg :: forall {k} (rep :: k). PR rep -> Parser (Prog rep)
pProg PR rep
pr = forall {k} (rep :: k).
OpaqueTypes -> Stms rep -> [FunDef rep] -> Prog rep
Prog forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OpaqueTypes
pOpaqueTypes forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Stms rep)
pStms PR rep
pr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall {k} (rep :: k). PR rep -> Parser (FunDef rep)
pFunDef PR rep
pr)

pSOAC :: PR rep -> Parser (SOAC.SOAC rep)
pSOAC :: forall {k} (rep :: k). PR rep -> Parser (SOAC rep)
pSOAC PR rep
pr =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"map" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} {rep :: k}.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pMapForm,
      Text -> Parsec Void Text ()
keyword Text
"redomap" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} {rep :: k}.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pRedomapForm,
      Text -> Parsec Void Text ()
keyword Text
"scanomap" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} {rep :: k}.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pScanomapForm,
      Text -> Parsec Void Text ()
keyword Text
"screma" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} {rep :: k}.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pScremaForm,
      Text -> Parsec Void Text ()
keyword Text
"vjp" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SOAC rep)
pVJP,
      Text -> Parsec Void Text ()
keyword Text
"jvp" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SOAC rep)
pJVP,
      ParsecT Void Text Identity (SOAC rep)
pScatter,
      ParsecT Void Text Identity (SOAC rep)
pHist,
      ParsecT Void Text Identity (SOAC rep)
pStream
    ]
  where
    pScrema :: ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
p =
      forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$
        forall {k} (rep :: k).
SubExp -> [VName] -> ScremaForm rep -> SOAC rep
SOAC.Screma
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (ScremaForm rep)
p
    pScremaForm :: ParsecT Void Text Identity (ScremaForm rep)
pScremaForm =
      forall {k} (rep :: k).
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Scan rep)
pScan PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Reduce rep)
pReduce PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pRedomapForm :: ParsecT Void Text Identity (ScremaForm rep)
pRedomapForm =
      forall {k} (rep :: k).
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Reduce rep)
pReduce PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pScanomapForm :: ParsecT Void Text Identity (ScremaForm rep)
pScanomapForm =
      forall {k} (rep :: k).
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Scan rep)
pScan PR rep
pr forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pMapForm :: ParsecT Void Text Identity (ScremaForm rep)
pMapForm =
      forall {k} (rep :: k).
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pScatter :: ParsecT Void Text Identity (SOAC rep)
pScatter =
      Text -> Parsec Void Text ()
keyword Text
"scatter"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( forall {k} (rep :: k).
SubExp
-> [VName] -> Lambda rep -> [(Shape, Int, VName)] -> SOAC rep
SOAC.Scatter
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Shape, Int, VName)
pDest)
          )
      where
        pDest :: ParsecT Void Text Identity (Shape, Int, VName)
pDest =
          forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$ (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Int
pInt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName
    pHist :: ParsecT Void Text Identity (SOAC rep)
pHist =
      Text -> Parsec Void Text ()
keyword Text
"hist"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( forall {k} (rep :: k).
SubExp -> [VName] -> [HistOp rep] -> Lambda rep -> SOAC rep
SOAC.Hist
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (ParsecT Void Text Identity (HistOp rep)
pHistOp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
          )
      where
        pHistOp :: ParsecT Void Text Identity (HistOp rep)
pHistOp =
          forall {k} (rep :: k).
Shape -> SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep
SOAC.HistOp
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pStream :: ParsecT Void Text Identity (SOAC rep)
pStream = Text -> Parsec Void Text ()
keyword Text
"streamSeq" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SOAC rep)
pStreamSeq
    pStreamSeq :: ParsecT Void Text Identity (SOAC rep)
pStreamSeq =
      forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$
        forall {k} (rep :: k).
SubExp -> [VName] -> [SubExp] -> Lambda rep -> SOAC rep
SOAC.Stream
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pVJP :: ParsecT Void Text Identity (SOAC rep)
pVJP =
      forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$
        forall {k} (rep :: k).
Lambda rep -> [SubExp] -> [SubExp] -> SOAC rep
SOAC.VJP
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
    pJVP :: ParsecT Void Text Identity (SOAC rep)
pJVP =
      forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$
        forall {k} (rep :: k).
Lambda rep -> [SubExp] -> [SubExp] -> SOAC rep
SOAC.JVP
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pSizeClass :: Parser GPU.SizeClass
pSizeClass :: Parser SizeClass
pSizeClass =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"group_size" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SizeClass
GPU.SizeGroup,
      Text -> Parsec Void Text ()
keyword Text
"num_groups" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SizeClass
GPU.SizeNumGroups,
      Text -> Parsec Void Text ()
keyword Text
"num_groups" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SizeClass
GPU.SizeNumGroups,
      Text -> Parsec Void Text ()
keyword Text
"tile_size" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SizeClass
GPU.SizeTile,
      Text -> Parsec Void Text ()
keyword Text
"reg_tile_size" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SizeClass
GPU.SizeRegTile,
      Text -> Parsec Void Text ()
keyword Text
"local_memory" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SizeClass
GPU.SizeLocalMemory,
      Text -> Parsec Void Text ()
keyword Text
"threshold"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( forall a b c. (a -> b -> c) -> b -> a -> c
flip KernelPath -> Maybe Int64 -> SizeClass
GPU.SizeThreshold
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int64
pInt64, Parsec Void Text Text
"def" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing]
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity KernelPath
pKernelPath
          ),
      Text -> Parsec Void Text ()
keyword Text
"bespoke"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (Name -> Int64 -> SizeClass
GPU.SizeBespoke forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int64
pInt64)
    ]
  where
    pKernelPath :: ParsecT Void Text Identity KernelPath
pKernelPath = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity (Name, Bool)
pStep
    pStep :: ParsecT Void Text Identity (Name, Bool)
pStep =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"!" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (,) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Name
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False,
          (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        ]

pSizeOp :: Parser GPU.SizeOp
pSizeOp :: Parser SizeOp
pSizeOp =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"get_size"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (Name -> SizeClass -> SizeOp
GPU.GetSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SizeClass
pSizeClass),
      Text -> Parsec Void Text ()
keyword Text
"get_size_max"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (SizeClass -> SizeOp
GPU.GetSizeMax forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SizeClass
pSizeClass),
      Text -> Parsec Void Text ()
keyword Text
"cmp_size"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( forall a. Parsec Void Text a -> Parsec Void Text a
parens (Name -> SizeClass -> SubExp -> SizeOp
GPU.CmpSizeLe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SizeClass
pSizeClass)
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"<=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SubExp
pSubExp)
           ),
      Text -> Parsec Void Text ()
keyword Text
"calc_num_groups"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( SubExp -> Name -> SubExp -> SizeOp
GPU.CalcNumGroups
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Name
pName
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
          )
    ]

pSegSpace :: Parser SegOp.SegSpace
pSegSpace :: Parser SegSpace
pSegSpace =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip VName -> [(VName, SubExp)] -> SegSpace
SegOp.SegSpace
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ParsecT Void Text Identity (VName, SubExp)
pDim forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"~" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser VName
pVName)
  where
    pDim :: ParsecT Void Text Identity (VName, SubExp)
pDim = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"<" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp

pKernelResult :: Parser SegOp.KernelResult
pKernelResult :: Parser KernelResult
pKernelResult = do
  Certs
cs <- Parser Certs
pCerts
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"returns"
        forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ResultManifest -> Certs -> SubExp -> KernelResult
SegOp.Returns
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ Text -> Parsec Void Text ()
keyword Text
"(manifest)" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ResultManifest
SegOp.ResultNoSimplify,
            Text -> Parsec Void Text ()
keyword Text
"(private)" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ResultManifest
SegOp.ResultPrivate,
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultManifest
SegOp.ResultMaySimplify
          ]
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Certs
cs
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp,
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip (Certs -> Shape -> VName -> [(Slice SubExp, SubExp)] -> KernelResult
SegOp.WriteReturns Certs
cs)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Shape
pShape
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parsec Void Text ()
keyword Text
"with"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ParsecT Void Text Identity (Slice SubExp, SubExp)
pWrite forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma),
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parsec Void Text Text
"tile"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (Certs -> [(SubExp, SubExp)] -> VName -> KernelResult
SegOp.TileReturns Certs
cs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (SubExp, SubExp)
pTile forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName,
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parsec Void Text Text
"blkreg_tile"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (Certs -> [(SubExp, SubExp, SubExp)] -> VName -> KernelResult
SegOp.RegTileReturns Certs
cs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (SubExp, SubExp, SubExp)
pRegTile forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName
    ]
  where
    pTile :: ParsecT Void Text Identity (SubExp, SubExp)
pTile = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSlash forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
    pRegTile :: ParsecT Void Text Identity (SubExp, SubExp, SubExp)
pRegTile = do
      SubExp
dim <- Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSlash
      forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$ do
        SubExp
blk_tile <- Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pAsterisk
        SubExp
reg_tile <- Parser SubExp
pSubExp
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubExp
dim, SubExp
blk_tile, SubExp
reg_tile)
    pWrite :: ParsecT Void Text Identity (Slice SubExp, SubExp)
pWrite = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Slice SubExp)
pSlice forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pEqual forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp

pKernelBody :: PR rep -> Parser (SegOp.KernelBody rep)
pKernelBody :: forall {k} (rep :: k). PR rep -> Parser (KernelBody rep)
pKernelBody PR rep
pr =
  forall {k} (rep :: k).
BodyDec rep -> Stms rep -> [KernelResult] -> KernelBody rep
SegOp.KernelBody (forall {k} (rep :: k). PR rep -> BodyDec rep
pBodyDec PR rep
pr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k). PR rep -> Parser (Stms rep)
pStms PR rep
pr
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parsec Void Text ()
keyword Text
"return"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser KernelResult
pKernelResult forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)

pSegOp :: PR rep -> Parser lvl -> Parser (SegOp.SegOp lvl rep)
pSegOp :: forall {k} (rep :: k) lvl.
PR rep -> Parser lvl -> Parser (SegOp lvl rep)
pSegOp PR rep
pr Parser lvl
pLvl =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"segmap" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl rep)
pSegMap,
      Text -> Parsec Void Text ()
keyword Text
"segred" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl rep)
pSegRed,
      Text -> Parsec Void Text ()
keyword Text
"segscan" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl rep)
pSegScan,
      Text -> Parsec Void Text ()
keyword Text
"seghist" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl rep)
pSegHist
    ]
  where
    pSegMap :: ParsecT Void Text Identity (SegOp lvl rep)
pSegMap =
      forall {k} lvl (rep :: k).
lvl -> SegSpace -> [Type] -> KernelBody rep -> SegOp lvl rep
SegOp.SegMap
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser lvl
pLvl
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SegSpace
pSegSpace
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Type]
pTypes
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (KernelBody rep)
pKernelBody PR rep
pr)
    pSegOp' :: (lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b
f ParsecT Void Text Identity a
p =
      lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b
f
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser lvl
pLvl
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SegSpace
pSegSpace
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
parens (ParsecT Void Text Identity a
p forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pColon
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Type]
pTypes
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (KernelBody rep)
pKernelBody PR rep
pr)
    pSegBinOp :: ParsecT Void Text Identity (SegBinOp rep)
pSegBinOp = do
      [SubExp]
nes <- forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
      Shape
shape <- Parser Shape
pShape forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
      Commutativity
comm <- Parser Commutativity
pComm
      Lambda rep
lam <- forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
Commutativity -> Lambda rep -> [SubExp] -> Shape -> SegBinOp rep
SegOp.SegBinOp Commutativity
comm Lambda rep
lam [SubExp]
nes Shape
shape
    pHistOp :: ParsecT Void Text Identity (HistOp rep)
pHistOp =
      forall {k} (rep :: k).
Shape
-> SubExp
-> [VName]
-> [SubExp]
-> Shape
-> Lambda rep
-> HistOp rep
SegOp.HistOp
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser VName
pVName forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (Parser SubExp
pSubExp forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Shape
pShape
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (rep :: k). PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pSegRed :: ParsecT Void Text Identity (SegOp lvl rep)
pSegRed = forall {a} {b}.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' forall {k} lvl (rep :: k).
lvl
-> SegSpace
-> [SegBinOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
SegOp.SegRed ParsecT Void Text Identity (SegBinOp rep)
pSegBinOp
    pSegScan :: ParsecT Void Text Identity (SegOp lvl rep)
pSegScan = forall {a} {b}.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' forall {k} lvl (rep :: k).
lvl
-> SegSpace
-> [SegBinOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
SegOp.SegScan ParsecT Void Text Identity (SegBinOp rep)
pSegBinOp
    pSegHist :: ParsecT Void Text Identity (SegOp lvl rep)
pSegHist = forall {a} {b}.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' forall {k} lvl (rep :: k).
lvl
-> SegSpace
-> [HistOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
SegOp.SegHist ParsecT Void Text Identity (HistOp rep)
pHistOp

pSegLevel :: Parser GPU.SegLevel
pSegLevel :: Parser SegLevel
pSegLevel =
  forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ Text -> Parsec Void Text ()
keyword Text
"thread" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Count NumGroups SubExp
-> Count GroupSize SubExp -> SegVirt -> SegLevel
GPU.SegThread,
        Text -> Parsec Void Text ()
keyword Text
"group" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Count NumGroups SubExp
-> Count GroupSize SubExp -> SegVirt -> SegLevel
GPU.SegGroup
      ]
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parsec Void Text ()
pSemi forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"#groups=" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (u :: k) e. e -> Count u e
GPU.Count forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parsec Void Text ()
pSemi forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"groupsize=" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (u :: k) e. e -> Count u e
GPU.Count forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SubExp
pSubExp)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Parsec Void Text ()
pSemi
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
              [ Text -> Parsec Void Text ()
keyword Text
"full"
                  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SegSeqDims -> SegVirt
SegOp.SegNoVirtFull
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Int] -> SegSeqDims
SegOp.SegSeqDims forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text a
brackets (ParsecT Void Text Identity Int
pInt forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)),
                Text -> Parsec Void Text ()
keyword Text
"virtualise" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SegVirt
SegOp.SegVirt
              ],
          forall (f :: * -> *) a. Applicative f => a -> f a
pure SegVirt
SegOp.SegNoVirt
        ]

pHostOp :: PR rep -> Parser op -> Parser (GPU.HostOp rep op)
pHostOp :: forall {k} (rep :: k) op.
PR rep -> Parser op -> Parser (HostOp rep op)
pHostOp PR rep
pr Parser op
pOther =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall {k} (rep :: k) op. SegOp SegLevel rep -> HostOp rep op
GPU.SegOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (rep :: k) lvl.
PR rep -> Parser lvl -> Parser (SegOp lvl rep)
pSegOp PR rep
pr Parser SegLevel
pSegLevel,
      forall {k} (rep :: k) op. SizeOp -> HostOp rep op
GPU.SizeOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SizeOp
pSizeOp,
      forall {k} (rep :: k) op. op -> HostOp rep op
GPU.OtherOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser op
pOther,
      Text -> Parsec Void Text ()
keyword Text
"gpu" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall {k} (rep :: k) op. [Type] -> Body rep -> HostOp rep op
GPU.GPUBody forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parsec Void Text ()
pColon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Type]
pTypes) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parsec Void Text a -> Parsec Void Text a
braces (forall {k} (rep :: k). PR rep -> Parser (Body rep)
pBody PR rep
pr)
    ]

pMCOp :: PR rep -> Parser op -> Parser (MC.MCOp rep op)
pMCOp :: forall {k} (rep :: k) op.
PR rep -> Parser op -> Parser (MCOp rep op)
pMCOp PR rep
pr Parser op
pOther =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall {k} (rep :: k) op.
Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
MC.ParOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parsec Void Text ()
keyword Text
"par" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
braces ParsecT Void Text Identity (SegOp () rep)
pMCSegOp)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parsec Void Text ()
keyword Text
"seq" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
braces ParsecT Void Text Identity (SegOp () rep)
pMCSegOp),
      forall {k} (rep :: k) op.
Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
MC.ParOp forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (SegOp () rep)
pMCSegOp,
      forall {k} (rep :: k) op. op -> MCOp rep op
MC.OtherOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser op
pOther
    ]
  where
    pMCSegOp :: ParsecT Void Text Identity (SegOp () rep)
pMCSegOp = forall {k} (rep :: k) lvl.
PR rep -> Parser lvl -> Parser (SegOp lvl rep)
pSegOp PR rep
pr (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"()")

pIxFunBase :: Parser a -> Parser (IxFun.IxFun a)
pIxFunBase :: forall a. Parser a -> Parser (IxFun a)
pIxFunBase Parser a
pNum =
  forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ do
    [a]
base <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"base" forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
brackets (Parser a
pNum forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSemi
    Bool
ct <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"contiguous" forall a b. (a -> b) -> a -> b
$ Parser Bool
pBool forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSemi
    [LMAD a]
lmads <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"LMADs" forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
brackets (Parser (LMAD a)
pLMAD forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` Parsec Void Text ()
pComma)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall num. NonEmpty (LMAD num) -> Shape num -> Bool -> IxFun num
IxFun.IxFun (forall a. [a] -> NonEmpty a
NE.fromList [LMAD a]
lmads) [a]
base Bool
ct
  where
    pLab :: Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
s ParsecT Void Text Identity b
m = Text -> Parsec Void Text ()
keyword Text
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text ()
pColon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity b
m
    pMon :: ParsecT Void Text Identity Monotonicity
pMon =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Parsec Void Text Text
"Inc" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Monotonicity
IxFun.Inc,
          Parsec Void Text Text
"Dec" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Monotonicity
IxFun.Dec,
          Parsec Void Text Text
"Unknown" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Monotonicity
IxFun.Unknown
        ]
    pLMAD :: Parser (LMAD a)
pLMAD = forall a. Parsec Void Text a -> Parsec Void Text a
braces forall a b. (a -> b) -> a -> b
$ do
      a
offset <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"offset" Parser a
pNum forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSemi
      [a]
strides <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"strides" forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
brackets (Parser a
pNum forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSemi
      [a]
shape <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"shape" forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
brackets (Parser a
pNum forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSemi
      [Int]
perm <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"permutation" forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
brackets (ParsecT Void Text Identity Int
pInt forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pSemi
      [Monotonicity]
mon <- forall {b}.
Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
pLab Text
"monotonicity" forall a b. (a -> b) -> a -> b
$ forall a. Parsec Void Text a -> Parsec Void Text a
brackets (ParsecT Void Text Identity Monotonicity
pMon forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parsec Void Text ()
pComma)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall num. num -> [LMADDim num] -> LMAD num
IxFun.LMAD a
offset forall a b. (a -> b) -> a -> b
$ forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 forall num. num -> num -> Int -> Monotonicity -> LMADDim num
IxFun.LMADDim [a]
strides [a]
shape [Int]
perm [Monotonicity]
mon

pPrimExpLeaf :: Parser VName
pPrimExpLeaf :: Parser VName
pPrimExpLeaf = Parser VName
pVName

pExtPrimExpLeaf :: Parser (Ext VName)
pExtPrimExpLeaf :: Parser (Ext VName)
pExtPrimExpLeaf = forall a. Parser a -> Parser (Ext a)
pExt Parser VName
pVName

pIxFun :: Parser IxFun
pIxFun :: Parser IxFun
pIxFun = forall a. Parser a -> Parser (IxFun a)
pIxFunBase forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> TPrimExp Int64 v
isInt64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp PrimType
int64 Parser VName
pPrimExpLeaf

pExtIxFun :: Parser ExtIxFun
pExtIxFun :: Parser ExtIxFun
pExtIxFun = forall a. Parser a -> Parser (IxFun a)
pIxFunBase forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> TPrimExp Int64 v
isInt64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v.
PrimType -> Parsec Void Text v -> Parsec Void Text (PrimExp v)
pPrimExp PrimType
int64 Parser (Ext VName)
pExtPrimExpLeaf

pMemInfo :: Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo :: forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser d
pd Parser u
pu Parser ret
pret =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall d u ret. PrimType -> MemInfo d u ret
MemPrim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text PrimType
pPrimType,
      Text -> Parsec Void Text ()
keyword Text
"mem" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall d u ret. Space -> MemInfo d u ret
MemMem forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void Text Identity Space
pSpace, forall (f :: * -> *) a. Applicative f => a -> f a
pure Space
DefaultSpace],
      ParsecT Void Text Identity (MemInfo d u ret)
pArrayOrAcc
    ]
  where
    pArrayOrAcc :: ParsecT Void Text Identity (MemInfo d u ret)
pArrayOrAcc = do
      u
u <- Parser u
pu
      ShapeBase d
shape <- forall d. [d] -> ShapeBase d
Shape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall a. Parsec Void Text a -> Parsec Void Text a
brackets Parser d
pd)
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall {u} {d}.
u -> ShapeBase d -> ParsecT Void Text Identity (MemInfo d u ret)
pArray u
u ShapeBase d
shape, forall {a} {d} {ret}.
a -> ParsecT Void Text Identity (MemInfo d a ret)
pAcc u
u]
    pArray :: u -> ShapeBase d -> ParsecT Void Text Identity (MemInfo d u ret)
pArray u
u ShapeBase d
shape = do
      PrimType
pt <- Parsec Void Text PrimType
pPrimType
      forall d u ret.
PrimType -> ShapeBase d -> u -> ret -> MemInfo d u ret
MemArray PrimType
pt ShapeBase d
shape u
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ret
pret)
    pAcc :: a -> ParsecT Void Text Identity (MemInfo d a ret)
pAcc a
u =
      Text -> Parsec Void Text ()
keyword Text
"acc"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          ( forall d u ret. VName -> Shape -> [Type] -> u -> MemInfo d u ret
MemAcc
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Shape
pShape
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text ()
pComma
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Type]
pTypes
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
u
          )

pSpace :: Parser Space
pSpace :: ParsecT Void Text Identity Space
pSpace =
  forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"@"
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ String -> Space
Space forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName,
        [SubExp] -> PrimType -> Space
ScalarSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. ShapeBase d -> [d]
shapeDims forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Shape
pShape) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text PrimType
pPrimType
      ]

pMemBind :: Parser MemBind
pMemBind :: Parser MemBind
pMemBind = VName -> IxFun -> MemBind
ArrayIn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"->" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser IxFun
pIxFun

pMemReturn :: Parser MemReturn
pMemReturn :: Parser MemReturn
pMemReturn =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. Parsec Void Text a -> Parsec Void Text a
parens forall a b. (a -> b) -> a -> b
$ VName -> ExtIxFun -> MemReturn
ReturnsInBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"->" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExtIxFun
pExtIxFun,
      do
        Int
i <- Parsec Void Text Text
"?" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Int
pInt
        Space
space <- forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void Text Identity Space
pSpace, forall (f :: * -> *) a. Applicative f => a -> f a
pure Space
DefaultSpace] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parsec Void Text a -> Parsec Void Text a
lexeme Parsec Void Text Text
"->"
        Space -> Int -> ExtIxFun -> MemReturn
ReturnsNewBlock Space
space Int
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExtIxFun
pExtIxFun
    ]

pRetTypeMem :: Parser RetTypeMem
pRetTypeMem :: Parser RetTypeMem
pRetTypeMem = forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser ExtSize
pExtSize Parser Uniqueness
pUniqueness Parser MemReturn
pMemReturn

pBranchTypeMem :: Parser BranchTypeMem
pBranchTypeMem :: Parser BranchTypeMem
pBranchTypeMem = forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser ExtSize
pExtSize (forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness) Parser MemReturn
pMemReturn

pFParamMem :: Parser FParamMem
pFParamMem :: Parser FParamMem
pFParamMem = forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser SubExp
pSubExp Parser Uniqueness
pUniqueness Parser MemBind
pMemBind

pLParamMem :: Parser LParamMem
pLParamMem :: Parser LParamMem
pLParamMem = forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser SubExp
pSubExp (forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness) Parser MemBind
pMemBind

pLetDecMem :: Parser LetDecMem
pLetDecMem :: Parser LParamMem
pLetDecMem = forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser SubExp
pSubExp (forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness) Parser MemBind
pMemBind

pMemOp :: Parser inner -> Parser (MemOp inner)
pMemOp :: forall inner. Parser inner -> Parser (MemOp inner)
pMemOp Parser inner
pInner =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parsec Void Text ()
keyword Text
"alloc"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parsec Void Text a -> Parsec Void Text a
parens
          (forall inner. SubExp -> Space -> MemOp inner
Alloc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubExp
pSubExp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parsec Void Text ()
pComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Space
pSpace, forall (f :: * -> *) a. Applicative f => a -> f a
pure Space
DefaultSpace]),
      forall inner. inner -> MemOp inner
Inner forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser inner
pInner
    ]

prSOACS :: PR SOACS
prSOACS :: PR SOACS
prSOACS =
  forall {k} (rep :: k).
Parser (RetType rep)
-> Parser (BranchType rep)
-> Parser (FParamInfo rep)
-> Parser (LParamInfo rep)
-> Parser (LetDec rep)
-> Parser (Op rep)
-> BodyDec rep
-> ExpDec rep
-> PR rep
PR Parser DeclExtType
pDeclExtType Parser ExtType
pExtType Parser DeclType
pDeclType Parser Type
pType Parser Type
pType (forall {k} (rep :: k). PR rep -> Parser (SOAC rep)
pSOAC PR SOACS
prSOACS) () ()

prSeq :: PR Seq
prSeq :: PR Seq
prSeq =
  forall {k} (rep :: k).
Parser (RetType rep)
-> Parser (BranchType rep)
-> Parser (FParamInfo rep)
-> Parser (LParamInfo rep)
-> Parser (LetDec rep)
-> Parser (Op rep)
-> BodyDec rep
-> ExpDec rep
-> PR rep
PR Parser DeclExtType
pDeclExtType Parser ExtType
pExtType Parser DeclType
pDeclType Parser Type
pType Parser Type
pType forall (f :: * -> *) a. Alternative f => f a
empty () ()

prSeqMem :: PR SeqMem
prSeqMem :: PR SeqMem
prSeqMem =
  forall {k} (rep :: k).
Parser (RetType rep)
-> Parser (BranchType rep)
-> Parser (FParamInfo rep)
-> Parser (LParamInfo rep)
-> Parser (LetDec rep)
-> Parser (Op rep)
-> BodyDec rep
-> ExpDec rep
-> PR rep
PR Parser RetTypeMem
pRetTypeMem Parser BranchTypeMem
pBranchTypeMem Parser FParamMem
pFParamMem Parser LParamMem
pLParamMem Parser LParamMem
pLetDecMem forall {inner}. Parser (MemOp inner)
op () ()
  where
    op :: Parser (MemOp inner)
op = forall inner. Parser inner -> Parser (MemOp inner)
pMemOp forall (f :: * -> *) a. Alternative f => f a
empty

prGPU :: PR GPU
prGPU :: PR GPU
prGPU =
  forall {k} (rep :: k).
Parser (RetType rep)
-> Parser (BranchType rep)
-> Parser (FParamInfo rep)
-> Parser (LParamInfo rep)
-> Parser (LetDec rep)
-> Parser (Op rep)
-> BodyDec rep
-> ExpDec rep
-> PR rep
PR Parser DeclExtType
pDeclExtType Parser ExtType
pExtType Parser DeclType
pDeclType Parser Type
pType Parser Type
pType Parser (HostOp GPU (SOAC GPU))
op () ()
  where
    op :: Parser (HostOp GPU (SOAC GPU))
op = forall {k} (rep :: k) op.
PR rep -> Parser op -> Parser (HostOp rep op)
pHostOp PR GPU
prGPU (forall {k} (rep :: k). PR rep -> Parser (SOAC rep)
pSOAC PR GPU
prGPU)

prGPUMem :: PR GPUMem
prGPUMem :: PR GPUMem
prGPUMem =
  forall {k} (rep :: k).
Parser (RetType rep)
-> Parser (BranchType rep)
-> Parser (FParamInfo rep)
-> Parser (LParamInfo rep)
-> Parser (LetDec rep)
-> Parser (Op rep)
-> BodyDec rep
-> ExpDec rep
-> PR rep
PR Parser RetTypeMem
pRetTypeMem Parser BranchTypeMem
pBranchTypeMem Parser FParamMem
pFParamMem Parser LParamMem
pLParamMem Parser LParamMem
pLetDecMem forall {op}. Parser (MemOp (HostOp GPUMem op))
op () ()
  where
    op :: Parser (MemOp (HostOp GPUMem op))
op = forall inner. Parser inner -> Parser (MemOp inner)
pMemOp forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k) op.
PR rep -> Parser op -> Parser (HostOp rep op)
pHostOp PR GPUMem
prGPUMem forall (f :: * -> *) a. Alternative f => f a
empty

prMC :: PR MC
prMC :: PR MC
prMC =
  forall {k} (rep :: k).
Parser (RetType rep)
-> Parser (BranchType rep)
-> Parser (FParamInfo rep)
-> Parser (LParamInfo rep)
-> Parser (LetDec rep)
-> Parser (Op rep)
-> BodyDec rep
-> ExpDec rep
-> PR rep
PR Parser DeclExtType
pDeclExtType Parser ExtType
pExtType Parser DeclType
pDeclType Parser Type
pType Parser Type
pType Parser (MCOp MC (SOAC MC))
op () ()
  where
    op :: Parser (MCOp MC (SOAC MC))
op = forall {k} (rep :: k) op.
PR rep -> Parser op -> Parser (MCOp rep op)
pMCOp PR MC
prMC (forall {k} (rep :: k). PR rep -> Parser (SOAC rep)
pSOAC PR MC
prMC)

prMCMem :: PR MCMem
prMCMem :: PR MCMem
prMCMem =
  forall {k} (rep :: k).
Parser (RetType rep)
-> Parser (BranchType rep)
-> Parser (FParamInfo rep)
-> Parser (LParamInfo rep)
-> Parser (LetDec rep)
-> Parser (Op rep)
-> BodyDec rep
-> ExpDec rep
-> PR rep
PR Parser RetTypeMem
pRetTypeMem Parser BranchTypeMem
pBranchTypeMem Parser FParamMem
pFParamMem Parser LParamMem
pLParamMem Parser LParamMem
pLetDecMem forall {op}. Parser (MemOp (MCOp MCMem op))
op () ()
  where
    op :: Parser (MemOp (MCOp MCMem op))
op = forall inner. Parser inner -> Parser (MemOp inner)
pMemOp forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k) op.
PR rep -> Parser op -> Parser (MCOp rep op)
pMCOp PR MCMem
prMCMem forall (f :: * -> *) a. Alternative f => f a
empty

parseRep :: PR rep -> FilePath -> T.Text -> Either T.Text (Prog rep)
parseRep :: forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR rep
pr String
fname Text
s =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
    forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void Text ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {k} (rep :: k). PR rep -> Parser (Prog rep)
pProg PR rep
pr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
fname Text
s

parseSOACS :: FilePath -> T.Text -> Either T.Text (Prog SOACS)
parseSOACS :: String -> Text -> Either Text (Prog SOACS)
parseSOACS = forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR SOACS
prSOACS

parseSeq :: FilePath -> T.Text -> Either T.Text (Prog Seq)
parseSeq :: String -> Text -> Either Text (Prog Seq)
parseSeq = forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR Seq
prSeq

parseSeqMem :: FilePath -> T.Text -> Either T.Text (Prog SeqMem)
parseSeqMem :: String -> Text -> Either Text (Prog SeqMem)
parseSeqMem = forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR SeqMem
prSeqMem

parseGPU :: FilePath -> T.Text -> Either T.Text (Prog GPU)
parseGPU :: String -> Text -> Either Text (Prog GPU)
parseGPU = forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR GPU
prGPU

parseGPUMem :: FilePath -> T.Text -> Either T.Text (Prog GPUMem)
parseGPUMem :: String -> Text -> Either Text (Prog GPUMem)
parseGPUMem = forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR GPUMem
prGPUMem

parseMC :: FilePath -> T.Text -> Either T.Text (Prog MC)
parseMC :: String -> Text -> Either Text (Prog MC)
parseMC = forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR MC
prMC

parseMCMem :: FilePath -> T.Text -> Either T.Text (Prog MCMem)
parseMCMem :: String -> Text -> Either Text (Prog MCMem)
parseMCMem = forall {k} (rep :: k).
PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR MCMem
prMCMem