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

-- | Parser for the Futhark core language.
module Futhark.IR.Parse
  ( parseSOACS,
    parseKernels,
    parseKernelsMem,
    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.Kernels (Kernels)
import qualified Futhark.IR.Kernels.Kernel as Kernel
import Futhark.IR.KernelsMem (KernelsMem)
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 =
      Parser Text
"_" Parser 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 :: forall a. Parser a -> Parser a
braces = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"{") (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"}")
brackets :: forall a. Parser a -> Parser a
brackets = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"[") (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"]")
parens :: forall a. Parser a -> Parser a
parens = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"(") (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
")")

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

pNonArray :: Parser (TypeBase shape NoUniqueness)
pNonArray :: forall shape. Parser (TypeBase shape NoUniqueness)
pNonArray =
  [ParsecT Void Text Identity (TypeBase shape NoUniqueness)]
-> ParsecT Void Text Identity (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
-> ParsecT Void Text Identity (TypeBase shape NoUniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity PrimType
pPrimType,
      Parser Text
"acc"
        Parser Text
-> ParsecT Void Text Identity (TypeBase shape NoUniqueness)
-> ParsecT Void Text Identity (TypeBase shape NoUniqueness)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (TypeBase shape NoUniqueness)
-> ParsecT Void Text Identity (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
-> ParsecT Void Text Identity (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 :: forall shape u.
ArrayShape shape =>
Parser shape -> Parser u -> Parser (TypeBase shape u)
pTypeBase Parser shape
ps Parser u
pu = do
  u
u <- Parser u
pu
  shape
shape <- Parser shape
ps
  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 :: forall a. Parser a -> Parser (Ext a)
pExt Parser a
p =
  [ParsecT Void Text Identity (Ext a)]
-> ParsecT Void Text Identity (Ext a)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text Identity (Ext a)
-> ParsecT Void Text Identity (Ext a)
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity (Ext a)
 -> ParsecT Void Text Identity (Ext a))
-> ParsecT Void Text Identity (Ext a)
-> ParsecT Void Text Identity (Ext a)
forall a b. (a -> b) -> a -> b
$ Parser Text
"?" Parser 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
-> ParsecT Void Text Identity (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 -> ParsecT Void Text Identity (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 :: forall shape.
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)
-> ParsecT Void Text Identity (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)

pPatternLike :: Parser a -> Parser ([a], [a])
pPatternLike :: forall a. Parser a -> Parser ([a], [a])
pPatternLike Parser a
p = Parser ([a], [a]) -> Parser ([a], [a])
forall a. Parser a -> Parser a
braces (Parser ([a], [a]) -> Parser ([a], [a]))
-> Parser ([a], [a]) -> Parser ([a], [a])
forall a b. (a -> b) -> a -> b
$ do
  [a]
xs <- Parser a
p 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
  [Parser ([a], [a])] -> Parser ([a], [a])
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text Identity ()
pSemi ParsecT Void Text Identity ()
-> Parser ([a], [a]) -> Parser ([a], [a])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (([a]
xs,) ([a] -> ([a], [a]))
-> ParsecT Void Text Identity [a] -> Parser ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser a
p 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)),
      ([a], [a]) -> Parser ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
forall a. Monoid a => a
mempty, [a]
xs)
    ]

pConvOp ::
  T.Text -> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp :: forall t1 t2.
Text
-> (t1 -> t2 -> ConvOp) -> Parser t1 -> Parser t2 -> Parser BasicOp
pConvOp Text
s t1 -> t2 -> ConvOp
op Parser t1
t1 Parser t2
t2 =
  Text -> 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)
-> Parser Text
-> ParsecT Void Text Identity (SubExp -> SubExp -> DimIndex SubExp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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)
-> Parser Text
-> ParsecT Void Text Identity (SubExp -> DimIndex SubExp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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 = Parser (Slice SubExp) -> Parser (Slice SubExp)
forall a. Parser a -> Parser a
brackets (Parser (Slice SubExp) -> Parser (Slice SubExp))
-> Parser (Slice SubExp) -> Parser (Slice SubExp)
forall a b. (a -> b) -> a -> b
$ Parser (DimIndex SubExp)
pDimIndex Parser (DimIndex SubExp)
-> ParsecT Void Text Identity () -> Parser (Slice 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

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,
      ((SubExp -> ErrorMsgPart SubExp) -> SubExp -> ErrorMsgPart SubExp)
-> SubExp -> (SubExp -> ErrorMsgPart SubExp) -> ErrorMsgPart SubExp
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SubExp -> ErrorMsgPart SubExp) -> SubExp -> ErrorMsgPart SubExp
forall a b. (a -> b) -> a -> b
($) (SubExp -> (SubExp -> ErrorMsgPart SubExp) -> ErrorMsgPart SubExp)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ((SubExp -> ErrorMsgPart SubExp) -> 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
  ((SubExp -> ErrorMsgPart SubExp) -> ErrorMsgPart SubExp)
-> ParsecT Void Text Identity (SubExp -> ErrorMsgPart SubExp)
-> Parser (ErrorMsgPart SubExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ParsecT Void Text Identity (SubExp -> ErrorMsgPart SubExp)]
-> ParsecT Void Text Identity (SubExp -> ErrorMsgPart SubExp)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ Text -> ParsecT Void Text Identity ()
keyword Text
"i32" ParsecT Void Text Identity ()
-> (SubExp -> ErrorMsgPart SubExp)
-> ParsecT Void Text Identity (SubExp -> ErrorMsgPart SubExp)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SubExp -> ErrorMsgPart SubExp
forall a. a -> ErrorMsgPart a
ErrorInt32,
            Text -> ParsecT Void Text Identity ()
keyword Text
"i64" ParsecT Void Text Identity ()
-> (SubExp -> ErrorMsgPart SubExp)
-> ParsecT Void Text Identity (SubExp -> ErrorMsgPart SubExp)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SubExp -> ErrorMsgPart SubExp
forall a. a -> ErrorMsgPart a
ErrorInt64
          ]
    ]

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
        [ Parser Text
"~" Parser 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
$> SubExp -> BasicOp
Opaque 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
"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 <- Parser Text
"@" Parser 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
$
        VName -> Slice SubExp -> SubExp -> BasicOp
Update
          (VName -> Slice SubExp -> SubExp -> BasicOp)
-> Parser VName
-> ParsecT Void Text Identity (Slice SubExp -> SubExp -> BasicOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName ParsecT Void Text Identity (Slice SubExp -> SubExp -> BasicOp)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (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 (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)
-> Parser Text -> ParsecT Void Text Identity (SubExp -> BasicOp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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,
      [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
<*> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
"[]" Parser 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
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' = Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"#[" Parser Text -> Parser Attr -> Parser Attr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Attr
pAttr Parser Attr -> Parser Text -> Parser Attr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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 lore = PR
  { forall lore. PR lore -> Parser (RetType lore)
pRetType :: Parser (RetType lore),
    forall lore. PR lore -> Parser (BranchType lore)
pBranchType :: Parser (BranchType lore),
    forall lore. PR lore -> Parser (FParamInfo lore)
pFParamInfo :: Parser (FParamInfo lore),
    forall lore. PR lore -> Parser (LParamInfo lore)
pLParamInfo :: Parser (LParamInfo lore),
    forall lore. PR lore -> Parser (LetDec lore)
pLetDec :: Parser (LetDec lore),
    forall lore. PR lore -> Parser (Op lore)
pOp :: Parser (Op lore),
    forall lore. PR lore -> BodyDec lore
pBodyDec :: BodyDec lore,
    forall lore. PR lore -> ExpDec lore
pExpDec :: ExpDec lore
  }

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

pBranchTypes :: PR lore -> Parser [BranchType lore]
pBranchTypes :: forall lore. PR lore -> Parser [BranchType lore]
pBranchTypes PR lore
pr = Parser [BranchType lore] -> Parser [BranchType lore]
forall a. Parser a -> Parser a
braces (Parser [BranchType lore] -> Parser [BranchType lore])
-> Parser [BranchType lore] -> Parser [BranchType lore]
forall a b. (a -> b) -> a -> b
$ PR lore -> Parser (BranchType lore)
forall lore. PR lore -> Parser (BranchType lore)
pBranchType PR lore
pr Parser (BranchType lore)
-> ParsecT Void Text Identity () -> Parser [BranchType lore]
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 :: forall t. 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 -> ParsecT Void Text Identity (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 lore -> Parser (FParam lore)
pFParam :: forall lore. PR lore -> Parser (FParam lore)
pFParam = Parser (FParamInfo lore) -> Parser (Param (FParamInfo lore))
forall t. Parser t -> Parser (Param t)
pParam (Parser (FParamInfo lore) -> Parser (Param (FParamInfo lore)))
-> (PR lore -> Parser (FParamInfo lore))
-> PR lore
-> Parser (Param (FParamInfo lore))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PR lore -> Parser (FParamInfo lore)
forall lore. PR lore -> Parser (FParamInfo lore)
pFParamInfo

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

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

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

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

pPattern :: PR lore -> Parser (Pattern lore)
pPattern :: forall lore. PR lore -> Parser (Pattern lore)
pPattern PR lore
pr = ([PatElemT (LetDec lore)]
 -> [PatElemT (LetDec lore)] -> PatternT (LetDec lore))
-> ([PatElemT (LetDec lore)], [PatElemT (LetDec lore)])
-> PatternT (LetDec lore)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [PatElemT (LetDec lore)]
-> [PatElemT (LetDec lore)] -> PatternT (LetDec lore)
forall dec. [PatElemT dec] -> [PatElemT dec] -> PatternT dec
Pattern (([PatElemT (LetDec lore)], [PatElemT (LetDec lore)])
 -> PatternT (LetDec lore))
-> ParsecT
     Void
     Text
     Identity
     ([PatElemT (LetDec lore)], [PatElemT (LetDec lore)])
-> ParsecT Void Text Identity (PatternT (LetDec lore))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (PatElemT (LetDec lore))
-> ParsecT
     Void
     Text
     Identity
     ([PatElemT (LetDec lore)], [PatElemT (LetDec lore)])
forall a. Parser a -> Parser ([a], [a])
pPatternLike (PR lore -> Parser (PatElemT (LetDec lore))
forall lore. PR lore -> Parser (PatElem lore)
pPatElem PR lore
pr)

pIf :: PR lore -> Parser (Exp lore)
pIf :: forall lore. PR lore -> Parser (Exp lore)
pIf PR lore
pr =
  Text -> ParsecT Void Text Identity ()
keyword Text
"if" ParsecT Void Text Identity ()
-> (IfSort
    -> SubExp
    -> BodyT lore
    -> BodyT lore
    -> [BranchType lore]
    -> Exp lore)
-> ParsecT
     Void
     Text
     Identity
     (IfSort
      -> SubExp
      -> BodyT lore
      -> BodyT lore
      -> [BranchType lore]
      -> Exp lore)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IfSort
-> SubExp
-> BodyT lore
-> BodyT lore
-> [BranchType lore]
-> Exp lore
forall {lore}.
IfSort
-> SubExp
-> BodyT lore
-> BodyT lore
-> [BranchType lore]
-> ExpT lore
f ParsecT
  Void
  Text
  Identity
  (IfSort
   -> SubExp
   -> BodyT lore
   -> BodyT lore
   -> [BranchType lore]
   -> Exp lore)
-> ParsecT Void Text Identity IfSort
-> ParsecT
     Void
     Text
     Identity
     (SubExp
      -> BodyT lore -> BodyT lore -> [BranchType lore] -> Exp lore)
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 lore -> BodyT lore -> [BranchType lore] -> Exp lore)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     (BodyT lore -> BodyT lore -> [BranchType lore] -> Exp lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SubExp
pSubExp
    ParsecT
  Void
  Text
  Identity
  (BodyT lore -> BodyT lore -> [BranchType lore] -> Exp lore)
-> ParsecT Void Text Identity (BodyT lore)
-> ParsecT
     Void Text Identity (BodyT lore -> [BranchType lore] -> Exp lore)
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 lore)
-> ParsecT Void Text Identity (BodyT lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (BodyT lore)
pBranchBody)
    ParsecT
  Void Text Identity (BodyT lore -> [BranchType lore] -> Exp lore)
-> ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity ([BranchType lore] -> Exp lore)
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 lore)
-> ParsecT Void Text Identity (BodyT lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (BodyT lore)
pBranchBody)
    ParsecT Void Text Identity ([BranchType lore] -> Exp lore)
-> ParsecT Void Text Identity [BranchType lore]
-> ParsecT Void Text Identity (Exp lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
":" Parser Text
-> ParsecT Void Text Identity [BranchType lore]
-> ParsecT Void Text Identity [BranchType lore]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PR lore -> ParsecT Void Text Identity [BranchType lore]
forall lore. PR lore -> Parser [BranchType lore]
pBranchTypes PR lore
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
        [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"<fallback>" Parser Text -> IfSort -> ParsecT Void Text Identity IfSort
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IfSort
IfFallback,
          Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"<equiv>" Parser 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 lore
-> BodyT lore
-> [BranchType lore]
-> ExpT lore
f IfSort
sort SubExp
cond BodyT lore
tbranch BodyT lore
fbranch [BranchType lore]
t =
      SubExp
-> BodyT lore -> BodyT lore -> IfDec (BranchType lore) -> ExpT lore
forall lore.
SubExp
-> BodyT lore -> BodyT lore -> IfDec (BranchType lore) -> ExpT lore
If SubExp
cond BodyT lore
tbranch BodyT lore
fbranch (IfDec (BranchType lore) -> ExpT lore)
-> IfDec (BranchType lore) -> ExpT lore
forall a b. (a -> b) -> a -> b
$ [BranchType lore] -> IfSort -> IfDec (BranchType lore)
forall rt. [rt] -> IfSort -> IfDec rt
IfDec [BranchType lore]
t IfSort
sort
    pBranchBody :: ParsecT Void Text Identity (BodyT lore)
pBranchBody =
      [ParsecT Void Text Identity (BodyT lore)]
-> ParsecT Void Text Identity (BodyT lore)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (BodyT lore)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (BodyT lore)
 -> ParsecT Void Text Identity (BodyT lore))
-> ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (BodyT lore)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (BodyT lore)
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity (BodyT lore)
 -> ParsecT Void Text Identity (BodyT lore))
-> ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (BodyT lore)
forall a b. (a -> b) -> a -> b
$ BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
forall lore. BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
Body (PR lore -> BodyDec lore
forall lore. PR lore -> BodyDec lore
pBodyDec PR lore
pr) Stms lore
forall a. Monoid a => a
mempty ([SubExp] -> BodyT lore)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (BodyT lore)
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 (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` ParsecT Void Text Identity ()
pComma,
          ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (BodyT lore)
forall a. Parser a -> Parser a
braces (PR lore -> ParsecT Void Text Identity (BodyT lore)
forall lore. PR lore -> Parser (Body lore)
pBody PR lore
pr)
        ]

pApply :: PR lore -> Parser (Exp lore)
pApply :: forall lore. PR lore -> Parser (Exp lore)
pApply PR lore
pr =
  Text -> ParsecT Void Text Identity ()
keyword Text
"apply"
    ParsecT Void Text Identity ()
-> (Name
    -> [(SubExp, Diet)]
    -> [RetType lore]
    -> (Safety, SrcLoc, [SrcLoc])
    -> Exp lore)
-> ParsecT
     Void
     Text
     Identity
     (Name
      -> [(SubExp, Diet)]
      -> [RetType lore]
      -> (Safety, SrcLoc, [SrcLoc])
      -> Exp lore)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Name
-> [(SubExp, Diet)]
-> [RetType lore]
-> (Safety, SrcLoc, [SrcLoc])
-> Exp lore
forall lore.
Name
-> [(SubExp, Diet)]
-> [RetType lore]
-> (Safety, SrcLoc, [SrcLoc])
-> ExpT lore
Apply
    ParsecT
  Void
  Text
  Identity
  (Name
   -> [(SubExp, Diet)]
   -> [RetType lore]
   -> (Safety, SrcLoc, [SrcLoc])
   -> Exp lore)
-> Parser Name
-> ParsecT
     Void
     Text
     Identity
     ([(SubExp, Diet)]
      -> [RetType lore] -> (Safety, SrcLoc, [SrcLoc]) -> Exp lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Name
pName
    ParsecT
  Void
  Text
  Identity
  ([(SubExp, Diet)]
   -> [RetType lore] -> (Safety, SrcLoc, [SrcLoc]) -> Exp lore)
-> ParsecT Void Text Identity [(SubExp, Diet)]
-> ParsecT
     Void
     Text
     Identity
     ([RetType lore] -> (Safety, SrcLoc, [SrcLoc]) -> Exp lore)
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 lore] -> (Safety, SrcLoc, [SrcLoc]) -> Exp lore)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([RetType lore] -> (Safety, SrcLoc, [SrcLoc]) -> Exp lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pColon
    ParsecT
  Void
  Text
  Identity
  ([RetType lore] -> (Safety, SrcLoc, [SrcLoc]) -> Exp lore)
-> ParsecT Void Text Identity [RetType lore]
-> ParsecT
     Void Text Identity ((Safety, SrcLoc, [SrcLoc]) -> Exp lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR lore -> ParsecT Void Text Identity [RetType lore]
forall lore. PR lore -> Parser [RetType lore]
pRetTypes PR lore
pr
    ParsecT Void Text Identity ((Safety, SrcLoc, [SrcLoc]) -> Exp lore)
-> ParsecT Void Text Identity (Safety, SrcLoc, [SrcLoc])
-> ParsecT Void Text Identity (Exp lore)
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
Safe, SrcLoc
forall a. Monoid a => a
mempty, [SrcLoc]
forall a. Monoid a => a
mempty)
  where
    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
        [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"*" Parser 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 lore -> Parser (Exp lore)
pLoop :: forall lore. PR lore -> Parser (Exp lore)
pLoop PR lore
pr =
  Text -> ParsecT Void Text Identity ()
keyword Text
"loop" ParsecT Void Text Identity ()
-> (([(Param (FParamInfo lore), SubExp)],
     [(Param (FParamInfo lore), SubExp)])
    -> LoopForm lore -> BodyT lore -> ExpT lore)
-> ParsecT
     Void
     Text
     Identity
     (([(Param (FParamInfo lore), SubExp)],
       [(Param (FParamInfo lore), SubExp)])
      -> LoopForm lore -> BodyT lore -> ExpT lore)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ([(Param (FParamInfo lore), SubExp)]
 -> [(Param (FParamInfo lore), SubExp)]
 -> LoopForm lore
 -> BodyT lore
 -> ExpT lore)
-> ([(Param (FParamInfo lore), SubExp)],
    [(Param (FParamInfo lore), SubExp)])
-> LoopForm lore
-> BodyT lore
-> ExpT lore
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(Param (FParamInfo lore), SubExp)]
-> [(Param (FParamInfo lore), SubExp)]
-> LoopForm lore
-> BodyT lore
-> ExpT lore
forall lore.
[(FParam lore, SubExp)]
-> [(FParam lore, SubExp)]
-> LoopForm lore
-> BodyT lore
-> ExpT lore
DoLoop
    ParsecT
  Void
  Text
  Identity
  (([(Param (FParamInfo lore), SubExp)],
    [(Param (FParamInfo lore), SubExp)])
   -> LoopForm lore -> BodyT lore -> ExpT lore)
-> ParsecT
     Void
     Text
     Identity
     ([(Param (FParamInfo lore), SubExp)],
      [(Param (FParamInfo lore), SubExp)])
-> ParsecT
     Void Text Identity (LoopForm lore -> BodyT lore -> ExpT lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
  Void
  Text
  Identity
  ([(Param (FParamInfo lore), SubExp)],
   [(Param (FParamInfo lore), SubExp)])
pLoopParams
    ParsecT
  Void Text Identity (LoopForm lore -> BodyT lore -> ExpT lore)
-> ParsecT Void Text Identity (LoopForm lore)
-> ParsecT Void Text Identity (BodyT lore -> ExpT lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (LoopForm lore)
pLoopForm ParsecT Void Text Identity (BodyT lore -> ExpT lore)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (BodyT lore -> ExpT lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT Void Text Identity ()
keyword Text
"do"
    ParsecT Void Text Identity (BodyT lore -> ExpT lore)
-> ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (ExpT lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (BodyT lore)
forall a. Parser a -> Parser a
braces (PR lore -> ParsecT Void Text Identity (BodyT lore)
forall lore. PR lore -> Parser (Body lore)
pBody PR lore
pr)
  where
    pLoopParams :: ParsecT
  Void
  Text
  Identity
  ([(Param (FParamInfo lore), SubExp)],
   [(Param (FParamInfo lore), SubExp)])
pLoopParams = do
      ([Param (FParamInfo lore)]
ctx, [Param (FParamInfo lore)]
val) <- Parser (Param (FParamInfo lore))
-> Parser ([Param (FParamInfo lore)], [Param (FParamInfo lore)])
forall a. Parser a -> Parser ([a], [a])
pPatternLike (PR lore -> Parser (Param (FParamInfo lore))
forall lore. PR lore -> Parser (FParam lore)
pFParam PR lore
pr)
      Parser Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> ParsecT Void Text Identity ())
-> Parser Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"="
      ([SubExp]
ctx_init, [SubExp]
val_init) <-
        Int -> [SubExp] -> ([SubExp], [SubExp])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Param (FParamInfo lore)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Param (FParamInfo lore)]
ctx) ([SubExp] -> ([SubExp], [SubExp]))
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity ([SubExp], [SubExp])
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
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 lore), SubExp)],
 [(Param (FParamInfo lore), SubExp)])
-> ParsecT
     Void
     Text
     Identity
     ([(Param (FParamInfo lore), SubExp)],
      [(Param (FParamInfo lore), SubExp)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Param (FParamInfo lore)]
-> [SubExp] -> [(Param (FParamInfo lore), SubExp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Param (FParamInfo lore)]
ctx [SubExp]
ctx_init, [Param (FParamInfo lore)]
-> [SubExp] -> [(Param (FParamInfo lore), SubExp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Param (FParamInfo lore)]
val [SubExp]
val_init)

    pLoopForm :: ParsecT Void Text Identity (LoopForm lore)
pLoopForm =
      [ParsecT Void Text Identity (LoopForm lore)]
-> ParsecT Void Text Identity (LoopForm lore)
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 lore), VName)]
    -> LoopForm lore)
-> ParsecT
     Void
     Text
     Identity
     (VName
      -> IntType
      -> SubExp
      -> [(Param (LParamInfo lore), VName)]
      -> LoopForm lore)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VName
-> IntType
-> SubExp
-> [(Param (LParamInfo lore), VName)]
-> LoopForm lore
forall lore.
VName
-> IntType -> SubExp -> [(LParam lore, VName)] -> LoopForm lore
ForLoop
            ParsecT
  Void
  Text
  Identity
  (VName
   -> IntType
   -> SubExp
   -> [(Param (LParamInfo lore), VName)]
   -> LoopForm lore)
-> Parser VName
-> ParsecT
     Void
     Text
     Identity
     (IntType
      -> SubExp -> [(Param (LParamInfo lore), VName)] -> LoopForm lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName ParsecT
  Void
  Text
  Identity
  (IntType
   -> SubExp -> [(Param (LParamInfo lore), VName)] -> LoopForm lore)
-> Parser Text
-> ParsecT
     Void
     Text
     Identity
     (IntType
      -> SubExp -> [(Param (LParamInfo lore), VName)] -> LoopForm lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
":"
            ParsecT
  Void
  Text
  Identity
  (IntType
   -> SubExp -> [(Param (LParamInfo lore), VName)] -> LoopForm lore)
-> ParsecT Void Text Identity IntType
-> ParsecT
     Void
     Text
     Identity
     (SubExp -> [(Param (LParamInfo lore), VName)] -> LoopForm lore)
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 lore), VName)] -> LoopForm lore)
-> Parser Text
-> ParsecT
     Void
     Text
     Identity
     (SubExp -> [(Param (LParamInfo lore), VName)] -> LoopForm lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"<"
            ParsecT
  Void
  Text
  Identity
  (SubExp -> [(Param (LParamInfo lore), VName)] -> LoopForm lore)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ([(Param (LParamInfo lore), VName)] -> LoopForm lore)
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 lore), VName)] -> LoopForm lore)
-> ParsecT Void Text Identity [(Param (LParamInfo lore), VName)]
-> ParsecT Void Text Identity (LoopForm lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Param (LParamInfo lore), VName)
-> ParsecT Void Text Identity [(Param (LParamInfo lore), VName)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((,) (Param (LParamInfo lore)
 -> VName -> (Param (LParamInfo lore), VName))
-> ParsecT Void Text Identity (Param (LParamInfo lore))
-> ParsecT
     Void Text Identity (VName -> (Param (LParamInfo lore), VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR lore -> ParsecT Void Text Identity (Param (LParamInfo lore))
forall lore. PR lore -> Parser (LParam lore)
pLParam PR lore
pr ParsecT
  Void Text Identity (VName -> (Param (LParamInfo lore), VName))
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity (VName -> (Param (LParamInfo lore), 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 lore), VName))
-> Parser VName
-> ParsecT Void Text Identity (Param (LParamInfo lore), 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 lore)
-> ParsecT Void Text Identity (VName -> LoopForm lore)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VName -> LoopForm lore
forall lore. VName -> LoopForm lore
WhileLoop ParsecT Void Text Identity (VName -> LoopForm lore)
-> Parser VName -> ParsecT Void Text Identity (LoopForm lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VName
pVName
        ]

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

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

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

pStm :: PR lore -> Parser (Stm lore)
pStm :: forall lore. PR lore -> Parser (Stm lore)
pStm PR lore
pr =
  Text -> ParsecT Void Text Identity ()
keyword Text
"let" ParsecT Void Text Identity ()
-> (PatternT (LetDec lore)
    -> StmAux (ExpDec lore) -> Exp lore -> Stm lore)
-> ParsecT
     Void
     Text
     Identity
     (PatternT (LetDec lore)
      -> StmAux (ExpDec lore) -> Exp lore -> Stm lore)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PatternT (LetDec lore)
-> StmAux (ExpDec lore) -> Exp lore -> Stm lore
forall lore.
Pattern lore -> StmAux (ExpDec lore) -> Exp lore -> Stm lore
Let ParsecT
  Void
  Text
  Identity
  (PatternT (LetDec lore)
   -> StmAux (ExpDec lore) -> Exp lore -> Stm lore)
-> ParsecT Void Text Identity (PatternT (LetDec lore))
-> ParsecT
     Void Text Identity (StmAux (ExpDec lore) -> Exp lore -> Stm lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR lore -> ParsecT Void Text Identity (PatternT (LetDec lore))
forall lore. PR lore -> Parser (Pattern lore)
pPattern PR lore
pr ParsecT
  Void Text Identity (StmAux (ExpDec lore) -> Exp lore -> Stm lore)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity (StmAux (ExpDec lore) -> Exp lore -> Stm lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pEqual ParsecT
  Void Text Identity (StmAux (ExpDec lore) -> Exp lore -> Stm lore)
-> ParsecT Void Text Identity (StmAux (ExpDec lore))
-> ParsecT Void Text Identity (Exp lore -> Stm lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (StmAux (ExpDec lore))
pStmAux ParsecT Void Text Identity (Exp lore -> Stm lore)
-> ParsecT Void Text Identity (Exp lore)
-> ParsecT Void Text Identity (Stm lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR lore -> ParsecT Void Text Identity (Exp lore)
forall lore. PR lore -> Parser (Exp lore)
pExp PR lore
pr
  where
    pStmAux :: ParsecT Void Text Identity (StmAux (ExpDec lore))
pStmAux = (Certificates -> Attrs -> ExpDec lore -> StmAux (ExpDec lore))
-> Attrs -> Certificates -> ExpDec lore -> StmAux (ExpDec lore)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Certificates -> Attrs -> ExpDec lore -> StmAux (ExpDec lore)
forall dec. Certificates -> Attrs -> dec -> StmAux dec
StmAux (Attrs -> Certificates -> ExpDec lore -> StmAux (ExpDec lore))
-> Parser Attrs
-> ParsecT
     Void
     Text
     Identity
     (Certificates -> ExpDec lore -> StmAux (ExpDec lore))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Attrs
pAttrs ParsecT
  Void
  Text
  Identity
  (Certificates -> ExpDec lore -> StmAux (ExpDec lore))
-> ParsecT Void Text Identity Certificates
-> ParsecT Void Text Identity (ExpDec lore -> StmAux (ExpDec lore))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Certificates
pCerts ParsecT Void Text Identity (ExpDec lore -> StmAux (ExpDec lore))
-> ParsecT Void Text Identity (ExpDec lore)
-> ParsecT Void Text Identity (StmAux (ExpDec lore))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpDec lore -> ParsecT Void Text Identity (ExpDec lore)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PR lore -> ExpDec lore
forall lore. PR lore -> ExpDec lore
pExpDec PR lore
pr)
    pCerts :: ParsecT Void Text Identity Certificates
pCerts =
      [ParsecT Void Text Identity Certificates]
-> ParsecT Void Text Identity Certificates
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"#" Parser Text
-> ParsecT Void Text Identity Certificates
-> ParsecT Void Text Identity Certificates
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Certificates
-> ParsecT Void Text Identity Certificates
forall a. Parser a -> Parser a
braces ([VName] -> Certificates
Certificates ([VName] -> Certificates)
-> Parser [VName] -> ParsecT Void Text Identity Certificates
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)
            ParsecT Void Text Identity Certificates
-> String -> ParsecT Void Text Identity Certificates
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"certificates",
          Certificates -> ParsecT Void Text Identity Certificates
forall (f :: * -> *) a. Applicative f => a -> f a
pure Certificates
forall a. Monoid a => a
mempty
        ]

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

pBody :: PR lore -> Parser (Body lore)
pBody :: forall lore. PR lore -> Parser (Body lore)
pBody PR lore
pr =
  [ParsecT Void Text Identity (BodyT lore)]
-> ParsecT Void Text Identity (BodyT lore)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
forall lore. BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
Body (PR lore -> BodyDec lore
forall lore. PR lore -> BodyDec lore
pBodyDec PR lore
pr) (Stms lore -> [SubExp] -> BodyT lore)
-> ParsecT Void Text Identity (Stms lore)
-> ParsecT Void Text Identity ([SubExp] -> BodyT lore)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR lore -> ParsecT Void Text Identity (Stms lore)
forall lore. PR lore -> Parser (Stms lore)
pStms PR lore
pr ParsecT Void Text Identity ([SubExp] -> BodyT lore)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([SubExp] -> BodyT lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT Void Text Identity ()
keyword Text
"in" ParsecT Void Text Identity ([SubExp] -> BodyT lore)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (BodyT lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [SubExp]
pResult,
      BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
forall lore. BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
Body (PR lore -> BodyDec lore
forall lore. PR lore -> BodyDec lore
pBodyDec PR lore
pr) Stms lore
forall a. Monoid a => a
mempty ([SubExp] -> BodyT lore)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (BodyT lore)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [SubExp]
pResult
    ]
  where
    pResult :: ParsecT Void Text Identity [SubExp]
pResult = ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity [SubExp]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity [SubExp]
 -> ParsecT Void Text Identity [SubExp])
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity [SubExp]
forall a b. (a -> b) -> a -> b
$ 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

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
$ (,) ([EntryPointType] -> [EntryPointType] -> EntryPoint)
-> ParsecT Void Text Identity [EntryPointType]
-> ParsecT Void Text Identity ([EntryPointType] -> EntryPoint)
forall (f :: * -> *) a b. Functor 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 =
      [ParsecT Void Text Identity EntryPointType]
-> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Parser Text
"direct" Parser Text
-> EntryPointType -> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> EntryPointType
TypeDirect,
          Parser Text
"unsigned" Parser Text
-> EntryPointType -> ParsecT Void Text Identity EntryPointType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> EntryPointType
TypeUnsigned,
          Parser Text
"opaque" Parser 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 (String -> Int -> EntryPointType
TypeOpaque (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 lore -> Parser (FunDef lore)
pFunDef :: forall lore. PR lore -> Parser (FunDef lore)
pFunDef PR lore
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 lore)]
fparams <- PR lore -> Parser [Param (FParamInfo lore)]
forall lore. PR lore -> Parser [FParam lore]
pFParams PR lore
pr Parser [Param (FParamInfo lore)]
-> ParsecT Void Text Identity ()
-> Parser [Param (FParamInfo lore)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pColon
  [RetType lore]
ret <- PR lore -> Parser [RetType lore]
forall lore. PR lore -> Parser [RetType lore]
pRetTypes PR lore
pr
  Maybe EntryPoint
-> Attrs
-> Name
-> [RetType lore]
-> [Param (FParamInfo lore)]
-> BodyT lore
-> FunDef lore
forall lore.
Maybe EntryPoint
-> Attrs
-> Name
-> [RetType lore]
-> [FParam lore]
-> BodyT lore
-> FunDef lore
FunDef Maybe EntryPoint
entry Attrs
attrs Name
fname [RetType lore]
ret [Param (FParamInfo lore)]
fparams
    (BodyT lore -> FunDef lore)
-> ParsecT Void Text Identity (BodyT lore) -> Parser (FunDef lore)
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 lore)
-> ParsecT Void Text Identity (BodyT lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (BodyT lore)
-> ParsecT Void Text Identity (BodyT lore)
forall a. Parser a -> Parser a
braces (PR lore -> ParsecT Void Text Identity (BodyT lore)
forall lore. PR lore -> Parser (Body lore)
pBody PR lore
pr))

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

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

pSizeClass :: Parser Kernel.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
Kernel.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
Kernel.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
Kernel.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
Kernel.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
Kernel.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
Kernel.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
Kernel.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, Parser Text
"def" Parser 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
Kernel.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
        [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"!" Parser 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 Kernel.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
Kernel.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
Kernel.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
Kernel.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
<*> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"<=" Parser 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
Kernel.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
Kernel.SplitSpace SplitOrdering
Kernel.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
Kernel.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
Kernel.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 (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"~" Parser 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))
-> Parser Text
-> ParsecT Void Text Identity (SubExp -> (VName, SubExp))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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 =
  [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 -> SubExp -> KernelResult)
-> ParsecT
     Void Text Identity (ResultManifest -> SubExp -> KernelResult)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ResultManifest -> SubExp -> KernelResult
SegOp.Returns
        ParsecT
  Void Text Identity (ResultManifest -> SubExp -> KernelResult)
-> ParsecT Void Text Identity ResultManifest
-> ParsecT Void Text Identity (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 (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 Shape -> VName -> [(Slice SubExp, SubExp)] -> KernelResult
SegOp.WriteReturns
          (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),
      Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Text
"tile"
        Parser 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 ([(SubExp, SubExp)] -> VName -> KernelResult
SegOp.TileReturns ([(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,
      Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Text
"blkreg_tile"
        Parser 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 ([(SubExp, SubExp, SubExp)] -> VName -> KernelResult
SegOp.RegTileReturns ([(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
          ( SplitOrdering -> SubExp -> SubExp -> VName -> KernelResult
SegOp.ConcatReturns 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
          ( SplitOrdering -> SubExp -> SubExp -> VName -> KernelResult
SegOp.ConcatReturns
              (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 lore -> Parser (SegOp.KernelBody lore)
pKernelBody :: forall lore. PR lore -> Parser (KernelBody lore)
pKernelBody PR lore
pr =
  BodyDec lore -> Stms lore -> [KernelResult] -> KernelBody lore
forall lore.
BodyDec lore -> Stms lore -> [KernelResult] -> KernelBody lore
SegOp.KernelBody (PR lore -> BodyDec lore
forall lore. PR lore -> BodyDec lore
pBodyDec PR lore
pr)
    (Stms lore -> [KernelResult] -> KernelBody lore)
-> ParsecT Void Text Identity (Stms lore)
-> ParsecT Void Text Identity ([KernelResult] -> KernelBody lore)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR lore -> ParsecT Void Text Identity (Stms lore)
forall lore. PR lore -> Parser (Stms lore)
pStms PR lore
pr ParsecT Void Text Identity ([KernelResult] -> KernelBody lore)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([KernelResult] -> KernelBody lore)
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 lore)
-> ParsecT Void Text Identity [KernelResult]
-> ParsecT Void Text Identity (KernelBody lore)
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 lore -> Parser lvl -> Parser (SegOp.SegOp lvl lore)
pSegOp :: forall lore lvl. PR lore -> Parser lvl -> Parser (SegOp lvl lore)
pSegOp PR lore
pr Parser lvl
pLvl =
  [ParsecT Void Text Identity (SegOp lvl lore)]
-> ParsecT Void Text Identity (SegOp lvl lore)
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 ()
-> ParsecT Void Text Identity (SegOp lvl lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl lore)
pSegMap,
      Text -> ParsecT Void Text Identity ()
keyword Text
"segred" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (SegOp lvl lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl lore)
pSegRed,
      Text -> ParsecT Void Text Identity ()
keyword Text
"segscan" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (SegOp lvl lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl lore)
pSegScan,
      Text -> ParsecT Void Text Identity ()
keyword Text
"seghist" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (SegOp lvl lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (SegOp lvl lore)
pSegHist
    ]
  where
    pSegMap :: ParsecT Void Text Identity (SegOp lvl lore)
pSegMap =
      lvl -> SegSpace -> [Type] -> KernelBody lore -> SegOp lvl lore
forall lvl lore.
lvl -> SegSpace -> [Type] -> KernelBody lore -> SegOp lvl lore
SegOp.SegMap
        (lvl -> SegSpace -> [Type] -> KernelBody lore -> SegOp lvl lore)
-> Parser lvl
-> ParsecT
     Void
     Text
     Identity
     (SegSpace -> [Type] -> KernelBody lore -> SegOp lvl lore)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser lvl
pLvl
        ParsecT
  Void
  Text
  Identity
  (SegSpace -> [Type] -> KernelBody lore -> SegOp lvl lore)
-> Parser SegSpace
-> ParsecT
     Void Text Identity ([Type] -> KernelBody lore -> SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SegSpace
pSegSpace ParsecT
  Void Text Identity ([Type] -> KernelBody lore -> SegOp lvl lore)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity ([Type] -> KernelBody lore -> SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pColon
        ParsecT
  Void Text Identity ([Type] -> KernelBody lore -> SegOp lvl lore)
-> ParsecT Void Text Identity [Type]
-> ParsecT Void Text Identity (KernelBody lore -> SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Type]
pTypes
        ParsecT Void Text Identity (KernelBody lore -> SegOp lvl lore)
-> ParsecT Void Text Identity (KernelBody lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (KernelBody lore)
-> ParsecT Void Text Identity (KernelBody lore)
forall a. Parser a -> Parser a
braces (PR lore -> ParsecT Void Text Identity (KernelBody lore)
forall lore. PR lore -> Parser (KernelBody lore)
pKernelBody PR lore
pr)
    pSegOp' :: (lvl -> SegSpace -> [a] -> [Type] -> KernelBody lore -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl -> SegSpace -> [a] -> [Type] -> KernelBody lore -> b
f ParsecT Void Text Identity a
p =
      lvl -> SegSpace -> [a] -> [Type] -> KernelBody lore -> b
f (lvl -> SegSpace -> [a] -> [Type] -> KernelBody lore -> b)
-> Parser lvl
-> ParsecT
     Void
     Text
     Identity
     (SegSpace -> [a] -> [Type] -> KernelBody lore -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser lvl
pLvl
        ParsecT
  Void
  Text
  Identity
  (SegSpace -> [a] -> [Type] -> KernelBody lore -> b)
-> Parser SegSpace
-> ParsecT
     Void Text Identity ([a] -> [Type] -> KernelBody lore -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SegSpace
pSegSpace
        ParsecT Void Text Identity ([a] -> [Type] -> KernelBody lore -> b)
-> ParsecT Void Text Identity [a]
-> ParsecT Void Text Identity ([Type] -> KernelBody lore -> 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 lore -> b)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([Type] -> KernelBody lore -> b)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pColon
        ParsecT Void Text Identity ([Type] -> KernelBody lore -> b)
-> ParsecT Void Text Identity [Type]
-> ParsecT Void Text Identity (KernelBody lore -> 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 lore -> b)
-> ParsecT Void Text Identity (KernelBody lore)
-> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (KernelBody lore)
-> ParsecT Void Text Identity (KernelBody lore)
forall a. Parser a -> Parser a
braces (PR lore -> ParsecT Void Text Identity (KernelBody lore)
forall lore. PR lore -> Parser (KernelBody lore)
pKernelBody PR lore
pr)
    pSegBinOp :: ParsecT Void Text Identity (SegBinOp lore)
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 lore
lam <- PR lore -> Parser (Lambda lore)
forall lore. PR lore -> Parser (Lambda lore)
pLambda PR lore
pr
      SegBinOp lore -> ParsecT Void Text Identity (SegBinOp lore)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SegBinOp lore -> ParsecT Void Text Identity (SegBinOp lore))
-> SegBinOp lore -> ParsecT Void Text Identity (SegBinOp lore)
forall a b. (a -> b) -> a -> b
$ Commutativity -> Lambda lore -> [SubExp] -> Shape -> SegBinOp lore
forall lore.
Commutativity -> Lambda lore -> [SubExp] -> Shape -> SegBinOp lore
SegOp.SegBinOp Commutativity
comm Lambda lore
lam [SubExp]
nes Shape
shape
    pHistOp :: ParsecT Void Text Identity (HistOp lore)
pHistOp =
      SubExp
-> SubExp
-> [VName]
-> [SubExp]
-> Shape
-> Lambda lore
-> HistOp lore
forall lore.
SubExp
-> SubExp
-> [VName]
-> [SubExp]
-> Shape
-> Lambda lore
-> HistOp lore
SegOp.HistOp
        (SubExp
 -> SubExp
 -> [VName]
 -> [SubExp]
 -> Shape
 -> Lambda lore
 -> HistOp lore)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     (SubExp
      -> [VName] -> [SubExp] -> Shape -> Lambda lore -> HistOp lore)
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 lore -> HistOp lore)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (SubExp
      -> [VName] -> [SubExp] -> Shape -> Lambda lore -> HistOp lore)
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 lore -> HistOp lore)
-> ParsecT Void Text Identity SubExp
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> [SubExp] -> Shape -> Lambda lore -> HistOp lore)
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 lore -> HistOp lore)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([VName] -> [SubExp] -> Shape -> Lambda lore -> HistOp lore)
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 lore -> HistOp lore)
-> Parser [VName]
-> ParsecT
     Void
     Text
     Identity
     ([SubExp] -> Shape -> Lambda lore -> HistOp lore)
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 lore -> HistOp lore)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     ([SubExp] -> Shape -> Lambda lore -> HistOp lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT
  Void
  Text
  Identity
  ([SubExp] -> Shape -> Lambda lore -> HistOp lore)
-> ParsecT Void Text Identity [SubExp]
-> ParsecT Void Text Identity (Shape -> Lambda lore -> HistOp lore)
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 lore -> HistOp lore)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Shape -> Lambda lore -> HistOp lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT Void Text Identity (Shape -> Lambda lore -> HistOp lore)
-> ParsecT Void Text Identity Shape
-> ParsecT Void Text Identity (Lambda lore -> HistOp lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Shape
pShape ParsecT Void Text Identity (Lambda lore -> HistOp lore)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Lambda lore -> HistOp lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pComma
        ParsecT Void Text Identity (Lambda lore -> HistOp lore)
-> Parser (Lambda lore) -> ParsecT Void Text Identity (HistOp lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PR lore -> Parser (Lambda lore)
forall lore. PR lore -> Parser (Lambda lore)
pLambda PR lore
pr
    pSegRed :: ParsecT Void Text Identity (SegOp lvl lore)
pSegRed = (lvl
 -> SegSpace
 -> [SegBinOp lore]
 -> [Type]
 -> KernelBody lore
 -> SegOp lvl lore)
-> ParsecT Void Text Identity (SegBinOp lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall {a} {b}.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody lore -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl
-> SegSpace
-> [SegBinOp lore]
-> [Type]
-> KernelBody lore
-> SegOp lvl lore
forall lvl lore.
lvl
-> SegSpace
-> [SegBinOp lore]
-> [Type]
-> KernelBody lore
-> SegOp lvl lore
SegOp.SegRed ParsecT Void Text Identity (SegBinOp lore)
pSegBinOp
    pSegScan :: ParsecT Void Text Identity (SegOp lvl lore)
pSegScan = (lvl
 -> SegSpace
 -> [SegBinOp lore]
 -> [Type]
 -> KernelBody lore
 -> SegOp lvl lore)
-> ParsecT Void Text Identity (SegBinOp lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall {a} {b}.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody lore -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl
-> SegSpace
-> [SegBinOp lore]
-> [Type]
-> KernelBody lore
-> SegOp lvl lore
forall lvl lore.
lvl
-> SegSpace
-> [SegBinOp lore]
-> [Type]
-> KernelBody lore
-> SegOp lvl lore
SegOp.SegScan ParsecT Void Text Identity (SegBinOp lore)
pSegBinOp
    pSegHist :: ParsecT Void Text Identity (SegOp lvl lore)
pSegHist = (lvl
 -> SegSpace
 -> [HistOp lore]
 -> [Type]
 -> KernelBody lore
 -> SegOp lvl lore)
-> ParsecT Void Text Identity (HistOp lore)
-> ParsecT Void Text Identity (SegOp lvl lore)
forall {a} {b}.
(lvl -> SegSpace -> [a] -> [Type] -> KernelBody lore -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
pSegOp' lvl
-> SegSpace
-> [HistOp lore]
-> [Type]
-> KernelBody lore
-> SegOp lvl lore
forall lvl lore.
lvl
-> SegSpace
-> [HistOp lore]
-> [Type]
-> KernelBody lore
-> SegOp lvl lore
SegOp.SegHist ParsecT Void Text Identity (HistOp lore)
pHistOp

pSegLevel :: Parser Kernel.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
Kernel.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
Kernel.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 () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"#groups=" Parser 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
Kernel.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 () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"groupsize=" Parser 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
Kernel.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 lore -> Parser op -> Parser (Kernel.HostOp lore op)
pHostOp :: forall lore op. PR lore -> Parser op -> Parser (HostOp lore op)
pHostOp PR lore
pr Parser op
pOther =
  [ParsecT Void Text Identity (HostOp lore op)]
-> ParsecT Void Text Identity (HostOp lore op)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ SegOp SegLevel lore -> HostOp lore op
forall lore op. SegOp SegLevel lore -> HostOp lore op
Kernel.SegOp (SegOp SegLevel lore -> HostOp lore op)
-> ParsecT Void Text Identity (SegOp SegLevel lore)
-> ParsecT Void Text Identity (HostOp lore op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PR lore
-> Parser SegLevel
-> ParsecT Void Text Identity (SegOp SegLevel lore)
forall lore lvl. PR lore -> Parser lvl -> Parser (SegOp lvl lore)
pSegOp PR lore
pr Parser SegLevel
pSegLevel,
      SizeOp -> HostOp lore op
forall lore op. SizeOp -> HostOp lore op
Kernel.SizeOp (SizeOp -> HostOp lore op)
-> Parser SizeOp -> ParsecT Void Text Identity (HostOp lore op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SizeOp
pSizeOp,
      op -> HostOp lore op
forall lore op. op -> HostOp lore op
Kernel.OtherOp (op -> HostOp lore op)
-> Parser op -> ParsecT Void Text Identity (HostOp lore op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser op
pOther
    ]

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

pIxFunBase :: Parser a -> Parser (IxFun.IxFun a)
pIxFunBase :: forall a. 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
        [ Parser Text
"Inc" Parser Text
-> Monotonicity -> ParsecT Void Text Identity Monotonicity
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Monotonicity
IxFun.Inc,
          Parser Text
"Dec" Parser Text
-> Monotonicity -> ParsecT Void Text Identity Monotonicity
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Monotonicity
IxFun.Dec,
          Parser Text
"Unknown" Parser 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 :: forall d u ret.
Parser d -> Parser u -> Parser ret -> Parser (MemInfo d u ret)
pMemInfo Parser d
pd Parser u
pu Parser ret
pret =
  [ParsecT Void Text Identity (MemInfo d u ret)]
-> ParsecT Void Text Identity (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
-> ParsecT Void Text Identity (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
-> ParsecT Void Text Identity (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],
      ParsecT Void Text Identity (MemInfo d u ret)
pArrayOrAcc
    ]
  where
    pArrayOrAcc :: ParsecT Void Text Identity (MemInfo d u ret)
pArrayOrAcc = do
      u
u <- Parser u
pu
      ShapeBase d
shape <- [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)
      [ParsecT Void Text Identity (MemInfo d u ret)]
-> ParsecT Void Text Identity (MemInfo d u ret)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [u -> ShapeBase d -> ParsecT Void Text Identity (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 -> ParsecT Void Text Identity (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
<$> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"@" Parser 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 =
  Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"@"
    Parser 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)
-> Parser Text -> ParsecT Void Text Identity (IxFun -> MemBind)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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)
-> Parser Text
-> ParsecT Void Text Identity (ExtIxFun -> MemReturn)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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 <- Parser Text
"?" Parser 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
-> Parser Text -> ParsecT Void Text Identity Space
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser 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 :: forall inner. Parser inner -> Parser (MemOp inner)
pMemOp Parser inner
pInner =
  [ParsecT Void Text Identity (MemOp inner)]
-> ParsecT Void Text Identity (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 ()
-> ParsecT Void Text Identity (MemOp inner)
-> ParsecT Void Text Identity (MemOp inner)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (MemOp inner)
-> ParsecT Void Text Identity (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
-> ParsecT Void Text Identity (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 -> ParsecT Void Text Identity (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 lore.
Parser (RetType lore)
-> Parser (BranchType lore)
-> Parser (FParamInfo lore)
-> Parser (LParamInfo lore)
-> Parser (LetDec lore)
-> Parser (Op lore)
-> BodyDec lore
-> ExpDec lore
-> PR lore
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 lore. PR lore -> Parser (SOAC lore)
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 lore.
Parser (RetType lore)
-> Parser (BranchType lore)
-> Parser (FParamInfo lore)
-> Parser (LParamInfo lore)
-> Parser (LetDec lore)
-> Parser (Op lore)
-> BodyDec lore
-> ExpDec lore
-> PR lore
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 lore.
Parser (RetType lore)
-> Parser (BranchType lore)
-> Parser (FParamInfo lore)
-> Parser (LParamInfo lore)
-> Parser (LetDec lore)
-> Parser (Op lore)
-> BodyDec lore
-> ExpDec lore
-> PR lore
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

prKernels :: PR Kernels
prKernels :: PR Kernels
prKernels =
  Parser (RetType Kernels)
-> Parser (BranchType Kernels)
-> Parser (FParamInfo Kernels)
-> Parser (LParamInfo Kernels)
-> Parser (LetDec Kernels)
-> Parser (Op Kernels)
-> BodyDec Kernels
-> ExpDec Kernels
-> PR Kernels
forall lore.
Parser (RetType lore)
-> Parser (BranchType lore)
-> Parser (FParamInfo lore)
-> Parser (LParamInfo lore)
-> Parser (LetDec lore)
-> Parser (Op lore)
-> BodyDec lore
-> ExpDec lore
-> PR lore
PR Parser DeclExtType
Parser (RetType Kernels)
pDeclExtType Parser ExtType
Parser (BranchType Kernels)
pExtType Parser DeclType
Parser (FParamInfo Kernels)
pDeclType Parser Type
Parser (LParamInfo Kernels)
pType Parser Type
Parser (LetDec Kernels)
pType Parser (Op Kernels)
Parser (HostOp Kernels (SOAC Kernels))
op () ()
  where
    op :: Parser (HostOp Kernels (SOAC Kernels))
op = PR Kernels
-> Parser (SOAC Kernels) -> Parser (HostOp Kernels (SOAC Kernels))
forall lore op. PR lore -> Parser op -> Parser (HostOp lore op)
pHostOp PR Kernels
prKernels (PR Kernels -> Parser (SOAC Kernels)
forall lore. PR lore -> Parser (SOAC lore)
pSOAC PR Kernels
prKernels)

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

parseLore :: PR lore -> FilePath -> T.Text -> Either T.Text (Prog lore)
parseLore :: forall lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore PR lore
pr String
fname Text
s =
  (ParseErrorBundle Text Void -> Either Text (Prog lore))
-> (Prog lore -> Either Text (Prog lore))
-> Either (ParseErrorBundle Text Void) (Prog lore)
-> Either Text (Prog lore)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Either Text (Prog lore)
forall a b. a -> Either a b
Left (Text -> Either Text (Prog lore))
-> (ParseErrorBundle Text Void -> Text)
-> ParseErrorBundle Text Void
-> Either Text (Prog lore)
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 lore -> Either Text (Prog lore)
forall a b. b -> Either a b
Right (Either (ParseErrorBundle Text Void) (Prog lore)
 -> Either Text (Prog lore))
-> Either (ParseErrorBundle Text Void) (Prog lore)
-> Either Text (Prog lore)
forall a b. (a -> b) -> a -> b
$
    Parsec Void Text (Prog lore)
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (Prog lore)
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 lore) -> Parsec Void Text (Prog lore)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PR lore -> Parsec Void Text (Prog lore)
forall lore. PR lore -> Parser (Prog lore)
pProg PR lore
pr Parsec Void Text (Prog lore)
-> ParsecT Void Text Identity () -> Parsec Void Text (Prog lore)
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 lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore 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 lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore 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 lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore PR SeqMem
prSeqMem

parseKernels :: FilePath -> T.Text -> Either T.Text (Prog Kernels)
parseKernels :: String -> Text -> Either Text (Prog Kernels)
parseKernels = PR Kernels -> String -> Text -> Either Text (Prog Kernels)
forall lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore PR Kernels
prKernels

parseKernelsMem :: FilePath -> T.Text -> Either T.Text (Prog KernelsMem)
parseKernelsMem :: String -> Text -> Either Text (Prog KernelsMem)
parseKernelsMem = PR KernelsMem -> String -> Text -> Either Text (Prog KernelsMem)
forall lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore PR KernelsMem
prKernelsMem

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 lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore 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 lore. PR lore -> String -> Text -> Either Text (Prog lore)
parseLore PR MCMem
prMCMem