{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- | 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 (zipWith5)
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Void
import Futhark.Analysis.PrimExp.Parse
import Futhark.IR
import Futhark.IR.GPU (GPU)
import qualified Futhark.IR.GPU.Op as GPU
import Futhark.IR.GPUMem (GPUMem)
import Futhark.IR.MC (MC)
import qualified Futhark.IR.MC.Op as MC
import Futhark.IR.MCMem (MCMem)
import Futhark.IR.Mem
import qualified Futhark.IR.Mem.IxFun as IxFun
import Futhark.IR.Primitive.Parse
import Futhark.IR.SOACS (SOACS)
import qualified Futhark.IR.SOACS.SOAC as SOAC
import qualified Futhark.IR.SegOp as SegOp
import Futhark.IR.Seq (Seq)
import Futhark.IR.SeqMem (SeqMem)
import Futhark.Util.Pretty (prettyText)
import Text.Megaparsec
import Text.Megaparsec.Char hiding (space)
import qualified Text.Megaparsec.Char.Lexer as L

type Parser = Parsec Void T.Text

pStringLiteral :: Parser String
pStringLiteral :: Parser String
pStringLiteral = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ParsecT Void Text Identity Char -> Parser String -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char -> Parser String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"')

pName :: Parser Name
pName :: Parser Name
pName =
  Parser Name -> Parser Name
forall a. Parser a -> Parser a
lexeme (Parser Name -> Parser Name)
-> (Parser String -> Parser Name) -> Parser String -> Parser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Name) -> Parser String -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Name
nameFromString (Parser String -> Parser Name) -> Parser String -> Parser Name
forall a b. (a -> b) -> a -> b
$
    (:) (Char -> String -> String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlpha ParsecT Void Text Identity (String -> String)
-> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Char -> Parser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent)

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

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

pInt :: Parser Int
pInt :: ParsecT Void Text Identity Int
pInt = ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Int
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 = Parser Int64 -> Parser Int64
forall a. Parser a -> Parser a
lexeme Parser Int64
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 :: Parser a -> Parser a
braces = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"{") (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"}")
brackets :: Parser a -> Parser a
brackets = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"[") (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"]")
parens :: Parser a -> Parser a
parens = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"(") (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
")")

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

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

pTypeBase ::
  ArrayShape shape =>
  Parser shape ->
  Parser u ->
  Parser (TypeBase shape u)
pTypeBase :: 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
  TypeBase shape NoUniqueness -> shape -> u -> TypeBase shape u
forall shape u_unused u.
ArrayShape shape =>
TypeBase shape u_unused -> shape -> u -> TypeBase shape u
arrayOf (TypeBase shape NoUniqueness -> shape -> u -> TypeBase shape u)
-> ParsecT Void Text Identity (TypeBase shape NoUniqueness)
-> ParsecT Void Text Identity (shape -> u -> TypeBase shape u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (TypeBase shape NoUniqueness)
forall shape. Parser (TypeBase shape NoUniqueness)
pNonArray ParsecT Void Text Identity (shape -> u -> TypeBase shape u)
-> Parser shape
-> ParsecT Void Text Identity (u -> TypeBase shape u)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> shape -> Parser shape
forall (f :: * -> *) a. Applicative f => a -> f a
pure shape
shape ParsecT Void Text Identity (u -> TypeBase shape u)
-> Parser u -> Parser (TypeBase shape u)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u -> Parser u
forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u

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

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

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

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

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

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

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

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

pDeclBase ::
  Parser (TypeBase shape NoUniqueness) ->
  Parser (TypeBase shape Uniqueness)
pDeclBase :: Parser (TypeBase shape NoUniqueness)
-> Parser (TypeBase shape Uniqueness)
pDeclBase Parser (TypeBase shape NoUniqueness)
p = (TypeBase shape NoUniqueness
 -> Uniqueness -> TypeBase shape Uniqueness)
-> Uniqueness
-> TypeBase shape NoUniqueness
-> TypeBase shape Uniqueness
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeBase shape NoUniqueness
-> Uniqueness -> TypeBase shape Uniqueness
forall shape.
TypeBase shape NoUniqueness
-> Uniqueness -> TypeBase shape Uniqueness
toDecl (Uniqueness
 -> TypeBase shape NoUniqueness -> TypeBase shape Uniqueness)
-> Parser Uniqueness
-> ParsecT
     Void
     Text
     Identity
     (TypeBase shape NoUniqueness -> TypeBase shape Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Uniqueness
pUniqueness ParsecT
  Void
  Text
  Identity
  (TypeBase shape NoUniqueness -> TypeBase shape Uniqueness)
-> Parser (TypeBase shape NoUniqueness)
-> Parser (TypeBase shape Uniqueness)
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 = Parser Type -> Parser DeclType
forall shape.
Parser (TypeBase shape NoUniqueness)
-> Parser (TypeBase shape Uniqueness)
pDeclBase Parser Type
pType

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

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

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

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

pConvOp ::
  T.Text -> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp :: Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
s t1 -> t2 -> ConvOp
op Parser t1
t1 Parser t2
t2 =
  Text -> ParsecT Void Text Identity ()
keyword Text
s ParsecT Void Text Identity ()
-> (t1 -> SubExp -> t2 -> BasicOp)
-> ParsecT Void Text Identity (t1 -> SubExp -> t2 -> BasicOp)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> t1 -> SubExp -> t2 -> BasicOp
op' ParsecT Void Text Identity (t1 -> SubExp -> t2 -> BasicOp)
-> Parser t1
-> ParsecT Void Text Identity (SubExp -> t2 -> BasicOp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser t1
t1 ParsecT Void Text Identity (SubExp -> t2 -> BasicOp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (t2 -> BasicOp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity (t2 -> BasicOp)
-> Parser t2 -> Parser BasicOp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ParsecT Void Text Identity ()
keyword Text
"to" ParsecT Void Text Identity () -> Parser t2 -> Parser t2
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 = [Parser BasicOp] -> Parser BasicOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((BinOp -> Parser BasicOp) -> [BinOp] -> [Parser BasicOp]
forall a b. (a -> b) -> [a] -> [b]
map BinOp -> Parser BasicOp
p [BinOp]
allBinOps) Parser BasicOp -> String -> Parser BasicOp
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 -> ParsecT Void Text Identity ()
keyword (BinOp -> Text
forall a. Pretty a => a -> Text
prettyText BinOp
bop)
        ParsecT Void Text Identity () -> Parser BasicOp -> Parser BasicOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser BasicOp -> Parser BasicOp
forall a. Parser a -> Parser a
parens (BinOp -> SubExp -> SubExp -> BasicOp
BinOp BinOp
bop (SubExp -> SubExp -> BasicOp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (SubExp -> BasicOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity (SubExp -> BasicOp)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (SubExp -> BasicOp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity (SubExp -> BasicOp)
-> ParsecT Void Text Identity SubExp -> Parser BasicOp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp)

pCmpOp :: Parser BasicOp
pCmpOp :: Parser BasicOp
pCmpOp = [Parser BasicOp] -> Parser BasicOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((CmpOp -> Parser BasicOp) -> [CmpOp] -> [Parser BasicOp]
forall a b. (a -> b) -> [a] -> [b]
map CmpOp -> Parser BasicOp
p [CmpOp]
allCmpOps) Parser BasicOp -> String -> Parser BasicOp
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 -> ParsecT Void Text Identity ()
keyword (CmpOp -> Text
forall a. Pretty a => a -> Text
prettyText CmpOp
op)
        ParsecT Void Text Identity () -> Parser BasicOp -> Parser BasicOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser BasicOp -> Parser BasicOp
forall a. Parser a -> Parser a
parens (CmpOp -> SubExp -> SubExp -> BasicOp
CmpOp CmpOp
op (SubExp -> SubExp -> BasicOp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (SubExp -> BasicOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity (SubExp -> BasicOp)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (SubExp -> BasicOp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity (SubExp -> BasicOp)
-> ParsecT Void Text Identity SubExp -> Parser BasicOp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp)

pUnOp :: Parser BasicOp
pUnOp :: Parser BasicOp
pUnOp = [Parser BasicOp] -> Parser BasicOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((UnOp -> Parser BasicOp) -> [UnOp] -> [Parser BasicOp]
forall a b. (a -> b) -> [a] -> [b]
map UnOp -> Parser BasicOp
p [UnOp]
allUnOps) Parser BasicOp -> String -> Parser BasicOp
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 -> ParsecT Void Text Identity ()
keyword (UnOp -> Text
forall a. Pretty a => a -> Text
prettyText UnOp
bop) ParsecT Void Text Identity ()
-> (SubExp -> BasicOp)
-> ParsecT Void Text Identity (SubExp -> BasicOp)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UnOp -> SubExp -> BasicOp
UnOp UnOp
bop ParsecT Void Text Identity (SubExp -> BasicOp)
-> ParsecT Void Text Identity SubExp -> Parser BasicOp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp

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

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

pIndex :: Parser BasicOp
pIndex :: Parser BasicOp
pIndex = Parser BasicOp -> Parser BasicOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser BasicOp -> Parser BasicOp)
-> Parser BasicOp -> Parser BasicOp
forall a b. (a -> b) -> a -> b
$ VName -> Slice SubExp -> BasicOp
Index (VName -> Slice SubExp -> BasicOp)
-> Parser VName
-> ParsecT Void Text Identity (Slice SubExp -> BasicOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName ParsecT Void Text Identity (Slice SubExp -> BasicOp)
-> Parser (Slice SubExp) -> Parser BasicOp
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 =
  SubExp -> SubExp -> FlatDimIndex SubExp
forall d. d -> d -> FlatDimIndex d
FlatDimIndex (SubExp -> SubExp -> FlatDimIndex SubExp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (SubExp -> FlatDimIndex SubExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity (SubExp -> FlatDimIndex SubExp)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (SubExp -> FlatDimIndex SubExp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
":" ParsecT Void Text Identity (SubExp -> FlatDimIndex SubExp)
-> ParsecT Void Text Identity SubExp
-> Parser (FlatDimIndex SubExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp

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

pFlatIndex :: Parser BasicOp
pFlatIndex :: Parser BasicOp
pFlatIndex = Parser BasicOp -> Parser BasicOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser BasicOp -> Parser BasicOp)
-> Parser BasicOp -> Parser BasicOp
forall a b. (a -> b) -> a -> b
$ VName -> FlatSlice SubExp -> BasicOp
FlatIndex (VName -> FlatSlice SubExp -> BasicOp)
-> Parser VName
-> ParsecT Void Text Identity (FlatSlice SubExp -> BasicOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName ParsecT Void Text Identity (FlatSlice SubExp -> BasicOp)
-> Parser (FlatSlice SubExp) -> Parser BasicOp
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 =
  [Parser (ErrorMsgPart SubExp)] -> Parser (ErrorMsgPart SubExp)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ String -> ErrorMsgPart SubExp
forall a. String -> ErrorMsgPart a
ErrorString (String -> ErrorMsgPart SubExp)
-> Parser String -> Parser (ErrorMsgPart SubExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
pStringLiteral,
      (PrimType -> SubExp -> ErrorMsgPart SubExp)
-> SubExp -> PrimType -> ErrorMsgPart SubExp
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrimType -> SubExp -> ErrorMsgPart SubExp
forall a. PrimType -> a -> ErrorMsgPart a
ErrorVal (SubExp -> PrimType -> ErrorMsgPart SubExp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (PrimType -> ErrorMsgPart SubExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity SubExp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pColon) ParsecT Void Text Identity (PrimType -> ErrorMsgPart SubExp)
-> ParsecT Void Text Identity PrimType
-> Parser (ErrorMsgPart SubExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity PrimType
pPrimType
    ]

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

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

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

pShapeChange :: Parser (ShapeChange SubExp)
pShapeChange :: Parser (ShapeChange SubExp)
pShapeChange = Parser (ShapeChange SubExp) -> Parser (ShapeChange SubExp)
forall a. Parser a -> Parser a
parens (Parser (ShapeChange SubExp) -> Parser (ShapeChange SubExp))
-> Parser (ShapeChange SubExp) -> Parser (ShapeChange SubExp)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (DimChange SubExp)
pDimChange ParsecT Void Text Identity (DimChange SubExp)
-> ParsecT Void Text Identity () -> Parser (ShapeChange SubExp)
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma
  where
    pDimChange :: ParsecT Void Text Identity (DimChange SubExp)
pDimChange =
      [ParsecT Void Text Identity (DimChange SubExp)]
-> ParsecT Void Text Identity (DimChange SubExp)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text Identity Text
"~" ParsecT Void Text Identity Text
-> (SubExp -> DimChange SubExp)
-> ParsecT Void Text Identity (SubExp -> DimChange SubExp)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SubExp -> DimChange SubExp
forall d. d -> DimChange d
DimCoercion ParsecT Void Text Identity (SubExp -> DimChange SubExp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (DimChange SubExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp,
          SubExp -> DimChange SubExp
forall d. d -> DimChange d
DimNew (SubExp -> DimChange SubExp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (DimChange SubExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp
        ]

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

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

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

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

pComm :: Parser Commutativity
pComm :: Parser Commutativity
pComm =
  [Parser Commutativity] -> Parser Commutativity
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> ParsecT Void Text Identity ()
keyword Text
"commutative" ParsecT Void Text Identity ()
-> Commutativity -> Parser Commutativity
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Commutativity
Commutative,
      Commutativity -> Parser Commutativity
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
  { PR rep -> Parser (RetType rep)
pRetType :: Parser (RetType rep),
    PR rep -> Parser (BranchType rep)
pBranchType :: Parser (BranchType rep),
    PR rep -> Parser (FParamInfo rep)
pFParamInfo :: Parser (FParamInfo rep),
    PR rep -> Parser (LParamInfo rep)
pLParamInfo :: Parser (LParamInfo rep),
    PR rep -> Parser (LetDec rep)
pLetDec :: Parser (LetDec rep),
    PR rep -> Parser (Op rep)
pOp :: Parser (Op rep),
    PR rep -> BodyDec rep
pBodyDec :: BodyDec rep,
    PR rep -> ExpDec rep
pExpDec :: ExpDec rep
  }

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

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

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

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

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

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

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

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

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

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

pIf :: PR rep -> Parser (Exp rep)
pIf :: PR rep -> Parser (Exp rep)
pIf PR rep
pr =
  Text -> ParsecT Void Text Identity ()
keyword Text
"if" ParsecT Void Text Identity ()
-> (IfSort
    -> SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep)
-> ParsecT
     Void
     Text
     Identity
     (IfSort
      -> SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IfSort
-> SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep
forall rep.
IfSort
-> SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> ExpT rep
f ParsecT
  Void
  Text
  Identity
  (IfSort
   -> SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep)
-> ParsecT Void Text Identity IfSort
-> ParsecT
     Void
     Text
     Identity
     (SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity IfSort
pSort ParsecT
  Void
  Text
  Identity
  (SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     (BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp
    ParsecT
  Void
  Text
  Identity
  (BodyT rep -> BodyT rep -> [BranchType rep] -> Exp rep)
-> ParsecT Void Text Identity (BodyT rep)
-> ParsecT
     Void Text Identity (BodyT rep -> [BranchType rep] -> Exp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ParsecT Void Text Identity ()
keyword Text
"then" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (BodyT rep)
-> ParsecT Void Text Identity (BodyT rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (BodyT rep)
pBranchBody)
    ParsecT
  Void Text Identity (BodyT rep -> [BranchType rep] -> Exp rep)
-> ParsecT Void Text Identity (BodyT rep)
-> ParsecT Void Text Identity ([BranchType rep] -> Exp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ParsecT Void Text Identity ()
keyword Text
"else" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (BodyT rep)
-> ParsecT Void Text Identity (BodyT rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (BodyT rep)
pBranchBody)
    ParsecT Void Text Identity ([BranchType rep] -> Exp rep)
-> ParsecT Void Text Identity [BranchType rep] -> Parser (Exp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
":" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [BranchType rep]
-> ParsecT Void Text Identity [BranchType rep]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PR rep -> ParsecT Void Text Identity [BranchType rep]
forall rep. PR rep -> Parser [BranchType rep]
pBranchTypes PR rep
pr)
  where
    pSort :: ParsecT Void Text Identity IfSort
pSort =
      [ParsecT Void Text Identity IfSort]
-> ParsecT Void Text Identity IfSort
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"<fallback>" ParsecT Void Text Identity Text
-> IfSort -> ParsecT Void Text Identity IfSort
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IfSort
IfFallback,
          ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"<equiv>" ParsecT Void Text Identity Text
-> IfSort -> ParsecT Void Text Identity IfSort
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IfSort
IfEquiv,
          IfSort -> ParsecT Void Text Identity IfSort
forall (f :: * -> *) a. Applicative f => a -> f a
pure IfSort
IfNormal
        ]
    f :: IfSort
-> SubExp -> BodyT rep -> BodyT rep -> [BranchType rep] -> ExpT rep
f IfSort
sort SubExp
cond BodyT rep
tbranch BodyT rep
fbranch [BranchType rep]
t =
      SubExp
-> BodyT rep -> BodyT rep -> IfDec (BranchType rep) -> ExpT rep
forall rep.
SubExp
-> BodyT rep -> BodyT rep -> IfDec (BranchType rep) -> ExpT rep
If SubExp
cond BodyT rep
tbranch BodyT rep
fbranch (IfDec (BranchType rep) -> ExpT rep)
-> IfDec (BranchType rep) -> ExpT rep
forall a b. (a -> b) -> a -> b
$ [BranchType rep] -> IfSort -> IfDec (BranchType rep)
forall rt. [rt] -> IfSort -> IfDec rt
IfDec [BranchType rep]
t IfSort
sort
    pBranchBody :: ParsecT Void Text Identity (BodyT rep)
pBranchBody =
      [ParsecT Void Text Identity (BodyT rep)]
-> ParsecT Void Text Identity (BodyT rep)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text Identity (BodyT rep)
-> ParsecT Void Text Identity (BodyT rep)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (BodyT rep)
 -> ParsecT Void Text Identity (BodyT rep))
-> ParsecT Void Text Identity (BodyT rep)
-> ParsecT Void Text Identity (BodyT rep)
forall a b. (a -> b) -> a -> b
$ BodyDec rep -> Stms rep -> Result -> BodyT rep
forall rep. BodyDec rep -> Stms rep -> Result -> BodyT rep
Body (PR rep -> BodyDec rep
forall rep. PR rep -> BodyDec rep
pBodyDec PR rep
pr) Stms rep
forall a. Monoid a => a
mempty (Result -> BodyT rep)
-> Parser Result -> ParsecT Void Text Identity (BodyT rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Result
pResult,
          ParsecT Void Text Identity (BodyT rep)
-> ParsecT Void Text Identity (BodyT rep)
forall a. Parser a -> Parser a
braces (PR rep -> ParsecT Void Text Identity (BodyT rep)
forall rep. PR rep -> Parser (Body rep)
pBody PR rep
pr)
        ]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

pEntry :: Parser EntryPoint
pEntry :: Parser EntryPoint
pEntry =
  Parser EntryPoint -> Parser EntryPoint
forall a. Parser a -> Parser a
parens (Parser EntryPoint -> Parser EntryPoint)
-> Parser EntryPoint -> Parser EntryPoint
forall a b. (a -> b) -> a -> b
$
    (,,) (Name -> [EntryPointType] -> [EntryPointType] -> EntryPoint)
-> Parser Name
-> ParsecT
     Void
     Text
     Identity
     ([EntryPointType] -> [EntryPointType] -> EntryPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Name
nameFromString (String -> Name) -> Parser String -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
pStringLiteral)
      ParsecT
  Void
  Text
  Identity
  ([EntryPointType] -> [EntryPointType] -> EntryPoint)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([EntryPointType] -> [EntryPointType] -> EntryPoint)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma ParsecT
  Void
  Text
  Identity
  ([EntryPointType] -> [EntryPointType] -> EntryPoint)
-> ParsecT Void Text Identity [EntryPointType]
-> ParsecT Void Text Identity ([EntryPointType] -> EntryPoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [EntryPointType]
pEntryPointTypes
      ParsecT Void Text Identity ([EntryPointType] -> EntryPoint)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([EntryPointType] -> EntryPoint)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity ([EntryPointType] -> EntryPoint)
-> ParsecT Void Text Identity [EntryPointType] -> Parser EntryPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [EntryPointType]
pEntryPointTypes
  where
    pEntryPointTypes :: ParsecT Void Text Identity [EntryPointType]
pEntryPointTypes = ParsecT Void Text Identity [EntryPointType]
-> ParsecT Void Text Identity [EntryPointType]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity EntryPointType
pEntryPointType ParsecT Void Text Identity EntryPointType
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [EntryPointType]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma)
    pEntryPointType :: ParsecT Void Text Identity EntryPointType
pEntryPointType = do
      Uniqueness
u <- Parser Uniqueness
pUniqueness
      [ParsecT Void Text Identity EntryPointType]
-> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text Identity Text
"direct" ParsecT Void Text Identity Text
-> EntryPointType -> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Uniqueness -> EntryPointType
TypeDirect Uniqueness
u,
          ParsecT Void Text Identity Text
"unsigned" ParsecT Void Text Identity Text
-> EntryPointType -> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Uniqueness -> EntryPointType
TypeUnsigned Uniqueness
u,
          ParsecT Void Text Identity Text
"opaque" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity EntryPointType
-> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity EntryPointType
-> ParsecT Void Text Identity EntryPointType
forall a. Parser a -> Parser a
parens (Uniqueness -> String -> Int -> EntryPointType
TypeOpaque Uniqueness
u (String -> Int -> EntryPointType)
-> Parser String
-> ParsecT Void Text Identity (Int -> EntryPointType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
pStringLiteral ParsecT Void Text Identity (Int -> EntryPointType)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Int -> EntryPointType)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity (Int -> EntryPointType)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Int
pInt)
        ]

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

pProg :: PR rep -> Parser (Prog rep)
pProg :: PR rep -> Parser (Prog rep)
pProg PR rep
pr = Stms rep -> [FunDef rep] -> Prog rep
forall rep. Stms rep -> [FunDef rep] -> Prog rep
Prog (Stms rep -> [FunDef rep] -> Prog rep)
-> ParsecT Void Text Identity (Stms rep)
-> ParsecT Void Text Identity ([FunDef rep] -> Prog rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR rep -> ParsecT Void Text Identity (Stms rep)
forall rep. PR rep -> Parser (Stms rep)
pStms PR rep
pr ParsecT Void Text Identity ([FunDef rep] -> Prog rep)
-> ParsecT Void Text Identity [FunDef rep] -> Parser (Prog rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (FunDef rep)
-> ParsecT Void Text Identity [FunDef rep]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (PR rep -> ParsecT Void Text Identity (FunDef rep)
forall rep. PR rep -> Parser (FunDef rep)
pFunDef PR rep
pr)

pSOAC :: PR rep -> Parser (SOAC.SOAC rep)
pSOAC :: PR rep -> Parser (SOAC rep)
pSOAC PR rep
pr =
  [Parser (SOAC rep)] -> Parser (SOAC rep)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> ParsecT Void Text Identity ()
keyword Text
"map" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
forall rep.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pMapForm,
      Text -> ParsecT Void Text Identity ()
keyword Text
"redomap" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
forall rep.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pRedomapForm,
      Text -> ParsecT Void Text Identity ()
keyword Text
"scanomap" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
forall rep.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pScanomapForm,
      Text -> ParsecT Void Text Identity ()
keyword Text
"screma" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
forall rep.
ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
pScremaForm,
      Parser (SOAC rep)
pScatter,
      Parser (SOAC rep)
pHist,
      Parser (SOAC rep)
pStream
    ]
  where
    pScrema :: ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
pScrema ParsecT Void Text Identity (ScremaForm rep)
p =
      Parser (SOAC rep) -> Parser (SOAC rep)
forall a. Parser a -> Parser a
parens (Parser (SOAC rep) -> Parser (SOAC rep))
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall a b. (a -> b) -> a -> b
$
        SubExp -> [VName] -> ScremaForm rep -> SOAC rep
forall rep. SubExp -> [VName] -> ScremaForm rep -> SOAC rep
SOAC.Screma
          (SubExp -> [VName] -> ScremaForm rep -> SOAC rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void Text Identity ([VName] -> ScremaForm rep -> SOAC rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity ([VName] -> ScremaForm rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([VName] -> ScremaForm rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT Void Text Identity ([VName] -> ScremaForm rep -> SOAC rep)
-> Parser [VName]
-> ParsecT Void Text Identity (ScremaForm rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VName] -> Parser [VName]
forall a. Parser a -> Parser a
braces (Parser VName
pVName Parser VName -> ParsecT Void Text Identity () -> Parser [VName]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (ScremaForm rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (ScremaForm rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT Void Text Identity (ScremaForm rep -> SOAC rep)
-> ParsecT Void Text Identity (ScremaForm rep) -> Parser (SOAC rep)
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 =
      [Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
forall rep.
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm
        ([Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity [Scan rep]
-> ParsecT
     Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Scan rep]
-> ParsecT Void Text Identity [Scan rep]
forall a. Parser a -> Parser a
braces (PR rep -> Parser (Scan rep)
forall rep. PR rep -> Parser (Scan rep)
pScan PR rep
pr Parser (Scan rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Scan rep]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT
  Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT
  Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity [Reduce rep]
-> ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Reduce rep]
-> ParsecT Void Text Identity [Reduce rep]
forall a. Parser a -> Parser a
braces (PR rep -> Parser (Reduce rep)
forall rep. PR rep -> Parser (Reduce rep)
pReduce PR rep
pr Parser (Reduce rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Reduce rep]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT Void Text Identity (ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pRedomapForm :: ParsecT Void Text Identity (ScremaForm rep)
pRedomapForm =
      [Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
forall rep.
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm [Scan rep]
forall a. Monoid a => a
mempty
        ([Reduce rep] -> Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity [Reduce rep]
-> ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Reduce rep]
-> ParsecT Void Text Identity [Reduce rep]
forall a. Parser a -> Parser a
braces (PR rep -> Parser (Reduce rep)
forall rep. PR rep -> Parser (Reduce rep)
pReduce PR rep
pr Parser (Reduce rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Reduce rep]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT Void Text Identity (ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pScanomapForm :: ParsecT Void Text Identity (ScremaForm rep)
pScanomapForm =
      [Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
forall rep.
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm
        ([Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity [Scan rep]
-> ParsecT
     Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Scan rep]
-> ParsecT Void Text Identity [Scan rep]
forall a. Parser a -> Parser a
braces (PR rep -> Parser (Scan rep)
forall rep. PR rep -> Parser (Scan rep)
pScan PR rep
pr Parser (Scan rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Scan rep]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT
  Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT
  Void Text Identity ([Reduce rep] -> Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity [Reduce rep]
-> ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Reduce rep] -> ParsecT Void Text Identity [Reduce rep]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Reduce rep]
forall a. Monoid a => a
mempty
        ParsecT Void Text Identity (Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT Void Text Identity (ScremaForm rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pMapForm :: ParsecT Void Text Identity (ScremaForm rep)
pMapForm =
      [Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
forall rep.
[Scan rep] -> [Reduce rep] -> Lambda rep -> ScremaForm rep
SOAC.ScremaForm [Scan rep]
forall a. Monoid a => a
mempty [Reduce rep]
forall a. Monoid a => a
mempty (Lambda rep -> ScremaForm rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT Void Text Identity (ScremaForm rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pScatter :: Parser (SOAC rep)
pScatter =
      Text -> ParsecT Void Text Identity ()
keyword Text
"scatter"
        ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SOAC rep) -> Parser (SOAC rep)
forall a. Parser a -> Parser a
parens
          ( SubExp
-> Lambda rep -> [VName] -> [(Shape, Int, VName)] -> SOAC rep
forall rep.
SubExp
-> Lambda rep -> [VName] -> [(Shape, Int, VName)] -> SOAC rep
SOAC.Scatter (SubExp
 -> Lambda rep -> [VName] -> [(Shape, Int, VName)] -> SOAC rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     (Lambda rep -> [VName] -> [(Shape, Int, VName)] -> SOAC rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  (Lambda rep -> [VName] -> [(Shape, Int, VName)] -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (Lambda rep -> [VName] -> [(Shape, Int, VName)] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
              ParsecT
  Void
  Text
  Identity
  (Lambda rep -> [VName] -> [(Shape, Int, VName)] -> SOAC rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT
     Void Text Identity ([VName] -> [(Shape, Int, VName)] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr ParsecT
  Void Text Identity ([VName] -> [(Shape, Int, VName)] -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([VName] -> [(Shape, Int, VName)] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
              ParsecT
  Void Text Identity ([VName] -> [(Shape, Int, VName)] -> SOAC rep)
-> Parser [VName]
-> ParsecT Void Text Identity ([(Shape, Int, VName)] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VName] -> Parser [VName]
forall a. Parser a -> Parser a
braces (Parser VName
pVName Parser VName -> ParsecT Void Text Identity () -> Parser [VName]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma)
              ParsecT Void Text Identity ([(Shape, Int, VName)] -> SOAC rep)
-> ParsecT Void Text Identity [(Shape, Int, VName)]
-> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Shape, Int, VName)
-> ParsecT Void Text Identity [(Shape, Int, VName)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Shape, Int, VName)
-> ParsecT Void Text Identity (Shape, Int, VName)
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 =
          ParsecT Void Text Identity (Shape, Int, VName)
-> ParsecT Void Text Identity (Shape, Int, VName)
forall a. Parser a -> Parser a
parens (ParsecT Void Text Identity (Shape, Int, VName)
 -> ParsecT Void Text Identity (Shape, Int, VName))
-> ParsecT Void Text Identity (Shape, Int, VName)
-> ParsecT Void Text Identity (Shape, Int, VName)
forall a b. (a -> b) -> a -> b
$ (,,) (Shape -> Int -> VName -> (Shape, Int, VName))
-> ParsecT Void Text Identity Shape
-> ParsecT Void Text Identity (Int -> VName -> (Shape, Int, VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Shape
pShape ParsecT Void Text Identity (Int -> VName -> (Shape, Int, VName))
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Int -> VName -> (Shape, Int, VName))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity (Int -> VName -> (Shape, Int, VName))
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (VName -> (Shape, Int, VName))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Int
pInt ParsecT Void Text Identity (VName -> (Shape, Int, VName))
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (VName -> (Shape, Int, VName))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity (VName -> (Shape, Int, VName))
-> Parser VName -> ParsecT Void Text Identity (Shape, Int, VName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName
    pHist :: Parser (SOAC rep)
pHist =
      Text -> ParsecT Void Text Identity ()
keyword Text
"hist"
        ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SOAC rep) -> Parser (SOAC rep)
forall a. Parser a -> Parser a
parens
          ( SubExp -> [HistOp rep] -> Lambda rep -> [VName] -> SOAC rep
forall rep.
SubExp -> [HistOp rep] -> Lambda rep -> [VName] -> SOAC rep
SOAC.Hist
              (SubExp -> [HistOp rep] -> Lambda rep -> [VName] -> SOAC rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ([HistOp rep] -> Lambda rep -> [VName] -> SOAC rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  ([HistOp rep] -> Lambda rep -> [VName] -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([HistOp rep] -> Lambda rep -> [VName] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
              ParsecT
  Void
  Text
  Identity
  ([HistOp rep] -> Lambda rep -> [VName] -> SOAC rep)
-> ParsecT Void Text Identity [HistOp rep]
-> ParsecT Void Text Identity (Lambda rep -> [VName] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [HistOp rep]
-> ParsecT Void Text Identity [HistOp rep]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity (HistOp rep)
pHistOp ParsecT Void Text Identity (HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [HistOp rep]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (Lambda rep -> [VName] -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda rep -> [VName] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
              ParsecT Void Text Identity (Lambda rep -> [VName] -> SOAC rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT Void Text Identity ([VName] -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
              ParsecT Void Text Identity ([VName] -> SOAC rep)
-> Parser [VName] -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName -> Parser [VName]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity ()
pComma ParsecT Void Text Identity () -> Parser VName -> Parser VName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser VName
pVName)
          )
      where
        pHistOp :: ParsecT Void Text Identity (HistOp rep)
pHistOp =
          SubExp -> SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep
forall rep.
SubExp -> SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep
SOAC.HistOp
            (SubExp
 -> SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     (SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  (SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
            ParsecT
  Void
  Text
  Identity
  (SubExp -> [VName] -> [SubExp] -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> [SubExp] -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  ([VName] -> [SubExp] -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> [SubExp] -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
            ParsecT
  Void
  Text
  Identity
  ([VName] -> [SubExp] -> Lambda rep -> HistOp rep)
-> Parser [VName]
-> ParsecT
     Void Text Identity ([SubExp] -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VName] -> Parser [VName]
forall a. Parser a -> Parser a
braces (Parser VName
pVName Parser VName -> ParsecT Void Text Identity () -> Parser [VName]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity ([SubExp] -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([SubExp] -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
            ParsecT Void Text Identity ([SubExp] -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity [SubExp]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [SubExp]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
            ParsecT Void Text Identity (Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT Void Text Identity (HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pStream :: Parser (SOAC rep)
pStream =
      [Parser (SOAC rep)] -> Parser (SOAC rep)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Text -> ParsecT Void Text Identity ()
keyword Text
"streamParComm" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StreamOrd -> Commutativity -> Parser (SOAC rep)
pStreamPar StreamOrd
SOAC.InOrder Commutativity
Commutative,
          Text -> ParsecT Void Text Identity ()
keyword Text
"streamPar" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StreamOrd -> Commutativity -> Parser (SOAC rep)
pStreamPar StreamOrd
SOAC.InOrder Commutativity
Noncommutative,
          Text -> ParsecT Void Text Identity ()
keyword Text
"streamParPerComm" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StreamOrd -> Commutativity -> Parser (SOAC rep)
pStreamPar StreamOrd
SOAC.Disorder Commutativity
Commutative,
          Text -> ParsecT Void Text Identity ()
keyword Text
"streamParPer" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StreamOrd -> Commutativity -> Parser (SOAC rep)
pStreamPar StreamOrd
SOAC.Disorder Commutativity
Noncommutative,
          Text -> ParsecT Void Text Identity ()
keyword Text
"streamSeq" ParsecT Void Text Identity ()
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SOAC rep)
pStreamSeq
        ]
    pStreamPar :: StreamOrd -> Commutativity -> Parser (SOAC rep)
pStreamPar StreamOrd
order Commutativity
comm =
      Parser (SOAC rep) -> Parser (SOAC rep)
forall a. Parser a -> Parser a
parens (Parser (SOAC rep) -> Parser (SOAC rep))
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall a b. (a -> b) -> a -> b
$
        SubExp
-> [VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep
forall rep.
SubExp
-> [VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep
SOAC.Stream
          (SubExp
 -> [VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT
  Void
  Text
  Identity
  ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> Parser [VName]
-> ParsecT
     Void
     Text
     Identity
     (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VName] -> Parser [VName]
forall a. Parser a -> Parser a
braces (Parser VName
pVName Parser VName -> ParsecT Void Text Identity () -> Parser [VName]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT
  Void
  Text
  Identity
  (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT
  Void
  Text
  Identity
  (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity (StreamForm rep)
-> ParsecT Void Text Identity ([SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamOrd
-> Commutativity -> ParsecT Void Text Identity (StreamForm rep)
pParForm StreamOrd
order Commutativity
comm ParsecT Void Text Identity ([SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT Void Text Identity ([SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity [SubExp]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [SubExp]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT Void Text Identity (Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity (Lambda rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pParForm :: StreamOrd
-> Commutativity -> ParsecT Void Text Identity (StreamForm rep)
pParForm StreamOrd
order Commutativity
comm =
      StreamOrd -> Commutativity -> Lambda rep -> StreamForm rep
forall rep.
StreamOrd -> Commutativity -> Lambda rep -> StreamForm rep
SOAC.Parallel StreamOrd
order Commutativity
comm (Lambda rep -> StreamForm rep)
-> ParsecT Void Text Identity (Lambda rep)
-> ParsecT Void Text Identity (StreamForm rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pStreamSeq :: Parser (SOAC rep)
pStreamSeq =
      Parser (SOAC rep) -> Parser (SOAC rep)
forall a. Parser a -> Parser a
parens (Parser (SOAC rep) -> Parser (SOAC rep))
-> Parser (SOAC rep) -> Parser (SOAC rep)
forall a b. (a -> b) -> a -> b
$
        SubExp
-> [VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep
forall rep.
SubExp
-> [VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep
SOAC.Stream
          (SubExp
 -> [VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT
  Void
  Text
  Identity
  ([VName] -> StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> Parser [VName]
-> ParsecT
     Void
     Text
     Identity
     (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VName] -> Parser [VName]
forall a. Parser a -> Parser a
braces (Parser VName
pVName Parser VName -> ParsecT Void Text Identity () -> Parser [VName]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT
  Void
  Text
  Identity
  (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT
  Void
  Text
  Identity
  (StreamForm rep -> [SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity (StreamForm rep)
-> ParsecT Void Text Identity ([SubExp] -> Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamForm rep -> ParsecT Void Text Identity (StreamForm rep)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StreamForm rep
forall rep. StreamForm rep
SOAC.Sequential
          ParsecT Void Text Identity ([SubExp] -> Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity [SubExp]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [SubExp]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda rep -> SOAC rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
          ParsecT Void Text Identity (Lambda rep -> SOAC rep)
-> ParsecT Void Text Identity (Lambda rep) -> Parser (SOAC rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> ParsecT Void Text Identity (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr

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

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

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

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

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

pSegOp :: PR rep -> Parser lvl -> Parser (SegOp.SegOp lvl rep)
pSegOp :: PR rep -> Parser lvl -> Parser (SegOp lvl rep)
pSegOp PR rep
pr Parser lvl
pLvl =
  [Parser (SegOp lvl rep)] -> Parser (SegOp lvl rep)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> ParsecT Void Text Identity ()
keyword Text
"segmap" ParsecT Void Text Identity ()
-> Parser (SegOp lvl rep) -> Parser (SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SegOp lvl rep)
pSegMap,
      Text -> ParsecT Void Text Identity ()
keyword Text
"segred" ParsecT Void Text Identity ()
-> Parser (SegOp lvl rep) -> Parser (SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SegOp lvl rep)
pSegRed,
      Text -> ParsecT Void Text Identity ()
keyword Text
"segscan" ParsecT Void Text Identity ()
-> Parser (SegOp lvl rep) -> Parser (SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SegOp lvl rep)
pSegScan,
      Text -> ParsecT Void Text Identity ()
keyword Text
"seghist" ParsecT Void Text Identity ()
-> Parser (SegOp lvl rep) -> Parser (SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SegOp lvl rep)
pSegHist
    ]
  where
    pSegMap :: Parser (SegOp lvl rep)
pSegMap =
      lvl -> SegSpace -> [Type] -> KernelBody rep -> SegOp lvl rep
forall lvl rep.
lvl -> SegSpace -> [Type] -> KernelBody rep -> SegOp lvl rep
SegOp.SegMap
        (lvl -> SegSpace -> [Type] -> KernelBody rep -> SegOp lvl rep)
-> Parser lvl
-> ParsecT
     Void
     Text
     Identity
     (SegSpace -> [Type] -> KernelBody rep -> SegOp lvl rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser lvl
pLvl
        ParsecT
  Void
  Text
  Identity
  (SegSpace -> [Type] -> KernelBody rep -> SegOp lvl rep)
-> Parser SegSpace
-> ParsecT
     Void Text Identity ([Type] -> KernelBody rep -> SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SegSpace
pSegSpace ParsecT
  Void Text Identity ([Type] -> KernelBody rep -> SegOp lvl rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([Type] -> KernelBody rep -> SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pColon
        ParsecT
  Void Text Identity ([Type] -> KernelBody rep -> SegOp lvl rep)
-> ParsecT Void Text Identity [Type]
-> ParsecT Void Text Identity (KernelBody rep -> SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Type]
pTypes
        ParsecT Void Text Identity (KernelBody rep -> SegOp lvl rep)
-> ParsecT Void Text Identity (KernelBody rep)
-> Parser (SegOp lvl rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (KernelBody rep)
-> ParsecT Void Text Identity (KernelBody rep)
forall a. Parser a -> Parser a
braces (PR rep -> ParsecT Void Text Identity (KernelBody rep)
forall rep. 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 (lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> Parser lvl
-> ParsecT
     Void
     Text
     Identity
     (SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser lvl
pLvl
        ParsecT
  Void
  Text
  Identity
  (SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> Parser SegSpace
-> ParsecT
     Void Text Identity ([a] -> [Type] -> KernelBody rep -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SegSpace
pSegSpace
        ParsecT Void Text Identity ([a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity [a]
-> ParsecT Void Text Identity ([Type] -> KernelBody rep -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [a] -> ParsecT Void Text Identity [a]
forall a. Parser a -> Parser a
parens (ParsecT Void Text Identity a
p ParsecT Void Text Identity a
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity ([Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([Type] -> KernelBody rep -> b)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pColon
        ParsecT Void Text Identity ([Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity [Type]
-> ParsecT Void Text Identity (KernelBody rep -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Type]
pTypes
        ParsecT Void Text Identity (KernelBody rep -> b)
-> ParsecT Void Text Identity (KernelBody rep)
-> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (KernelBody rep)
-> ParsecT Void Text Identity (KernelBody rep)
forall a. Parser a -> Parser a
braces (PR rep -> ParsecT Void Text Identity (KernelBody rep)
forall rep. PR rep -> Parser (KernelBody rep)
pKernelBody PR rep
pr)
    pSegBinOp :: ParsecT Void Text Identity (SegBinOp rep)
pSegBinOp = do
      [SubExp]
nes <- ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity [SubExp]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [SubExp]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [SubExp]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
      Shape
shape <- ParsecT Void Text Identity Shape
pShape ParsecT Void Text Identity Shape
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Shape
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
      Commutativity
comm <- Parser Commutativity
pComm
      Lambda rep
lam <- PR rep -> Parser (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
      SegBinOp rep -> ParsecT Void Text Identity (SegBinOp rep)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SegBinOp rep -> ParsecT Void Text Identity (SegBinOp rep))
-> SegBinOp rep -> ParsecT Void Text Identity (SegBinOp rep)
forall a b. (a -> b) -> a -> b
$ Commutativity -> Lambda rep -> [SubExp] -> Shape -> SegBinOp rep
forall rep.
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 =
      SubExp
-> SubExp
-> [VName]
-> [SubExp]
-> Shape
-> Lambda rep
-> HistOp rep
forall rep.
SubExp
-> SubExp
-> [VName]
-> [SubExp]
-> Shape
-> Lambda rep
-> HistOp rep
SegOp.HistOp
        (SubExp
 -> SubExp
 -> [VName]
 -> [SubExp]
 -> Shape
 -> Lambda rep
 -> HistOp rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     (SubExp
      -> [VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  (SubExp
   -> [VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (SubExp
      -> [VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT
  Void
  Text
  Identity
  (SubExp
   -> [VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp ParsecT
  Void
  Text
  Identity
  ([VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT
  Void
  Text
  Identity
  ([VName] -> [SubExp] -> Shape -> Lambda rep -> HistOp rep)
-> Parser [VName]
-> ParsecT
     Void Text Identity ([SubExp] -> Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VName] -> Parser [VName]
forall a. Parser a -> Parser a
braces (Parser VName
pVName Parser VName -> ParsecT Void Text Identity () -> Parser [VName]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT
  Void Text Identity ([SubExp] -> Shape -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([SubExp] -> Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT
  Void Text Identity ([SubExp] -> Shape -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity [SubExp]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity SubExp
pSubExp ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [SubExp]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma) ParsecT Void Text Identity (Shape -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Shape -> Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT Void Text Identity (Shape -> Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity Shape
-> ParsecT Void Text Identity (Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Shape
pShape ParsecT Void Text Identity (Lambda rep -> HistOp rep)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda rep -> HistOp rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT Void Text Identity (Lambda rep -> HistOp rep)
-> Parser (Lambda rep) -> ParsecT Void Text Identity (HistOp rep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR rep -> Parser (Lambda rep)
forall rep. PR rep -> Parser (Lambda rep)
pLambda PR rep
pr
    pSegRed :: Parser (SegOp lvl rep)
pSegRed = (lvl
 -> SegSpace
 -> [SegBinOp rep]
 -> [Type]
 -> KernelBody rep
 -> SegOp lvl rep)
-> ParsecT Void Text Identity (SegBinOp rep)
-> Parser (SegOp lvl rep)
forall a b.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl
-> SegSpace
-> [SegBinOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
forall lvl rep.
lvl
-> SegSpace
-> [SegBinOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
SegOp.SegRed ParsecT Void Text Identity (SegBinOp rep)
pSegBinOp
    pSegScan :: Parser (SegOp lvl rep)
pSegScan = (lvl
 -> SegSpace
 -> [SegBinOp rep]
 -> [Type]
 -> KernelBody rep
 -> SegOp lvl rep)
-> ParsecT Void Text Identity (SegBinOp rep)
-> Parser (SegOp lvl rep)
forall a b.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl
-> SegSpace
-> [SegBinOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
forall lvl rep.
lvl
-> SegSpace
-> [SegBinOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
SegOp.SegScan ParsecT Void Text Identity (SegBinOp rep)
pSegBinOp
    pSegHist :: Parser (SegOp lvl rep)
pSegHist = (lvl
 -> SegSpace
 -> [HistOp rep]
 -> [Type]
 -> KernelBody rep
 -> SegOp lvl rep)
-> ParsecT Void Text Identity (HistOp rep)
-> Parser (SegOp lvl rep)
forall a b.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody rep -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl
-> SegSpace
-> [HistOp rep]
-> [Type]
-> KernelBody rep
-> SegOp lvl rep
forall lvl rep.
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 =
  Parser SegLevel -> Parser SegLevel
forall a. Parser a -> Parser a
parens (Parser SegLevel -> Parser SegLevel)
-> Parser SegLevel -> Parser SegLevel
forall a b. (a -> b) -> a -> b
$
    [ParsecT
   Void
   Text
   Identity
   (Count NumGroups SubExp
    -> Count GroupSize SubExp -> SegVirt -> SegLevel)]
-> ParsecT
     Void
     Text
     Identity
     (Count NumGroups SubExp
      -> Count GroupSize SubExp -> SegVirt -> SegLevel)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ Text -> ParsecT Void Text Identity ()
keyword Text
"thread" ParsecT Void Text Identity ()
-> (Count NumGroups SubExp
    -> Count GroupSize SubExp -> SegVirt -> SegLevel)
-> ParsecT
     Void
     Text
     Identity
     (Count NumGroups SubExp
      -> Count GroupSize SubExp -> SegVirt -> SegLevel)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Count NumGroups SubExp
-> Count GroupSize SubExp -> SegVirt -> SegLevel
GPU.SegThread,
        Text -> ParsecT Void Text Identity ()
keyword Text
"group" ParsecT Void Text Identity ()
-> (Count NumGroups SubExp
    -> Count GroupSize SubExp -> SegVirt -> SegLevel)
-> ParsecT
     Void
     Text
     Identity
     (Count NumGroups SubExp
      -> Count GroupSize SubExp -> SegVirt -> SegLevel)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Count NumGroups SubExp
-> Count GroupSize SubExp -> SegVirt -> SegLevel
GPU.SegGroup
      ]
      ParsecT
  Void
  Text
  Identity
  (Count NumGroups SubExp
   -> Count GroupSize SubExp -> SegVirt -> SegLevel)
-> ParsecT Void Text Identity (Count NumGroups SubExp)
-> ParsecT
     Void Text Identity (Count GroupSize SubExp -> SegVirt -> SegLevel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
pSemi ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"#groups=" ParsecT Void Text Identity Text
-> (SubExp -> Count NumGroups SubExp)
-> ParsecT Void Text Identity (SubExp -> Count NumGroups SubExp)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SubExp -> Count NumGroups SubExp
forall u e. e -> Count u e
GPU.Count ParsecT Void Text Identity (SubExp -> Count NumGroups SubExp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (Count NumGroups SubExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp)
      ParsecT
  Void Text Identity (Count GroupSize SubExp -> SegVirt -> SegLevel)
-> ParsecT Void Text Identity (Count GroupSize SubExp)
-> ParsecT Void Text Identity (SegVirt -> SegLevel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
pSemi ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
"groupsize=" ParsecT Void Text Identity Text
-> (SubExp -> Count GroupSize SubExp)
-> ParsecT Void Text Identity (SubExp -> Count GroupSize SubExp)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SubExp -> Count GroupSize SubExp
forall u e. e -> Count u e
GPU.Count ParsecT Void Text Identity (SubExp -> Count GroupSize SubExp)
-> ParsecT Void Text Identity SubExp
-> ParsecT Void Text Identity (Count GroupSize SubExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp)
      ParsecT Void Text Identity (SegVirt -> SegLevel)
-> ParsecT Void Text Identity SegVirt -> Parser SegLevel
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ParsecT Void Text Identity SegVirt]
-> ParsecT Void Text Identity SegVirt
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text Identity ()
pSemi
            ParsecT Void Text Identity ()
-> ParsecT Void Text Identity SegVirt
-> ParsecT Void Text Identity SegVirt
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ParsecT Void Text Identity SegVirt]
-> ParsecT Void Text Identity SegVirt
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
              [ Text -> ParsecT Void Text Identity ()
keyword Text
"full" ParsecT Void Text Identity ()
-> SegVirt -> ParsecT Void Text Identity SegVirt
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SegVirt
SegOp.SegNoVirtFull,
                Text -> ParsecT Void Text Identity ()
keyword Text
"virtualise" ParsecT Void Text Identity ()
-> SegVirt -> ParsecT Void Text Identity SegVirt
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SegVirt
SegOp.SegVirt
              ],
          SegVirt -> ParsecT Void Text Identity SegVirt
forall (f :: * -> *) a. Applicative f => a -> f a
pure SegVirt
SegOp.SegNoVirt
        ]

pHostOp :: PR rep -> Parser op -> Parser (GPU.HostOp rep op)
pHostOp :: PR rep -> Parser op -> Parser (HostOp rep op)
pHostOp PR rep
pr Parser op
pOther =
  [Parser (HostOp rep op)] -> Parser (HostOp rep op)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ SegOp SegLevel rep -> HostOp rep op
forall rep op. SegOp SegLevel rep -> HostOp rep op
GPU.SegOp (SegOp SegLevel rep -> HostOp rep op)
-> ParsecT Void Text Identity (SegOp SegLevel rep)
-> Parser (HostOp rep op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR rep
-> Parser SegLevel
-> ParsecT Void Text Identity (SegOp SegLevel rep)
forall rep lvl. PR rep -> Parser lvl -> Parser (SegOp lvl rep)
pSegOp PR rep
pr Parser SegLevel
pSegLevel,
      SizeOp -> HostOp rep op
forall rep op. SizeOp -> HostOp rep op
GPU.SizeOp (SizeOp -> HostOp rep op)
-> Parser SizeOp -> Parser (HostOp rep op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SizeOp
pSizeOp,
      op -> HostOp rep op
forall rep op. op -> HostOp rep op
GPU.OtherOp (op -> HostOp rep op) -> Parser op -> Parser (HostOp rep op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser op
pOther
    ]

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

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

pPrimExpLeaf :: Parser (VName, PrimType)
pPrimExpLeaf :: Parser (VName, PrimType)
pPrimExpLeaf = (,PrimType
int64) (VName -> (VName, PrimType))
-> Parser VName -> Parser (VName, PrimType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName

pExtPrimExpLeaf :: Parser (Ext VName, PrimType)
pExtPrimExpLeaf :: Parser (Ext VName, PrimType)
pExtPrimExpLeaf = (,PrimType
int64) (Ext VName -> (Ext VName, PrimType))
-> ParsecT Void Text Identity (Ext VName)
-> Parser (Ext VName, PrimType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName -> ParsecT Void Text Identity (Ext VName)
forall a. Parser a -> Parser (Ext a)
pExt Parser VName
pVName

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

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

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

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

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

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

pRetTypeMem :: Parser RetTypeMem
pRetTypeMem :: Parser RetTypeMem
pRetTypeMem = Parser ExtSize
-> Parser Uniqueness -> Parser MemReturn -> Parser RetTypeMem
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 = Parser ExtSize
-> ParsecT Void Text Identity NoUniqueness
-> Parser MemReturn
-> Parser BranchTypeMem
forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser ExtSize
pExtSize (NoUniqueness -> ParsecT Void Text Identity NoUniqueness
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness) Parser MemReturn
pMemReturn

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

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

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

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

prSOACS :: PR SOACS
prSOACS :: PR SOACS
prSOACS =
  Parser (RetType SOACS)
-> Parser (BranchType SOACS)
-> Parser (FParamInfo SOACS)
-> Parser (LParamInfo SOACS)
-> Parser (LetDec SOACS)
-> Parser (Op SOACS)
-> BodyDec SOACS
-> ExpDec SOACS
-> PR SOACS
forall rep.
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
Parser (RetType SOACS)
pDeclExtType Parser ExtType
Parser (BranchType SOACS)
pExtType Parser DeclType
Parser (FParamInfo SOACS)
pDeclType Parser Type
Parser (LParamInfo SOACS)
pType Parser Type
Parser (LetDec SOACS)
pType (PR SOACS -> Parser (SOAC SOACS)
forall rep. PR rep -> Parser (SOAC rep)
pSOAC PR SOACS
prSOACS) () ()

prSeq :: PR Seq
prSeq :: PR Seq
prSeq =
  Parser (RetType Seq)
-> Parser (BranchType Seq)
-> Parser (FParamInfo Seq)
-> Parser (LParamInfo Seq)
-> Parser (LetDec Seq)
-> Parser (Op Seq)
-> BodyDec Seq
-> ExpDec Seq
-> PR Seq
forall rep.
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
Parser (RetType Seq)
pDeclExtType Parser ExtType
Parser (BranchType Seq)
pExtType Parser DeclType
Parser (FParamInfo Seq)
pDeclType Parser Type
Parser (LParamInfo Seq)
pType Parser Type
Parser (LetDec Seq)
pType Parser (Op Seq)
forall (f :: * -> *) a. Alternative f => f a
empty () ()

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

prGPU :: PR GPU
prGPU :: PR GPU
prGPU =
  Parser (RetType GPU)
-> Parser (BranchType GPU)
-> Parser (FParamInfo GPU)
-> Parser (LParamInfo GPU)
-> Parser (LetDec GPU)
-> Parser (Op GPU)
-> BodyDec GPU
-> ExpDec GPU
-> PR GPU
forall rep.
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
Parser (RetType GPU)
pDeclExtType Parser ExtType
Parser (BranchType GPU)
pExtType Parser DeclType
Parser (FParamInfo GPU)
pDeclType Parser Type
Parser (LParamInfo GPU)
pType Parser Type
Parser (LetDec GPU)
pType Parser (Op GPU)
Parser (HostOp GPU (SOAC GPU))
op () ()
  where
    op :: Parser (HostOp GPU (SOAC GPU))
op = PR GPU -> Parser (SOAC GPU) -> Parser (HostOp GPU (SOAC GPU))
forall rep op. PR rep -> Parser op -> Parser (HostOp rep op)
pHostOp PR GPU
prGPU (PR GPU -> Parser (SOAC GPU)
forall rep. PR rep -> Parser (SOAC rep)
pSOAC PR GPU
prGPU)

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

prMC :: PR MC
prMC :: PR MC
prMC =
  Parser (RetType MC)
-> Parser (BranchType MC)
-> Parser (FParamInfo MC)
-> Parser (LParamInfo MC)
-> Parser (LetDec MC)
-> Parser (Op MC)
-> BodyDec MC
-> ExpDec MC
-> PR MC
forall rep.
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
Parser (RetType MC)
pDeclExtType Parser ExtType
Parser (BranchType MC)
pExtType Parser DeclType
Parser (FParamInfo MC)
pDeclType Parser Type
Parser (LParamInfo MC)
pType Parser Type
Parser (LetDec MC)
pType Parser (Op MC)
Parser (MCOp MC (SOAC MC))
op () ()
  where
    op :: Parser (MCOp MC (SOAC MC))
op = PR MC -> Parser (SOAC MC) -> Parser (MCOp MC (SOAC MC))
forall rep op. PR rep -> Parser op -> Parser (MCOp rep op)
pMCOp PR MC
prMC (PR MC -> Parser (SOAC MC)
forall rep. PR rep -> Parser (SOAC rep)
pSOAC PR MC
prMC)

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

parseRep :: PR rep -> FilePath -> T.Text -> Either T.Text (Prog rep)
parseRep :: PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR rep
pr String
fname Text
s =
  (ParseErrorBundle Text Void -> Either Text (Prog rep))
-> (Prog rep -> Either Text (Prog rep))
-> Either (ParseErrorBundle Text Void) (Prog rep)
-> Either Text (Prog rep)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Either Text (Prog rep)
forall a b. a -> Either a b
Left (Text -> Either Text (Prog rep))
-> (ParseErrorBundle Text Void -> Text)
-> ParseErrorBundle Text Void
-> Either Text (Prog rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) Prog rep -> Either Text (Prog rep)
forall a b. b -> Either a b
Right (Either (ParseErrorBundle Text Void) (Prog rep)
 -> Either Text (Prog rep))
-> Either (ParseErrorBundle Text Void) (Prog rep)
-> Either Text (Prog rep)
forall a b. (a -> b) -> a -> b
$
    Parsec Void Text (Prog rep)
-> String -> Text -> Either (ParseErrorBundle Text Void) (Prog rep)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void Text Identity ()
whitespace ParsecT Void Text Identity ()
-> Parsec Void Text (Prog rep) -> Parsec Void Text (Prog rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PR rep -> Parsec Void Text (Prog rep)
forall rep. PR rep -> Parser (Prog rep)
pProg PR rep
pr Parsec Void Text (Prog rep)
-> ParsecT Void Text Identity () -> Parsec Void Text (Prog rep)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
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 = PR SOACS -> String -> Text -> Either Text (Prog SOACS)
forall rep. 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 = PR Seq -> String -> Text -> Either Text (Prog Seq)
forall rep. 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 = PR SeqMem -> String -> Text -> Either Text (Prog SeqMem)
forall rep. 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 = PR GPU -> String -> Text -> Either Text (Prog GPU)
forall rep. 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 = PR GPUMem -> String -> Text -> Either Text (Prog GPUMem)
forall rep. 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 = PR MC -> String -> Text -> Either Text (Prog MC)
forall rep. 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 = PR MCMem -> String -> Text -> Either Text (Prog MCMem)
forall rep. PR rep -> String -> Text -> Either Text (Prog rep)
parseRep PR MCMem
prMCMem