{-# LANGUAGE NamedFieldPuns #-}

{- |
Module      : Language.Egison.Parser.NonS
Licence     : MIT

This module provides the parser for the new syntax.
-}

module Language.Egison.Parser.NonS
       (
       -- * Parse a string
         parseTopExprs
       , parseTopExpr
       , parseExprs
       , parseExpr
       , upperReservedWords
       , lowerReservedWords
       ) where

import           Control.Monad.State            (get, gets, put)

import           Data.Char                      (isAsciiUpper, isLetter)
import           Data.Either                    (isRight)
import           Data.Function                  (on)
import           Data.Functor                   (($>))
import           Data.List                      (groupBy, insertBy, sortOn)
import           Data.Maybe                     (isJust, isNothing)
import           Data.Text                      (pack)

import           Control.Monad.Combinators.Expr
import           Text.Megaparsec
import           Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer     as L

import           Language.Egison.AST            hiding (Assoc (..))
import qualified Language.Egison.AST            as E
import           Language.Egison.RState


parseTopExprs :: String -> RuntimeM (Either String [TopExpr])
parseTopExprs :: String -> RuntimeM (Either String [TopExpr])
parseTopExprs = Parser [TopExpr] -> String -> RuntimeM (Either String [TopExpr])
forall a. Parser a -> String -> RuntimeM (Either String a)
doParse (Parser [TopExpr] -> String -> RuntimeM (Either String [TopExpr]))
-> Parser [TopExpr] -> String -> RuntimeM (Either String [TopExpr])
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM TopExpr -> Parser [TopExpr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
m () -> m a -> m a
L.nonIndented ParsecT CustomError String RuntimeM ()
sc ParsecT CustomError String RuntimeM TopExpr
topExpr) Parser [TopExpr]
-> ParsecT CustomError String RuntimeM () -> Parser [TopExpr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

parseTopExpr :: String -> RuntimeM (Either String TopExpr)
parseTopExpr :: String -> RuntimeM (Either String TopExpr)
parseTopExpr = ParsecT CustomError String RuntimeM TopExpr
-> String -> RuntimeM (Either String TopExpr)
forall a. Parser a -> String -> RuntimeM (Either String a)
doParse (ParsecT CustomError String RuntimeM TopExpr
 -> String -> RuntimeM (Either String TopExpr))
-> ParsecT CustomError String RuntimeM TopExpr
-> String
-> RuntimeM (Either String TopExpr)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM ()
sc ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TopExpr
topExpr ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

parseExprs :: String -> RuntimeM (Either String [Expr])
parseExprs :: String -> RuntimeM (Either String [Expr])
parseExprs = Parser [Expr] -> String -> RuntimeM (Either String [Expr])
forall a. Parser a -> String -> RuntimeM (Either String a)
doParse (Parser [Expr] -> String -> RuntimeM (Either String [Expr]))
-> Parser [Expr] -> String -> RuntimeM (Either String [Expr])
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM Expr -> Parser [Expr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
m () -> m a -> m a
L.nonIndented ParsecT CustomError String RuntimeM ()
sc ParsecT CustomError String RuntimeM Expr
expr) Parser [Expr]
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

parseExpr :: String -> RuntimeM (Either String Expr)
parseExpr :: String -> RuntimeM (Either String Expr)
parseExpr = ParsecT CustomError String RuntimeM Expr
-> String -> RuntimeM (Either String Expr)
forall a. Parser a -> String -> RuntimeM (Either String a)
doParse (ParsecT CustomError String RuntimeM Expr
 -> String -> RuntimeM (Either String Expr))
-> ParsecT CustomError String RuntimeM Expr
-> String
-> RuntimeM (Either String Expr)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM ()
sc ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

--
-- Parser
--

type Parser = ParsecT CustomError String RuntimeM

data CustomError
  = IllFormedSection Op Op
  | IllFormedDefine
  | LastStmtInDoBlock
  deriving (CustomError -> CustomError -> Bool
(CustomError -> CustomError -> Bool)
-> (CustomError -> CustomError -> Bool) -> Eq CustomError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomError -> CustomError -> Bool
$c/= :: CustomError -> CustomError -> Bool
== :: CustomError -> CustomError -> Bool
$c== :: CustomError -> CustomError -> Bool
Eq, Eq CustomError
Eq CustomError
-> (CustomError -> CustomError -> Ordering)
-> (CustomError -> CustomError -> Bool)
-> (CustomError -> CustomError -> Bool)
-> (CustomError -> CustomError -> Bool)
-> (CustomError -> CustomError -> Bool)
-> (CustomError -> CustomError -> CustomError)
-> (CustomError -> CustomError -> CustomError)
-> Ord CustomError
CustomError -> CustomError -> Bool
CustomError -> CustomError -> Ordering
CustomError -> CustomError -> CustomError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CustomError -> CustomError -> CustomError
$cmin :: CustomError -> CustomError -> CustomError
max :: CustomError -> CustomError -> CustomError
$cmax :: CustomError -> CustomError -> CustomError
>= :: CustomError -> CustomError -> Bool
$c>= :: CustomError -> CustomError -> Bool
> :: CustomError -> CustomError -> Bool
$c> :: CustomError -> CustomError -> Bool
<= :: CustomError -> CustomError -> Bool
$c<= :: CustomError -> CustomError -> Bool
< :: CustomError -> CustomError -> Bool
$c< :: CustomError -> CustomError -> Bool
compare :: CustomError -> CustomError -> Ordering
$ccompare :: CustomError -> CustomError -> Ordering
$cp1Ord :: Eq CustomError
Ord)

instance ShowErrorComponent CustomError where
  showErrorComponent :: CustomError -> String
showErrorComponent (IllFormedSection Op
op Op
op') =
    String
"The operator " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Op -> String
info Op
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" must have lower precedence than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Op -> String
info Op
op'
    where
      info :: Op -> String
info Op
op =
         String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Op -> String
repr Op
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Assoc -> String
forall a. Show a => a -> String
show (Op -> Assoc
assoc Op
op) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Op -> Int
priority Op
op) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  showErrorComponent CustomError
IllFormedDefine =
    String
"Failed to parse the left hand side of definition expression."
  showErrorComponent CustomError
LastStmtInDoBlock =
    String
"The last statement in a 'do' block must be an expression."


doParse :: Parser a -> String -> RuntimeM (Either String a)
doParse :: Parser a -> String -> RuntimeM (Either String a)
doParse Parser a
p String
input = do
  Either (ParseErrorBundle String CustomError) a
result <- Parser a
-> String
-> String
-> RuntimeM (Either (ParseErrorBundle String CustomError) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT Parser a
p String
"egison" String
input
  case Either (ParseErrorBundle String CustomError) a
result of
    Left ParseErrorBundle String CustomError
e  -> Either String a -> RuntimeM (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> RuntimeM (Either String a))
-> Either String a -> RuntimeM (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (ParseErrorBundle String CustomError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String CustomError
e)
    Right a
r -> Either String a -> RuntimeM (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> RuntimeM (Either String a))
-> Either String a -> RuntimeM (Either String a)
forall a b. (a -> b) -> a -> b
$ a -> Either String a
forall a b. b -> Either a b
Right a
r

--
-- Expressions
--

topExpr :: Parser TopExpr
topExpr :: ParsecT CustomError String RuntimeM TopExpr
topExpr = String -> TopExpr
Load     (String -> TopExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"load" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
stringLiteral)
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TopExpr
LoadFile (String -> TopExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"loadFile" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
stringLiteral)
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> TopExpr
Execute  (Expr -> TopExpr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"execute" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"def" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TopExpr
defineExpr)
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
infixExpr
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> TopExpr
Test     (Expr -> TopExpr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM TopExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
expr
      ParsecT CustomError String RuntimeM TopExpr
-> String -> ParsecT CustomError String RuntimeM TopExpr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"toplevel expression"

-- Sort binaryop table on the insertion
addNewOp :: Op -> Bool -> Parser ()
addNewOp :: Op -> Bool -> ParsecT CustomError String RuntimeM ()
addNewOp Op
newop Bool
isPattern | Bool
isPattern = do
  RState
pstate <- ParsecT CustomError String RuntimeM RState
forall s (m :: * -> *). MonadState s m => m s
get
  RState -> ParsecT CustomError String RuntimeM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RState -> ParsecT CustomError String RuntimeM ())
-> RState -> ParsecT CustomError String RuntimeM ()
forall a b. (a -> b) -> a -> b
$! RState
pstate { patternOps :: [Op]
patternOps = (Op -> Op -> Ordering) -> Op -> [Op] -> [Op]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy
                                     (\Op
x Op
y -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Op -> Int
priority Op
y) (Op -> Int
priority Op
x))
                                     Op
newop
                                     (RState -> [Op]
patternOps RState
pstate) }
addNewOp Op
newop Bool
_ = do
  RState
pstate <- ParsecT CustomError String RuntimeM RState
forall s (m :: * -> *). MonadState s m => m s
get
  RState -> ParsecT CustomError String RuntimeM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RState -> ParsecT CustomError String RuntimeM ())
-> RState -> ParsecT CustomError String RuntimeM ()
forall a b. (a -> b) -> a -> b
$! RState
pstate { exprOps :: [Op]
exprOps = (Op -> Op -> Ordering) -> Op -> [Op] -> [Op]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy
                                  (\Op
x Op
y -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Op -> Int
priority Op
y) (Op -> Int
priority Op
x))
                                  Op
newop
                                  (RState -> [Op]
exprOps RState
pstate) }

infixExpr :: Parser TopExpr
infixExpr :: ParsecT CustomError String RuntimeM TopExpr
infixExpr = do
  Assoc
assoc     <- (String -> ParsecT CustomError String RuntimeM ()
reserved String
"infixl" ParsecT CustomError String RuntimeM ()
-> Assoc -> ParsecT CustomError String RuntimeM Assoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Assoc
E.InfixL)
           ParsecT CustomError String RuntimeM Assoc
-> ParsecT CustomError String RuntimeM Assoc
-> ParsecT CustomError String RuntimeM Assoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"infixr" ParsecT CustomError String RuntimeM ()
-> Assoc -> ParsecT CustomError String RuntimeM Assoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Assoc
E.InfixR)
           ParsecT CustomError String RuntimeM Assoc
-> ParsecT CustomError String RuntimeM Assoc
-> ParsecT CustomError String RuntimeM Assoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"infix"  ParsecT CustomError String RuntimeM ()
-> Assoc -> ParsecT CustomError String RuntimeM Assoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Assoc
E.InfixN)
  Bool
isPattern <- Either () () -> Bool
forall a b. Either a b -> Bool
isRight (Either () () -> Bool)
-> ParsecT CustomError String RuntimeM (Either () ())
-> ParsecT CustomError String RuntimeM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM (Either () ())
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP (String -> ParsecT CustomError String RuntimeM ()
reserved String
"expression") (String -> ParsecT CustomError String RuntimeM ()
reserved String
"pattern")
  Int
priority  <- Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int)
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Integer
positiveIntegerLiteral
  String
sym       <- if Bool
isPattern then ParsecT CustomError String RuntimeM String
newPatOp ParsecT CustomError String RuntimeM String
-> (String -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT CustomError String RuntimeM String
checkP else ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM Char
opChar ParsecT CustomError String RuntimeM String
-> (String -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT CustomError String RuntimeM String
check
  let newop :: Op
newop = Op :: String -> Int -> Assoc -> Bool -> Op
Op { repr :: String
repr = String
sym, Int
priority :: Int
priority :: Int
priority, Assoc
assoc :: Assoc
assoc :: Assoc
assoc, isWedge :: Bool
isWedge = Bool
False }
  Op -> Bool -> ParsecT CustomError String RuntimeM ()
addNewOp Op
newop Bool
isPattern
  TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Op -> TopExpr
InfixDecl Bool
isPattern Op
newop)
  where
    check :: String -> Parser String
    check :: String -> ParsecT CustomError String RuntimeM String
check (Char
'!':String
_) = String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot declare infix starting with '!'"
    check String
x | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedOp = String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT CustomError String RuntimeM String)
-> String -> ParsecT CustomError String RuntimeM String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be a new infix"
            | Bool
otherwise           = String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

    -- Checks if given string is valid for pattern op.
    checkP :: String -> Parser String
    checkP :: String -> ParsecT CustomError String RuntimeM String
checkP String
x | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedPOp = String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT CustomError String RuntimeM String)
-> String -> ParsecT CustomError String RuntimeM String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be a new pattern infix"
             | Bool
otherwise           = String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

    reservedOp :: [String]
reservedOp = [String
":", String
":=", String
"->"]
    reservedPOp :: [String]
reservedPOp = [String
"&", String
"|", String
":=", String
"->"]

defineExpr :: Parser TopExpr
defineExpr :: ParsecT CustomError String RuntimeM TopExpr
defineExpr = do
  [Op]
ops  <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
exprOps
  VarWithIndices
f    <-   Parser VarWithIndices -> Parser VarWithIndices
forall a. Parser a -> Parser a
parens (String -> VarWithIndices
stringToVarWithIndices (String -> VarWithIndices)
-> (Op -> String) -> Op -> VarWithIndices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op -> String
repr (Op -> VarWithIndices)
-> ParsecT CustomError String RuntimeM Op -> Parser VarWithIndices
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT CustomError String RuntimeM Op]
-> ParsecT CustomError String RuntimeM Op
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Op -> ParsecT CustomError String RuntimeM Op)
-> [Op] -> [ParsecT CustomError String RuntimeM Op]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ParsecT CustomError String RuntimeM Op
infixLiteral (String -> ParsecT CustomError String RuntimeM Op)
-> (Op -> String) -> Op -> ParsecT CustomError String RuntimeM Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op -> String
repr) [Op]
ops))
        Parser VarWithIndices
-> Parser VarWithIndices -> Parser VarWithIndices
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VarWithIndices
varWithIndicesLiteral
  [Arg ArgPattern]
args <- ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM (Arg ArgPattern)
arg
  ()
_    <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
  Expr
body <- ParsecT CustomError String RuntimeM Expr
expr
  case [Arg ArgPattern]
args of
    [] -> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices -> Expr -> TopExpr
Define VarWithIndices
f Expr
body)
    [Arg ArgPattern]
_  -> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices -> Expr -> TopExpr
Define VarWithIndices
f ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr [Arg ArgPattern]
args Expr
body))

expr :: Parser Expr
expr :: ParsecT CustomError String RuntimeM Expr
expr = do
  Expr
body <- ParsecT CustomError String RuntimeM Expr
exprWithoutWhere
  Maybe [BindingExpr]
bindings <- ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM (Maybe [BindingExpr])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT CustomError String RuntimeM ()
reserved String
"where" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser BindingExpr
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a. Parser a -> Parser [a]
alignSome Parser BindingExpr
binding)
  Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ case Maybe [BindingExpr]
bindings of
             Maybe [BindingExpr]
Nothing       -> Expr
body
             Just [BindingExpr]
bindings -> [BindingExpr] -> Expr -> Expr
LetRecExpr [BindingExpr]
bindings Expr
body

exprWithoutWhere :: Parser Expr
exprWithoutWhere :: ParsecT CustomError String RuntimeM Expr
exprWithoutWhere = ParsecT CustomError String RuntimeM Expr
opExpr

-- Expressions that can be the arguments for the operators.
exprInOp :: Parser Expr
exprInOp :: ParsecT CustomError String RuntimeM Expr
exprInOp =
       ParsecT CustomError String RuntimeM Expr
ifExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
patternMatchExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
lambdaExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
lambdaLikeExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
letExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
withSymbolsExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
doExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
seqExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
capplyExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
matcherExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
algebraicDataMatcherExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
tensorExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
functionExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
refsExpr
   ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
atomOrApplyExpr
   ParsecT CustomError String RuntimeM Expr
-> String -> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"expression"

-- Also parses exprInOp
opExpr :: Parser Expr
opExpr :: ParsecT CustomError String RuntimeM Expr
opExpr = do
  [Op]
ops <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
exprOps
  ParsecT CustomError String RuntimeM Expr
-> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser ParsecT CustomError String RuntimeM Expr
exprInOp ([Op] -> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
makeExprTable [Op]
ops)

makeExprTable :: [Op] -> [[Operator Parser Expr]]
makeExprTable :: [Op] -> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
makeExprTable [Op]
ops =
  -- Generate binary operator table from |ops|
  [[Operator (ParsecT CustomError String RuntimeM) Expr]]
-> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
forall a. [a] -> [a]
reverse ([[Operator (ParsecT CustomError String RuntimeM) Expr]]
 -> [[Operator (ParsecT CustomError String RuntimeM) Expr]])
-> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
-> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
forall a b. (a -> b) -> a -> b
$ ([(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
 -> [Operator (ParsecT CustomError String RuntimeM) Expr])
-> [[(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]]
-> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Operator (ParsecT CustomError String RuntimeM) Expr)
 -> Operator (ParsecT CustomError String RuntimeM) Expr)
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
-> [Operator (ParsecT CustomError String RuntimeM) Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Operator (ParsecT CustomError String RuntimeM) Expr)
-> Operator (ParsecT CustomError String RuntimeM) Expr
forall a b. (a, b) -> b
snd) ([[(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]]
 -> [[Operator (ParsecT CustomError String RuntimeM) Expr]])
-> [[(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]]
-> [[Operator (ParsecT CustomError String RuntimeM) Expr]]
forall a b. (a -> b) -> a -> b
$ ((Int, Operator (ParsecT CustomError String RuntimeM) Expr)
 -> (Int, Operator (ParsecT CustomError String RuntimeM) Expr)
 -> Bool)
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
-> [[(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int, Operator (ParsecT CustomError String RuntimeM) Expr)
    -> Int)
-> (Int, Operator (ParsecT CustomError String RuntimeM) Expr)
-> (Int, Operator (ParsecT CustomError String RuntimeM) Expr)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Operator (ParsecT CustomError String RuntimeM) Expr) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
 -> [[(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]])
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
-> [[(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]]
forall a b. (a -> b) -> a -> b
$ ((Int, Operator (ParsecT CustomError String RuntimeM) Expr) -> Int)
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Operator (ParsecT CustomError String RuntimeM) Expr) -> Int
forall a b. (a, b) -> a
fst ([(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
 -> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)])
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
forall a b. (a -> b) -> a -> b
$
    (Int
infixFuncOpPriority, Operator (ParsecT CustomError String RuntimeM) Expr
infixFuncOperator) (Int, Operator (ParsecT CustomError String RuntimeM) Expr)
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
forall a. a -> [a] -> [a]
: (Op -> (Int, Operator (ParsecT CustomError String RuntimeM) Expr))
-> [Op]
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (\Op
op -> (Op -> Int
priority Op
op, Op -> Operator (ParsecT CustomError String RuntimeM) Expr
toOperator Op
op)) [Op]
ops
  where
    -- notFollowedBy (in unary and binary) is necessary for section expression.
    unary :: String -> Parser (Expr -> Expr)
    unary :: String -> Parser (Expr -> Expr)
unary String
sym = String -> Expr -> Expr
PrefixExpr (String -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM String
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> ParsecT CustomError String RuntimeM String
operator String
sym ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> ParsecT CustomError String RuntimeM ()
symbol String
")"))

    binary :: Op -> Parser (Expr -> Expr -> Expr)
    binary :: Op -> Parser (Expr -> Expr -> Expr)
binary Op
op = do
      -- Operators should be indented than pos1 in order to avoid
      -- "1\n-2" (2 topExprs, 1 and -2) to be parsed as "1 - 2".
      Op
op <- ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Pos
indented Parser Pos
-> ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT CustomError String RuntimeM Op
infixLiteral (Op -> String
repr Op
op) ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Op
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> ParsecT CustomError String RuntimeM ()
symbol String
")"))
      (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr))
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ Op -> Expr -> Expr -> Expr
InfixExpr Op
op

    toOperator :: Op -> Operator Parser Expr
    toOperator :: Op -> Operator (ParsecT CustomError String RuntimeM) Expr
toOperator Op
op =
      case Op -> Assoc
assoc Op
op of
        Assoc
E.InfixL -> Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT CustomError String RuntimeM) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> Parser (Expr -> Expr -> Expr)
binary Op
op)
        Assoc
E.InfixR -> Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT CustomError String RuntimeM) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> Parser (Expr -> Expr -> Expr)
binary Op
op)
        Assoc
E.InfixN -> Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT CustomError String RuntimeM) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> Parser (Expr -> Expr -> Expr)
binary Op
op)
        Assoc
E.Prefix -> Parser (Expr -> Expr)
-> Operator (ParsecT CustomError String RuntimeM) Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (String -> Parser (Expr -> Expr)
unary (Op -> String
repr Op
op))

    infixFuncOperator :: Operator Parser Expr
    infixFuncOperator :: Operator (ParsecT CustomError String RuntimeM) Expr
infixFuncOperator = Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT CustomError String RuntimeM) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Parser (Expr -> Expr -> Expr)
 -> Operator (ParsecT CustomError String RuntimeM) Expr)
-> Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT CustomError String RuntimeM) Expr
forall a b. (a -> b) -> a -> b
$ Op -> Expr -> Expr -> Expr
InfixExpr (Op -> Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Op
-> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Op
infixFuncOp

infixFuncOp :: Parser Op
infixFuncOp :: ParsecT CustomError String RuntimeM Op
infixFuncOp = do
  String
func <- ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Pos
indented Parser Pos
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT CustomError String RuntimeM ()
symbol String
"`") (String -> ParsecT CustomError String RuntimeM ()
symbol String
"`") ParsecT CustomError String RuntimeM String
ident)
  Op -> ParsecT CustomError String RuntimeM Op
forall (m :: * -> *) a. Monad m => a -> m a
return (Op -> ParsecT CustomError String RuntimeM Op)
-> Op -> ParsecT CustomError String RuntimeM Op
forall a b. (a -> b) -> a -> b
$ Op :: String -> Int -> Assoc -> Bool -> Op
Op { repr :: String
repr = String
func, priority :: Int
priority = Int
infixFuncOpPriority, assoc :: Assoc
assoc = Assoc
E.InfixL, isWedge :: Bool
isWedge = Bool
False }

infixFuncOpPriority :: Int
infixFuncOpPriority :: Int
infixFuncOpPriority = Int
7

ifExpr :: Parser Expr
ifExpr :: ParsecT CustomError String RuntimeM Expr
ifExpr = String -> ParsecT CustomError String RuntimeM ()
reserved String
"if" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr -> Expr -> Expr
IfExpr (Expr -> Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
expr Parser (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM ()
-> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
reserved String
"then" Parser (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
expr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM () -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
reserved String
"else" Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
expr

patternMatchExpr :: Parser Expr
patternMatchExpr :: ParsecT CustomError String RuntimeM Expr
patternMatchExpr = ParsecT CustomError String RuntimeM ()
-> (Expr -> Expr -> [MatchClause] -> Expr)
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> (Expr -> Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchExpr (String -> ParsecT CustomError String RuntimeM ()
reserved String
"match")       (PMMode -> Expr -> Expr -> [MatchClause] -> Expr
MatchExpr PMMode
BFSMode)
               ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM ()
-> (Expr -> Expr -> [MatchClause] -> Expr)
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> (Expr -> Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchExpr (String -> ParsecT CustomError String RuntimeM ()
reserved String
"matchDFS")    (PMMode -> Expr -> Expr -> [MatchClause] -> Expr
MatchExpr PMMode
DFSMode)
               ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM ()
-> (Expr -> Expr -> [MatchClause] -> Expr)
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> (Expr -> Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchExpr (String -> ParsecT CustomError String RuntimeM ()
reserved String
"matchAll")    (PMMode -> Expr -> Expr -> [MatchClause] -> Expr
MatchAllExpr PMMode
BFSMode)
               ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM ()
-> (Expr -> Expr -> [MatchClause] -> Expr)
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> (Expr -> Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchExpr (String -> ParsecT CustomError String RuntimeM ()
reserved String
"matchAllDFS") (PMMode -> Expr -> Expr -> [MatchClause] -> Expr
MatchAllExpr PMMode
DFSMode)
               ParsecT CustomError String RuntimeM Expr
-> String -> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"pattern match expression"
  where
    makeMatchExpr :: ParsecT CustomError String RuntimeM a
-> (Expr -> Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchExpr ParsecT CustomError String RuntimeM a
keyword Expr -> Expr -> [MatchClause] -> b
ctor = Expr -> Expr -> [MatchClause] -> b
ctor (Expr -> Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (Expr -> [MatchClause] -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomError String RuntimeM a
keyword ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)
                                      ParsecT CustomError String RuntimeM (Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM ([MatchClause] -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"as" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)
                                      ParsecT CustomError String RuntimeM ([MatchClause] -> b)
-> ParsecT CustomError String RuntimeM [MatchClause]
-> ParsecT CustomError String RuntimeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"with" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [MatchClause]
-> ParsecT CustomError String RuntimeM [MatchClause]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [MatchClause]
matchClauses1)

-- Parse more than 1 match clauses.
matchClauses1 :: Parser [MatchClause]
matchClauses1 :: ParsecT CustomError String RuntimeM [MatchClause]
matchClauses1 =
  -- If the first bar '|' is missing, then it is expected to have only one match clause.
  (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|") ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [MatchClause]
-> ParsecT CustomError String RuntimeM [MatchClause]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MatchClause
-> ParsecT CustomError String RuntimeM [MatchClause]
forall a. Parser a -> Parser [a]
alignSome Parser MatchClause
matchClause) ParsecT CustomError String RuntimeM [MatchClause]
-> ParsecT CustomError String RuntimeM [MatchClause]
-> ParsecT CustomError String RuntimeM [MatchClause]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MatchClause -> [MatchClause] -> [MatchClause]
forall a. a -> [a] -> [a]
:[]) (MatchClause -> [MatchClause])
-> Parser MatchClause
-> ParsecT CustomError String RuntimeM [MatchClause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MatchClause
matchClauseWithoutBar
  where
    matchClauseWithoutBar :: Parser MatchClause
    matchClauseWithoutBar :: Parser MatchClause
matchClauseWithoutBar = (,) (Pattern -> Expr -> MatchClause)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM (Expr -> MatchClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Pattern
pattern ParsecT CustomError String RuntimeM (Expr -> MatchClause)
-> ParsecT CustomError String RuntimeM Expr -> Parser MatchClause
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"->" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)

    matchClause :: Parser MatchClause
    matchClause :: Parser MatchClause
matchClause = (,) (Pattern -> Expr -> MatchClause)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM (Expr -> MatchClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Pattern
pattern) ParsecT CustomError String RuntimeM (Expr -> MatchClause)
-> ParsecT CustomError String RuntimeM Expr -> Parser MatchClause
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"->" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)

lambdaExpr :: Parser Expr
lambdaExpr :: ParsecT CustomError String RuntimeM Expr
lambdaExpr = String -> ParsecT CustomError String RuntimeM ()
symbol String
"\\" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (
      ParsecT CustomError String RuntimeM ()
-> (Expr -> [MatchClause] -> Expr)
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> (Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchLambdaExpr (String -> ParsecT CustomError String RuntimeM ()
reserved String
"match")    Expr -> [MatchClause] -> Expr
MatchLambdaExpr
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM ()
-> (Expr -> [MatchClause] -> Expr)
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> (Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchLambdaExpr (String -> ParsecT CustomError String RuntimeM ()
reserved String
"matchAll") Expr -> [MatchClause] -> Expr
MatchAllLambdaExpr
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr -> Expr) -> Parser (Expr -> Expr)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr ([Arg ArgPattern] -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM (Arg ArgPattern)
arg Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM () -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
symbol String
"->") Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
expr
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [String] -> Pattern -> Expr
PatternFunctionExpr ([String] -> Pattern -> Expr)
-> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM (Pattern -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM [String]
forall a. Parser a -> Parser [a]
tupleOrSome ParsecT CustomError String RuntimeM String
lowerId ParsecT CustomError String RuntimeM (Pattern -> Expr)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"=>" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Pattern
pattern))
  ParsecT CustomError String RuntimeM Expr
-> String -> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"lambda or pattern function expression"
  where
    makeMatchLambdaExpr :: ParsecT CustomError String RuntimeM a
-> (Expr -> [MatchClause] -> b)
-> ParsecT CustomError String RuntimeM b
makeMatchLambdaExpr ParsecT CustomError String RuntimeM a
keyword Expr -> [MatchClause] -> b
ctor = do
      Expr
matcher <- ParsecT CustomError String RuntimeM a
keyword ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT CustomError String RuntimeM ()
reserved String
"as" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr
      [MatchClause]
clauses <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"with" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [MatchClause]
-> ParsecT CustomError String RuntimeM [MatchClause]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [MatchClause]
matchClauses1
      b -> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT CustomError String RuntimeM b)
-> b -> ParsecT CustomError String RuntimeM b
forall a b. (a -> b) -> a -> b
$ Expr -> [MatchClause] -> b
ctor Expr
matcher [MatchClause]
clauses

lambdaLikeExpr :: Parser Expr
lambdaLikeExpr :: ParsecT CustomError String RuntimeM Expr
lambdaLikeExpr =
        (String -> ParsecT CustomError String RuntimeM ()
reserved String
"memoizedLambda" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> Expr -> Expr
MemoizedLambdaExpr ([String] -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM [String]
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM [String]
forall a. Parser a -> Parser [a]
tupleOrSome ParsecT CustomError String RuntimeM String
lowerId Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"->" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr))
    ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"cambda"         ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Expr -> Expr
CambdaExpr         (String -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM String
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
lowerId      Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"->" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr))

arg :: Parser (Arg ArgPattern)
arg :: ParsecT CustomError String RuntimeM (Arg ArgPattern)
arg = ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
InvertedScalarArg (ArgPattern -> Arg ArgPattern)
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"*$" ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM ArgPattern
argPatternAtom)
  ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg         (ArgPattern -> Arg ArgPattern)
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'%' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM ArgPattern
argPatternAtom)
  ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
ScalarArg         (ArgPattern -> Arg ArgPattern)
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'$' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM ArgPattern
argPatternAtom)
  ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg         (ArgPattern -> Arg ArgPattern)
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM ArgPattern
argPattern
  ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> String -> ParsecT CustomError String RuntimeM (Arg ArgPattern)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"argument"

argPattern :: Parser ArgPattern
argPattern :: ParsecT CustomError String RuntimeM ArgPattern
argPattern =
  ParsecT CustomError String RuntimeM ArgPattern
argPatternAtom

argPatternAtom :: Parser ArgPattern
argPatternAtom :: ParsecT CustomError String RuntimeM ArgPattern
argPatternAtom
  =   ArgPattern
APWildCard ArgPattern
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ArgPattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  String -> ParsecT CustomError String RuntimeM ()
symbol String
"_"
  ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Arg ArgPattern] -> ArgPattern
APTuplePat ([Arg ArgPattern] -> ArgPattern)
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
-> ParsecT CustomError String RuntimeM ArgPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM [Arg ArgPattern]
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
forall a. Parser a -> Parser a
parens (ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM (Arg ArgPattern)
arg ParsecT CustomError String RuntimeM ()
comma)
  ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM ArgPattern
collectionPattern
  ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VarWithIndices -> ArgPattern
APPatVar   (VarWithIndices -> ArgPattern)
-> Parser VarWithIndices
-> ParsecT CustomError String RuntimeM ArgPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VarWithIndices
varWithIndicesLiteral
    where
      collectionPattern :: ParsecT CustomError String RuntimeM ArgPattern
collectionPattern = ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall a. Parser a -> Parser a
brackets (ParsecT CustomError String RuntimeM ArgPattern
 -> ParsecT CustomError String RuntimeM ArgPattern)
-> ParsecT CustomError String RuntimeM ArgPattern
-> ParsecT CustomError String RuntimeM ArgPattern
forall a b. (a -> b) -> a -> b
$ do
        [Arg ArgPattern]
elems <- ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM (Arg ArgPattern)
arg ParsecT CustomError String RuntimeM ()
comma
        ArgPattern -> ParsecT CustomError String RuntimeM ArgPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (ArgPattern -> ParsecT CustomError String RuntimeM ArgPattern)
-> ArgPattern -> ParsecT CustomError String RuntimeM ArgPattern
forall a b. (a -> b) -> a -> b
$ (Arg ArgPattern -> ArgPattern -> ArgPattern)
-> ArgPattern -> [Arg ArgPattern] -> ArgPattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Arg ArgPattern -> ArgPattern -> ArgPattern
APConsPat ArgPattern
APEmptyPat [Arg ArgPattern]
elems

letExpr :: Parser Expr
letExpr :: ParsecT CustomError String RuntimeM Expr
letExpr = do
  [BindingExpr]
binds <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"let" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [BindingExpr]
oneLiner ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser BindingExpr
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a. Parser a -> Parser [a]
alignSome Parser BindingExpr
binding
  Expr
body  <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"in" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr
  Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ [BindingExpr] -> Expr -> Expr
LetRecExpr [BindingExpr]
binds Expr
body
  where
    oneLiner :: Parser [BindingExpr]
    oneLiner :: ParsecT CustomError String RuntimeM [BindingExpr]
oneLiner = ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a. Parser a -> Parser a
braces (ParsecT CustomError String RuntimeM [BindingExpr]
 -> ParsecT CustomError String RuntimeM [BindingExpr])
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a b. (a -> b) -> a -> b
$ Parser BindingExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser BindingExpr
binding (String -> ParsecT CustomError String RuntimeM ()
symbol String
";")

binding :: Parser BindingExpr
binding :: Parser BindingExpr
binding = do
  Either VarWithIndices PrimitiveDataPattern
id <- VarWithIndices -> Either VarWithIndices PrimitiveDataPattern
forall a b. a -> Either a b
Left (VarWithIndices -> Either VarWithIndices PrimitiveDataPattern)
-> Parser VarWithIndices
-> ParsecT
     CustomError
     String
     RuntimeM
     (Either VarWithIndices PrimitiveDataPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VarWithIndices -> Parser VarWithIndices
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser VarWithIndices
varWithIndicesLiteral' ParsecT
  CustomError
  String
  RuntimeM
  (Either VarWithIndices PrimitiveDataPattern)
-> ParsecT
     CustomError
     String
     RuntimeM
     (Either VarWithIndices PrimitiveDataPattern)
-> ParsecT
     CustomError
     String
     RuntimeM
     (Either VarWithIndices PrimitiveDataPattern)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrimitiveDataPattern -> Either VarWithIndices PrimitiveDataPattern
forall a b. b -> Either a b
Right (PrimitiveDataPattern
 -> Either VarWithIndices PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT
     CustomError
     String
     RuntimeM
     (Either VarWithIndices PrimitiveDataPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdAtom
  [Arg ArgPattern]
args <- ParsecT CustomError String RuntimeM (Arg ArgPattern)
-> ParsecT CustomError String RuntimeM [Arg ArgPattern]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM (Arg ArgPattern)
arg
  Expr
body <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":=" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr
  case (Either VarWithIndices PrimitiveDataPattern
id, [Arg ArgPattern]
args) of
    (Left VarWithIndices
var, [])  -> BindingExpr -> Parser BindingExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (BindingExpr -> Parser BindingExpr)
-> BindingExpr -> Parser BindingExpr
forall a b. (a -> b) -> a -> b
$ VarWithIndices -> Expr -> BindingExpr
BindWithIndices VarWithIndices
var Expr
body
    (Right PrimitiveDataPattern
pdp, []) -> BindingExpr -> Parser BindingExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (BindingExpr -> Parser BindingExpr)
-> BindingExpr -> Parser BindingExpr
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern -> Expr -> BindingExpr
Bind PrimitiveDataPattern
pdp Expr
body
    (Right PrimitiveDataPattern
pdp, [Arg ArgPattern]
_)  -> BindingExpr -> Parser BindingExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (BindingExpr -> Parser BindingExpr)
-> BindingExpr -> Parser BindingExpr
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern -> Expr -> BindingExpr
Bind PrimitiveDataPattern
pdp ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr [Arg ArgPattern]
args Expr
body)
    (Either VarWithIndices PrimitiveDataPattern, [Arg ArgPattern])
_               -> String -> Parser BindingExpr
forall a. HasCallStack => String -> a
error String
"unreachable"

withSymbolsExpr :: Parser Expr
withSymbolsExpr :: ParsecT CustomError String RuntimeM Expr
withSymbolsExpr = [String] -> Expr -> Expr
WithSymbolsExpr ([String] -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM [String]
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"withSymbols" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall a. Parser a -> Parser a
brackets (ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM String
ident ParsecT CustomError String RuntimeM ()
comma)) Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
expr

doExpr :: Parser Expr
doExpr :: ParsecT CustomError String RuntimeM Expr
doExpr = do
  [BindingExpr]
stmts <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"do" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [BindingExpr]
oneLiner ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser BindingExpr
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a. Parser a -> Parser [a]
alignSome Parser BindingExpr
statement
  case [BindingExpr] -> [BindingExpr]
forall a. [a] -> [a]
reverse [BindingExpr]
stmts of
    []                          -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ [BindingExpr] -> Expr -> Expr
DoExpr []           (String -> [Expr] -> Expr
makeApply String
"return" [])
    Bind (PDTuplePat []) Expr
expr:[BindingExpr]
_ -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ [BindingExpr] -> Expr -> Expr
DoExpr ([BindingExpr] -> [BindingExpr]
forall a. [a] -> [a]
init [BindingExpr]
stmts) Expr
expr
    BindingExpr
_:[BindingExpr]
_                         -> CustomError -> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure CustomError
LastStmtInDoBlock
  where
    statement :: Parser BindingExpr
    statement :: Parser BindingExpr
statement = (String -> ParsecT CustomError String RuntimeM ()
reserved String
"let" ParsecT CustomError String RuntimeM ()
-> Parser BindingExpr -> Parser BindingExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser BindingExpr
binding) Parser BindingExpr -> Parser BindingExpr -> Parser BindingExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrimitiveDataPattern -> Expr -> BindingExpr
Bind ([PrimitiveDataPattern] -> PrimitiveDataPattern
forall var. [PDPatternBase var] -> PDPatternBase var
PDTuplePat []) (Expr -> BindingExpr)
-> ParsecT CustomError String RuntimeM Expr -> Parser BindingExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
expr

    oneLiner :: Parser [BindingExpr]
    oneLiner :: ParsecT CustomError String RuntimeM [BindingExpr]
oneLiner = ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a. Parser a -> Parser a
braces (ParsecT CustomError String RuntimeM [BindingExpr]
 -> ParsecT CustomError String RuntimeM [BindingExpr])
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a b. (a -> b) -> a -> b
$ Parser BindingExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser BindingExpr
statement (String -> ParsecT CustomError String RuntimeM ()
symbol String
";")

seqExpr :: Parser Expr
seqExpr :: ParsecT CustomError String RuntimeM Expr
seqExpr = Expr -> Expr -> Expr
SeqExpr (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"seq" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr) Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr

capplyExpr :: Parser Expr
capplyExpr :: ParsecT CustomError String RuntimeM Expr
capplyExpr = Expr -> Expr -> Expr
CApplyExpr (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"capply" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr) Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr

matcherExpr :: Parser Expr
matcherExpr :: ParsecT CustomError String RuntimeM Expr
matcherExpr = do
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"matcher"
  -- Assuming it is unlikely that users want to write matchers with only 1
  -- pattern definition, the first '|' (bar) is made indispensable in matcher
  -- expression.
  [PatternDef] -> Expr
MatcherExpr ([PatternDef] -> Expr)
-> ParsecT CustomError String RuntimeM [PatternDef]
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PatternDef
-> ParsecT CustomError String RuntimeM [PatternDef]
forall a. Parser a -> Parser [a]
alignSome (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|" ParsecT CustomError String RuntimeM ()
-> Parser PatternDef -> Parser PatternDef
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser PatternDef
patternDef)
  where
    patternDef :: Parser (PrimitivePatPattern, Expr, [(PrimitiveDataPattern, Expr)])
    patternDef :: Parser PatternDef
patternDef = do
      PrimitivePatPattern
pp <- Parser PrimitivePatPattern
ppPattern
      Expr
returnMatcher <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"as" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
reserved String
"with"
      [(PrimitiveDataPattern, Expr)]
datapat <- Parser (PrimitiveDataPattern, Expr)
-> Parser [(PrimitiveDataPattern, Expr)]
forall a. Parser a -> Parser [a]
alignSome (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|" ParsecT CustomError String RuntimeM ()
-> Parser (PrimitiveDataPattern, Expr)
-> Parser (PrimitiveDataPattern, Expr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (PrimitiveDataPattern, Expr)
dataCases)
      PatternDef -> Parser PatternDef
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitivePatPattern
pp, Expr
returnMatcher, [(PrimitiveDataPattern, Expr)]
datapat)

    dataCases :: Parser (PrimitiveDataPattern, Expr)
    dataCases :: Parser (PrimitiveDataPattern, Expr)
dataCases = (,) (PrimitiveDataPattern -> Expr -> (PrimitiveDataPattern, Expr))
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT
     CustomError String RuntimeM (Expr -> (PrimitiveDataPattern, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdPattern ParsecT
  CustomError String RuntimeM (Expr -> (PrimitiveDataPattern, Expr))
-> ParsecT CustomError String RuntimeM Expr
-> Parser (PrimitiveDataPattern, Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"->" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)

algebraicDataMatcherExpr :: Parser Expr
algebraicDataMatcherExpr :: ParsecT CustomError String RuntimeM Expr
algebraicDataMatcherExpr = do
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"algebraicDataMatcher"
  [(String, [Expr])] -> Expr
AlgebraicDataMatcherExpr ([(String, [Expr])] -> Expr)
-> ParsecT CustomError String RuntimeM [(String, [Expr])]
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (String, [Expr])
-> ParsecT CustomError String RuntimeM [(String, [Expr])]
forall a. Parser a -> Parser [a]
alignSome (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|" ParsecT CustomError String RuntimeM ()
-> Parser (String, [Expr]) -> Parser (String, [Expr])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (String, [Expr])
patternDef)
  where
    patternDef :: Parser (String, [Expr])
patternDef = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Expr
-> Parser (String, [Expr])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentBlock ParsecT CustomError String RuntimeM String
lowerId ParsecT CustomError String RuntimeM Expr
atomExpr

tensorExpr :: Parser Expr
tensorExpr :: ParsecT CustomError String RuntimeM Expr
tensorExpr =
      (String -> ParsecT CustomError String RuntimeM ()
reserved String
"tensor"         ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr -> Expr
TensorExpr         (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"generateTensor" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr -> Expr
GenerateTensorExpr (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"contract"       ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr
TensorContractExpr (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"tensorMap"      ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr -> Expr
TensorMapExpr      (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"tensorMap2"     ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr -> Expr -> Expr
TensorMap2Expr     (Expr -> Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"transpose"      ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr -> Expr
TransposeExpr      (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)

functionExpr :: Parser Expr
functionExpr :: ParsecT CustomError String RuntimeM Expr
functionExpr = [String] -> Expr
FunctionExpr ([String] -> Expr)
-> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"function" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall a. Parser a -> Parser a
parens (ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM String
ident ParsecT CustomError String RuntimeM ()
comma))

refsExpr :: Parser Expr
refsExpr :: ParsecT CustomError String RuntimeM Expr
refsExpr =
      (String -> ParsecT CustomError String RuntimeM ()
reserved String
"subrefs"   ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Expr -> Expr -> Expr
SubrefsExpr  Bool
False (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"subrefs!"  ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Expr -> Expr -> Expr
SubrefsExpr  Bool
True  (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"suprefs"   ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Expr -> Expr -> Expr
SuprefsExpr  Bool
False (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"suprefs!"  ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Expr -> Expr -> Expr
SuprefsExpr  Bool
True  (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"userRefs"  ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Expr -> Expr -> Expr
UserrefsExpr Bool
False (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)
  ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"userRefs!" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Expr -> Expr -> Expr
UserrefsExpr Bool
True  (Expr -> Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr Parser (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Expr
atomExpr)

collectionExpr :: Parser Expr
collectionExpr :: ParsecT CustomError String RuntimeM Expr
collectionExpr = String -> ParsecT CustomError String RuntimeM ()
symbol String
"[" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
betweenOrFromExpr ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
elementsExpr
  where
    betweenOrFromExpr :: ParsecT CustomError String RuntimeM Expr
betweenOrFromExpr = do
      Expr
start <- ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
symbol String
"..")
      Maybe Expr
end   <- ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM (Maybe Expr)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM (Maybe Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
symbol String
"]"
      case Maybe Expr
end of
        Just Expr
end' -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ String -> [Expr] -> Expr
makeApply String
"between" [Expr
start, Expr
end']
        Maybe Expr
Nothing   -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ String -> [Expr] -> Expr
makeApply String
"from" [Expr
start]

    elementsExpr :: ParsecT CustomError String RuntimeM Expr
elementsExpr = [Expr] -> Expr
CollectionExpr ([Expr] -> Expr)
-> Parser [Expr] -> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM ()
comma Parser [Expr]
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
symbol String
"]")

-- Parse an atomic expression starting with '(', which can be:
--   * a tuple
--   * an arbitrary expression wrapped with parenthesis
--   * section
tupleOrParenExpr :: Parser Expr
tupleOrParenExpr :: ParsecT CustomError String RuntimeM Expr
tupleOrParenExpr = do
  [Expr]
elems <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"(" ParsecT CustomError String RuntimeM ()
-> Parser [Expr] -> Parser [Expr]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser [Expr] -> Parser [Expr]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM ()
comma Parser [Expr]
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
symbol String
")") Parser [Expr] -> Parser [Expr] -> Parser [Expr]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser [Expr]
section Parser [Expr]
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT CustomError String RuntimeM ()
symbol String
")")
  case [Expr]
elems of
    [Expr
x] -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
x                 -- expression wrapped in parenthesis
    [Expr]
_   -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
TupleExpr [Expr]
elems -- tuple
  where
    section :: Parser [Expr]
    -- Start from right, in order to parse expressions like (-1 +) correctly
    section :: Parser [Expr]
section = (Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[]) (Expr -> [Expr])
-> ParsecT CustomError String RuntimeM Expr -> Parser [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomError String RuntimeM Expr
rightSection ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
leftSection)

    -- Sections without the left operand: eg. (+), (+ 1)
    leftSection :: Parser Expr
    leftSection :: ParsecT CustomError String RuntimeM Expr
leftSection = do
      [Op]
ops  <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
exprOps
      Op
op   <- [ParsecT CustomError String RuntimeM Op]
-> ParsecT CustomError String RuntimeM Op
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT CustomError String RuntimeM Op]
 -> ParsecT CustomError String RuntimeM Op)
-> [ParsecT CustomError String RuntimeM Op]
-> ParsecT CustomError String RuntimeM Op
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM Op
infixFuncOp ParsecT CustomError String RuntimeM Op
-> [ParsecT CustomError String RuntimeM Op]
-> [ParsecT CustomError String RuntimeM Op]
forall a. a -> [a] -> [a]
: (Op -> ParsecT CustomError String RuntimeM Op)
-> [Op] -> [ParsecT CustomError String RuntimeM Op]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ParsecT CustomError String RuntimeM Op
infixLiteral (String -> ParsecT CustomError String RuntimeM Op)
-> (Op -> String) -> Op -> ParsecT CustomError String RuntimeM Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op -> String
repr) [Op]
ops
      Maybe Expr
rarg <- ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomError String RuntimeM Expr
expr
      case Maybe Expr
rarg of
        -- Disabling for now... (See issue 159)
        -- Just (InfixExpr op' _ _)
        --   | assoc op' /= InfixR && priority op >= priority op' ->
        --   customFailure (IllFormedSection op op')
        Maybe Expr
_ -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Op -> Maybe Expr -> Maybe Expr -> Expr
SectionExpr Op
op Maybe Expr
forall a. Maybe a
Nothing Maybe Expr
rarg)

    -- Sections with the left operand but lacks the right operand: eg. (1 +)
    rightSection :: Parser Expr
    rightSection :: ParsecT CustomError String RuntimeM Expr
rightSection = do
      [Op]
ops  <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
exprOps
      Expr
larg <- ParsecT CustomError String RuntimeM Expr
opExpr
      Op
op   <- [ParsecT CustomError String RuntimeM Op]
-> ParsecT CustomError String RuntimeM Op
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT CustomError String RuntimeM Op]
 -> ParsecT CustomError String RuntimeM Op)
-> [ParsecT CustomError String RuntimeM Op]
-> ParsecT CustomError String RuntimeM Op
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM Op
infixFuncOp ParsecT CustomError String RuntimeM Op
-> [ParsecT CustomError String RuntimeM Op]
-> [ParsecT CustomError String RuntimeM Op]
forall a. a -> [a] -> [a]
: (Op -> ParsecT CustomError String RuntimeM Op)
-> [Op] -> [ParsecT CustomError String RuntimeM Op]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ParsecT CustomError String RuntimeM Op
infixLiteral (String -> ParsecT CustomError String RuntimeM Op)
-> (Op -> String) -> Op -> ParsecT CustomError String RuntimeM Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op -> String
repr) [Op]
ops
      case Expr
larg of
        -- InfixExpr op' _ _
        --   | assoc op' /= InfixL && priority op >= priority op' ->
        --   customFailure (IllFormedSection op op')
        Expr
_ -> Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Op -> Maybe Expr -> Maybe Expr -> Expr
SectionExpr Op
op (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
larg) Maybe Expr
forall a. Maybe a
Nothing)

vectorExpr :: Parser Expr
vectorExpr :: ParsecT CustomError String RuntimeM Expr
vectorExpr = [Expr] -> Expr
VectorExpr ([Expr] -> Expr)
-> Parser [Expr] -> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> Parser [Expr]
-> Parser [Expr]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT CustomError String RuntimeM ()
symbol String
"[|") (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|]") (ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM ()
comma)

hashExpr :: Parser Expr
hashExpr :: ParsecT CustomError String RuntimeM Expr
hashExpr = [(Expr, Expr)] -> Expr
HashExpr ([(Expr, Expr)] -> Expr)
-> ParsecT CustomError String RuntimeM [(Expr, Expr)]
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM [(Expr, Expr)]
-> ParsecT CustomError String RuntimeM [(Expr, Expr)]
forall a. Parser a -> Parser a
hashBraces (ParsecT CustomError String RuntimeM (Expr, Expr)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [(Expr, Expr)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy ParsecT CustomError String RuntimeM (Expr, Expr)
hashElem ParsecT CustomError String RuntimeM ()
comma)
  where
    hashBraces :: ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
hashBraces = ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT CustomError String RuntimeM ()
symbol String
"{|") (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|}")
    hashElem :: ParsecT CustomError String RuntimeM (Expr, Expr)
hashElem = ParsecT CustomError String RuntimeM (Expr, Expr)
-> ParsecT CustomError String RuntimeM (Expr, Expr)
forall a. Parser a -> Parser a
parens (ParsecT CustomError String RuntimeM (Expr, Expr)
 -> ParsecT CustomError String RuntimeM (Expr, Expr))
-> ParsecT CustomError String RuntimeM (Expr, Expr)
-> ParsecT CustomError String RuntimeM (Expr, Expr)
forall a b. (a -> b) -> a -> b
$ (,) (Expr -> Expr -> (Expr, Expr))
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (Expr -> (Expr, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
expr ParsecT CustomError String RuntimeM (Expr -> (Expr, Expr))
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (Expr, Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT CustomError String RuntimeM ()
comma ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)

index :: Parser a -> Parser (IndexExpr a)
index :: Parser a -> Parser (IndexExpr a)
index Parser a
p = a -> IndexExpr a
forall a. a -> IndexExpr a
SupSubscript (a -> IndexExpr a) -> Parser a -> Parser (IndexExpr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"~_" ParsecT CustomError String RuntimeM String -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p)
    Parser (IndexExpr a)
-> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT CustomError String RuntimeM Char
-> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (IndexExpr a)
subscript)
    Parser (IndexExpr a)
-> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'~' ParsecT CustomError String RuntimeM Char
-> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (IndexExpr a)
superscript)
    Parser (IndexExpr a)
-> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (IndexExpr a) -> Parser (IndexExpr a)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (a -> IndexExpr a
forall a. a -> IndexExpr a
Userscript (a -> IndexExpr a) -> Parser a -> Parser (IndexExpr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'|' ParsecT CustomError String RuntimeM Char -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p))
    Parser (IndexExpr a) -> String -> Parser (IndexExpr a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"index"
  where
    subscript :: Parser (IndexExpr a)
subscript = do
      a
e1 <- Parser a
p
      Maybe a
e2 <- Parser a -> ParsecT CustomError String RuntimeM (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"..._" ParsecT CustomError String RuntimeM String -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p)
      case Maybe a
e2 of
        Maybe a
Nothing  -> IndexExpr a -> Parser (IndexExpr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> Parser (IndexExpr a))
-> IndexExpr a -> Parser (IndexExpr a)
forall a b. (a -> b) -> a -> b
$ a -> IndexExpr a
forall a. a -> IndexExpr a
Subscript a
e1
        Just a
e2' -> IndexExpr a -> Parser (IndexExpr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> Parser (IndexExpr a))
-> IndexExpr a -> Parser (IndexExpr a)
forall a b. (a -> b) -> a -> b
$ a -> a -> IndexExpr a
forall a. a -> a -> IndexExpr a
MultiSubscript a
e1 a
e2'
    superscript :: Parser (IndexExpr a)
superscript = do
      a
e1 <- Parser a
p
      Maybe a
e2 <- Parser a -> ParsecT CustomError String RuntimeM (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"...~" ParsecT CustomError String RuntimeM String -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p)
      case Maybe a
e2 of
        Maybe a
Nothing  -> IndexExpr a -> Parser (IndexExpr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> Parser (IndexExpr a))
-> IndexExpr a -> Parser (IndexExpr a)
forall a b. (a -> b) -> a -> b
$ a -> IndexExpr a
forall a. a -> IndexExpr a
Superscript a
e1
        Just a
e2' -> IndexExpr a -> Parser (IndexExpr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> Parser (IndexExpr a))
-> IndexExpr a -> Parser (IndexExpr a)
forall a b. (a -> b) -> a -> b
$ a -> a -> IndexExpr a
forall a. a -> a -> IndexExpr a
MultiSuperscript a
e1 a
e2'

atomOrApplyExpr :: Parser Expr
atomOrApplyExpr :: ParsecT CustomError String RuntimeM Expr
atomOrApplyExpr = do
  (Expr
func, [Expr]
args) <- ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> Parser (Expr, [Expr])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentBlock ParsecT CustomError String RuntimeM Expr
atomExpr ParsecT CustomError String RuntimeM Expr
atomExpr
  Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ case [Expr]
args of
             [] -> Expr
func
             [Expr]
_  -> Expr -> [Expr] -> Expr
ApplyExpr Expr
func [Expr]
args

-- (Possibly indexed) atomic expressions
atomExpr :: Parser Expr
atomExpr :: ParsecT CustomError String RuntimeM Expr
atomExpr = do
  Expr
e <- ParsecT CustomError String RuntimeM Expr
atomExpr'
  Bool
override <- Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool)
-> ParsecT CustomError String RuntimeM (Maybe String)
-> ParsecT CustomError String RuntimeM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"..." ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM (IndexExpr Expr)
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM (IndexExpr Expr)
-> ParsecT CustomError String RuntimeM (IndexExpr Expr)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (IndexExpr Expr)
forall a. Parser a -> Parser (IndexExpr a)
index ParsecT CustomError String RuntimeM Expr
atomExpr')))
  [IndexExpr Expr]
indices <- ParsecT CustomError String RuntimeM (IndexExpr Expr)
-> ParsecT CustomError String RuntimeM [IndexExpr Expr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (IndexExpr Expr)
forall a. Parser a -> Parser (IndexExpr a)
index ParsecT CustomError String RuntimeM Expr
atomExpr')
  Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ case [IndexExpr Expr]
indices of
             [] -> Expr
e
             [IndexExpr Expr]
_  -> Bool -> Expr -> [IndexExpr Expr] -> Expr
IndexedExpr Bool
override Expr
e [IndexExpr Expr]
indices

-- Atomic expressions without index
atomExpr' :: Parser Expr
atomExpr' :: ParsecT CustomError String RuntimeM Expr
atomExpr' = ParsecT CustomError String RuntimeM Expr
anonParamFuncExpr      -- must come before |constantExpr|
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
anonTupleParamFuncExpr -- must come before |tupleOrParenExpr|
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
anonListParamFuncExpr  -- must come before |collectionExpr|
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConstantExpr -> Expr
ConstantExpr (ConstantExpr -> Expr)
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM ConstantExpr
constantExpr
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr
FreshVarExpr Expr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"#"
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Expr
VarExpr (String -> Expr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
vectorExpr     -- must come before |collectionExpr|
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
collectionExpr
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
tupleOrParenExpr
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Expr
hashExpr
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> Expr
QuoteExpr (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> ParsecT CustomError String RuntimeM ()
symbol String
"`" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomError String RuntimeM String
ident) ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr') -- must come after |constantExpr|
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> Expr
QuoteSymbolExpr (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr')
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Expr
AnonParamExpr  (Integer -> Expr)
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'%' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Integer
positiveIntegerLiteral)
        ParsecT CustomError String RuntimeM Expr
-> String -> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"atomic expression"

anonParamFuncExpr :: Parser Expr
anonParamFuncExpr :: ParsecT CustomError String RuntimeM Expr
anonParamFuncExpr = do
  Integer
n    <- ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'#') -- No space after the index
  Expr
body <- ParsecT CustomError String RuntimeM Expr
atomExpr                    -- No space after '#'
  Expr -> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT CustomError String RuntimeM Expr)
-> Expr -> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ Integer -> Expr -> Expr
AnonParamFuncExpr Integer
n Expr
body

anonTupleParamFuncExpr :: Parser Expr
anonTupleParamFuncExpr :: ParsecT CustomError String RuntimeM Expr
anonTupleParamFuncExpr = do
  Integer
n <- ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'(' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
")#")
  Integer -> Expr -> Expr
AnonTupleParamFuncExpr Integer
n (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr

anonListParamFuncExpr :: Parser Expr
anonListParamFuncExpr :: ParsecT CustomError String RuntimeM Expr
anonListParamFuncExpr = do
  Integer
n <- ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'[' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"]#")
  Integer -> Expr -> Expr
AnonListParamFuncExpr Integer
n (Expr -> Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Expr
atomExpr

constantExpr :: Parser ConstantExpr
constantExpr :: ParsecT CustomError String RuntimeM ConstantExpr
constantExpr = ParsecT CustomError String RuntimeM ConstantExpr
numericExpr
           ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ConstantExpr
BoolExpr (Bool -> ConstantExpr)
-> ParsecT CustomError String RuntimeM Bool
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Bool
boolLiteral
           ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ConstantExpr
CharExpr (Char -> ConstantExpr)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM Char
charLiteral        -- try for quoteExpr
           ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ConstantExpr
StringExpr (Text -> ConstantExpr)
-> (String -> Text) -> String -> ConstantExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> ConstantExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
stringLiteral
           ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConstantExpr
SomethingExpr ConstantExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"something"
           ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConstantExpr
UndefinedExpr ConstantExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"undefined"

numericExpr :: Parser ConstantExpr
numericExpr :: ParsecT CustomError String RuntimeM ConstantExpr
numericExpr = Double -> ConstantExpr
FloatExpr (Double -> ConstantExpr)
-> ParsecT CustomError String RuntimeM Double
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Double
-> ParsecT CustomError String RuntimeM Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM Double
positiveFloatLiteral
          ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> ConstantExpr
IntegerExpr (Integer -> ConstantExpr)
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM ConstantExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Integer
positiveIntegerLiteral
          ParsecT CustomError String RuntimeM ConstantExpr
-> String -> ParsecT CustomError String RuntimeM ConstantExpr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"numeric expression"
--
-- Pattern
--

pattern :: Parser Pattern
pattern :: ParsecT CustomError String RuntimeM Pattern
pattern = ParsecT CustomError String RuntimeM Pattern
letPattern
      ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Pattern
forallPattern
      ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Pattern
loopPattern
      ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Pattern
opPattern
      ParsecT CustomError String RuntimeM Pattern
-> String -> ParsecT CustomError String RuntimeM Pattern
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"pattern"

letPattern :: Parser Pattern
letPattern :: ParsecT CustomError String RuntimeM Pattern
letPattern =
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"let" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [BindingExpr] -> Pattern -> Pattern
LetPat ([BindingExpr] -> Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM (Pattern -> Pattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BindingExpr
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a. Parser a -> Parser [a]
alignSome Parser BindingExpr
binding ParsecT CustomError String RuntimeM (Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"in" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Pattern
pattern)

forallPattern :: Parser Pattern
forallPattern :: ParsecT CustomError String RuntimeM Pattern
forallPattern =
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"forall" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> Pattern -> Pattern
ForallPat (Pattern -> Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM (Pattern -> Pattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Pattern
atomPattern ParsecT CustomError String RuntimeM (Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Pattern
atomPattern

loopPattern :: Parser Pattern
loopPattern :: ParsecT CustomError String RuntimeM Pattern
loopPattern =
  String -> LoopRange -> Pattern -> Pattern -> Pattern
LoopPat (String -> LoopRange -> Pattern -> Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT
     CustomError
     String
     RuntimeM
     (LoopRange -> Pattern -> Pattern -> Pattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"loop" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'$' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
ident) ParsecT
  CustomError
  String
  RuntimeM
  (LoopRange -> Pattern -> Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM LoopRange
-> ParsecT
     CustomError String RuntimeM (Pattern -> Pattern -> Pattern)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM LoopRange
loopRange
          ParsecT CustomError String RuntimeM (Pattern -> Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM (Pattern -> Pattern)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Pattern
atomPattern ParsecT CustomError String RuntimeM (Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Pattern
atomPattern
  where
    loopRange :: Parser LoopRange
    loopRange :: ParsecT CustomError String RuntimeM LoopRange
loopRange =
      ParsecT CustomError String RuntimeM LoopRange
-> ParsecT CustomError String RuntimeM LoopRange
forall a. Parser a -> Parser a
parens (ParsecT CustomError String RuntimeM LoopRange
 -> ParsecT CustomError String RuntimeM LoopRange)
-> ParsecT CustomError String RuntimeM LoopRange
-> ParsecT CustomError String RuntimeM LoopRange
forall a b. (a -> b) -> a -> b
$ do Expr
start <- ParsecT CustomError String RuntimeM Expr
expr
                  Expr
ends  <- Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option (Expr -> Expr
defaultEnds Expr
start) (ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Expr
 -> ParsecT CustomError String RuntimeM Expr)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM ()
comma ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)
                  Pattern
as    <- Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Pattern
WildCard (ParsecT CustomError String RuntimeM ()
comma ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Pattern
pattern)
                  LoopRange -> ParsecT CustomError String RuntimeM LoopRange
forall (m :: * -> *) a. Monad m => a -> m a
return (LoopRange -> ParsecT CustomError String RuntimeM LoopRange)
-> LoopRange -> ParsecT CustomError String RuntimeM LoopRange
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Pattern -> LoopRange
LoopRange Expr
start Expr
ends Pattern
as

    defaultEnds :: Expr -> Expr
defaultEnds Expr
s =
      String -> [Expr] -> Expr
makeApply String
"from"
                [String -> [Expr] -> Expr
makeApply String
"-'" [Expr
s, ConstantExpr -> Expr
ConstantExpr (Integer -> ConstantExpr
IntegerExpr Integer
1)]]

seqPattern :: Parser Pattern
seqPattern :: ParsecT CustomError String RuntimeM Pattern
seqPattern = do
  [Pattern]
pats <- Parser [Pattern] -> Parser [Pattern]
forall a. Parser a -> Parser a
braces (Parser [Pattern] -> Parser [Pattern])
-> Parser [Pattern] -> Parser [Pattern]
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM () -> Parser [Pattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM Pattern
pattern ParsecT CustomError String RuntimeM ()
comma
  Pattern -> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> ParsecT CustomError String RuntimeM Pattern)
-> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall a b. (a -> b) -> a -> b
$ (Pattern -> Pattern -> Pattern) -> Pattern -> [Pattern] -> Pattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pattern -> Pattern -> Pattern
SeqConsPat Pattern
SeqNilPat [Pattern]
pats

opPattern :: Parser Pattern
opPattern :: ParsecT CustomError String RuntimeM Pattern
opPattern = do
  [Op]
ops <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
patternOps
  ParsecT CustomError String RuntimeM Pattern
-> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser ParsecT CustomError String RuntimeM Pattern
applyOrAtomPattern ([Op] -> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
makePatternTable [Op]
ops)

makePatternTable :: [Op] -> [[Operator Parser Pattern]]
makePatternTable :: [Op] -> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
makePatternTable [Op]
ops =
  let ops' :: [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
ops' = (Op
 -> (Int, Operator (ParsecT CustomError String RuntimeM) Pattern))
-> [Op]
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
forall a b. (a -> b) -> [a] -> [b]
map Op -> (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
toOperator [Op]
ops
   in ([(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
 -> [Operator (ParsecT CustomError String RuntimeM) Pattern])
-> [[(Int,
      Operator (ParsecT CustomError String RuntimeM) Pattern)]]
-> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
 -> Operator (ParsecT CustomError String RuntimeM) Pattern)
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
-> [Operator (ParsecT CustomError String RuntimeM) Pattern]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
-> Operator (ParsecT CustomError String RuntimeM) Pattern
forall a b. (a, b) -> b
snd) (((Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
 -> (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
 -> Bool)
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
-> [[(Int,
      Operator (ParsecT CustomError String RuntimeM) Pattern)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
x (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
y -> (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
-> Int
forall a b. (a, b) -> a
fst (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
-> Int
forall a b. (a, b) -> a
fst (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
y) [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
ops')
  where
    toOperator :: Op -> (Int, Operator Parser Pattern)
    toOperator :: Op -> (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
toOperator Op
op = (Op -> Int
priority Op
op, (Op
 -> ParsecT
      CustomError String RuntimeM (Pattern -> Pattern -> Pattern))
-> Op -> Operator (ParsecT CustomError String RuntimeM) Pattern
forall a.
(Op -> Parser (a -> a -> a))
-> Op -> Operator (ParsecT CustomError String RuntimeM) a
infixToOperator Op
-> ParsecT
     CustomError String RuntimeM (Pattern -> Pattern -> Pattern)
binary Op
op)

    binary :: Op -> Parser (Pattern -> Pattern -> Pattern)
    binary :: Op
-> ParsecT
     CustomError String RuntimeM (Pattern -> Pattern -> Pattern)
binary Op
op = do
      Op
op <- ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Pos
indented Parser Pos
-> ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT CustomError String RuntimeM Op
patInfixLiteral (Op -> String
repr Op
op))
      (Pattern -> Pattern -> Pattern)
-> ParsecT
     CustomError String RuntimeM (Pattern -> Pattern -> Pattern)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Pattern -> Pattern -> Pattern)
 -> ParsecT
      CustomError String RuntimeM (Pattern -> Pattern -> Pattern))
-> (Pattern -> Pattern -> Pattern)
-> ParsecT
     CustomError String RuntimeM (Pattern -> Pattern -> Pattern)
forall a b. (a -> b) -> a -> b
$ Op -> Pattern -> Pattern -> Pattern
InfixPat Op
op

applyOrAtomPattern :: Parser Pattern
applyOrAtomPattern :: ParsecT CustomError String RuntimeM Pattern
applyOrAtomPattern = (do
    (Pattern
func, [Pattern]
args) <- ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> Parser (Pattern, [Pattern])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentBlock (ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM Pattern
atomPattern) ParsecT CustomError String RuntimeM Pattern
atomPattern
    case (Pattern
func, [Pattern]
args) of
      (Pattern
_,                 []) -> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern
func
      (InductivePat String
x [], [Pattern]
_)  -> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> ParsecT CustomError String RuntimeM Pattern)
-> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall a b. (a -> b) -> a -> b
$ String -> [Pattern] -> Pattern
InductiveOrPApplyPat String
x [Pattern]
args
      (Pattern, [Pattern])
_                       -> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> ParsecT CustomError String RuntimeM Pattern)
-> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> [Pattern] -> Pattern
DApplyPat Pattern
func [Pattern]
args)
  ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
    (Expr
func, [Pattern]
args) <- ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Pattern
-> Parser (Expr, [Pattern])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentBlock ParsecT CustomError String RuntimeM Expr
atomExpr ParsecT CustomError String RuntimeM Pattern
atomPattern
    Pattern -> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> ParsecT CustomError String RuntimeM Pattern)
-> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall a b. (a -> b) -> a -> b
$ Expr -> [Pattern] -> Pattern
PApplyPat Expr
func [Pattern]
args)

collectionPattern :: Parser Pattern
collectionPattern :: ParsecT CustomError String RuntimeM Pattern
collectionPattern = ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall a. Parser a -> Parser a
brackets (ParsecT CustomError String RuntimeM Pattern
 -> ParsecT CustomError String RuntimeM Pattern)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall a b. (a -> b) -> a -> b
$ do
  [Pattern]
elems <- ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM () -> Parser [Pattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM Pattern
pattern ParsecT CustomError String RuntimeM ()
comma
  Pattern -> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> ParsecT CustomError String RuntimeM Pattern)
-> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall a b. (a -> b) -> a -> b
$ (Pattern -> Pattern -> Pattern) -> Pattern -> [Pattern] -> Pattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Op -> Pattern -> Pattern -> Pattern
InfixPat Op
consOp) Pattern
nilPat [Pattern]
elems
    where
      nilPat :: Pattern
nilPat = String -> [Pattern] -> Pattern
InductivePat String
"nil" []
      consOp :: Op
consOp = String -> [Op] -> Op
findOpFrom String
"::" [Op]
reservedPatternOp

-- (Possibly indexed) atomic pattern
atomPattern :: Parser Pattern
atomPattern :: ParsecT CustomError String RuntimeM Pattern
atomPattern = do
  Pattern
pat     <- ParsecT CustomError String RuntimeM Pattern
atomPattern'
  [Expr]
indices <- ParsecT CustomError String RuntimeM Expr -> Parser [Expr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM Expr -> Parser [Expr])
-> (ParsecT CustomError String RuntimeM Expr
    -> ParsecT CustomError String RuntimeM Expr)
-> ParsecT CustomError String RuntimeM Expr
-> Parser [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Expr -> Parser [Expr])
-> ParsecT CustomError String RuntimeM Expr -> Parser [Expr]
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr'
  Pattern -> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> ParsecT CustomError String RuntimeM Pattern)
-> Pattern -> ParsecT CustomError String RuntimeM Pattern
forall a b. (a -> b) -> a -> b
$ case [Expr]
indices of
             [] -> Pattern
pat
             [Expr]
_  -> Pattern -> [Expr] -> Pattern
IndexedPat Pattern
pat [Expr]
indices

-- Atomic pattern without index
atomPattern' :: Parser Pattern
atomPattern' :: ParsecT CustomError String RuntimeM Pattern
atomPattern' = Pattern
WildCard Pattern
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  String -> ParsecT CustomError String RuntimeM ()
symbol String
"_"
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Pattern
PatVar   (String -> Pattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
patVarLiteral
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern -> Pattern
NotPat   (Pattern -> Pattern)
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"!" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Pattern
atomPattern)
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> Pattern
ValuePat (Expr -> Pattern)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'#' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr)
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Pattern
collectionPattern
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [Pattern] -> Pattern
InductivePat (String -> [Pattern] -> Pattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ([Pattern] -> Pattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
lowerId ParsecT CustomError String RuntimeM ([Pattern] -> Pattern)
-> Parser [Pattern] -> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Pattern] -> Parser [Pattern]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Pattern
VarPat   (String -> Pattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'~' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
lowerId)
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> Pattern
PredPat  (Expr -> Pattern)
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"?" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr)
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern
ContPat  Pattern
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"..."
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Pattern
-> ([Pattern] -> Pattern)
-> ParsecT CustomError String RuntimeM Pattern
forall a. Parser a -> ([a] -> a) -> Parser a
makeTupleOrParen ParsecT CustomError String RuntimeM Pattern
pattern [Pattern] -> Pattern
TuplePat
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM Pattern
seqPattern
           ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern
LaterPatVar Pattern
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Pattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"@"
           ParsecT CustomError String RuntimeM Pattern
-> String -> ParsecT CustomError String RuntimeM Pattern
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"atomic pattern"

ppPattern :: Parser PrimitivePatPattern
ppPattern :: Parser PrimitivePatPattern
ppPattern = String -> [PrimitivePatPattern] -> PrimitivePatPattern
PPInductivePat (String -> [PrimitivePatPattern] -> PrimitivePatPattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT
     CustomError
     String
     RuntimeM
     ([PrimitivePatPattern] -> PrimitivePatPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
lowerId ParsecT
  CustomError
  String
  RuntimeM
  ([PrimitivePatPattern] -> PrimitivePatPattern)
-> ParsecT CustomError String RuntimeM [PrimitivePatPattern]
-> Parser PrimitivePatPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrimitivePatPattern
-> ParsecT CustomError String RuntimeM [PrimitivePatPattern]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser PrimitivePatPattern
ppAtom
        Parser PrimitivePatPattern
-> Parser PrimitivePatPattern -> Parser PrimitivePatPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do [Op]
ops <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
patternOps
               Parser PrimitivePatPattern
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
-> Parser PrimitivePatPattern
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parser PrimitivePatPattern
ppAtom ([Op]
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
makeTable [Op]
ops)
        Parser PrimitivePatPattern -> String -> Parser PrimitivePatPattern
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"primitive pattern pattern"
  where
    makeTable :: [Op] -> [[Operator Parser PrimitivePatPattern]]
    makeTable :: [Op]
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
makeTable [Op]
ops =
      ([Op]
 -> [Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern])
-> [[Op]]
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
forall a b. (a -> b) -> [a] -> [b]
map ((Op
 -> Operator
      (ParsecT CustomError String RuntimeM) PrimitivePatPattern)
-> [Op]
-> [Operator
      (ParsecT CustomError String RuntimeM) PrimitivePatPattern]
forall a b. (a -> b) -> [a] -> [b]
map Op
-> Operator
     (ParsecT CustomError String RuntimeM) PrimitivePatPattern
toOperator) ((Op -> Op -> Bool) -> [Op] -> [[Op]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Op
x Op
y -> Op -> Int
priority Op
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Op -> Int
priority Op
y) [Op]
ops)

    toOperator :: Op -> Operator Parser PrimitivePatPattern
    toOperator :: Op
-> Operator
     (ParsecT CustomError String RuntimeM) PrimitivePatPattern
toOperator = (Op
 -> Parser
      (PrimitivePatPattern
       -> PrimitivePatPattern -> PrimitivePatPattern))
-> Op
-> Operator
     (ParsecT CustomError String RuntimeM) PrimitivePatPattern
forall a.
(Op -> Parser (a -> a -> a))
-> Op -> Operator (ParsecT CustomError String RuntimeM) a
infixToOperator Op
-> Parser
     (PrimitivePatPattern -> PrimitivePatPattern -> PrimitivePatPattern)
inductive2

    inductive2 :: Op
-> Parser
     (PrimitivePatPattern -> PrimitivePatPattern -> PrimitivePatPattern)
inductive2 Op
op = (\PrimitivePatPattern
x PrimitivePatPattern
y -> String -> [PrimitivePatPattern] -> PrimitivePatPattern
PPInductivePat (Op -> String
repr Op
op) [PrimitivePatPattern
x, PrimitivePatPattern
y]) (PrimitivePatPattern -> PrimitivePatPattern -> PrimitivePatPattern)
-> ParsecT CustomError String RuntimeM String
-> Parser
     (PrimitivePatPattern -> PrimitivePatPattern -> PrimitivePatPattern)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM String
operator (Op -> String
repr Op
op)

    ppAtom :: Parser PrimitivePatPattern
    ppAtom :: Parser PrimitivePatPattern
ppAtom = PrimitivePatPattern
PPWildCard PrimitivePatPattern
-> ParsecT CustomError String RuntimeM ()
-> Parser PrimitivePatPattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"_"
         Parser PrimitivePatPattern
-> Parser PrimitivePatPattern -> Parser PrimitivePatPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrimitivePatPattern
PPPatVar   PrimitivePatPattern
-> ParsecT CustomError String RuntimeM ()
-> Parser PrimitivePatPattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"$"
         Parser PrimitivePatPattern
-> Parser PrimitivePatPattern -> Parser PrimitivePatPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> PrimitivePatPattern
PPValuePat (String -> PrimitivePatPattern)
-> ParsecT CustomError String RuntimeM String
-> Parser PrimitivePatPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"#$" ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
lowerId)
         Parser PrimitivePatPattern
-> Parser PrimitivePatPattern -> Parser PrimitivePatPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [PrimitivePatPattern] -> PrimitivePatPattern
PPInductivePat String
"nil" [] PrimitivePatPattern
-> ParsecT CustomError String RuntimeM ()
-> Parser PrimitivePatPattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> ParsecT CustomError String RuntimeM ()
symbol String
"[" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT CustomError String RuntimeM ()
symbol String
"]")
         Parser PrimitivePatPattern
-> Parser PrimitivePatPattern -> Parser PrimitivePatPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PrimitivePatPattern
-> ([PrimitivePatPattern] -> PrimitivePatPattern)
-> Parser PrimitivePatPattern
forall a. Parser a -> ([a] -> a) -> Parser a
makeTupleOrParen Parser PrimitivePatPattern
ppPattern [PrimitivePatPattern] -> PrimitivePatPattern
PPTuplePat

pdPattern :: Parser PrimitiveDataPattern
pdPattern :: ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdPattern = ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitiveDataPattern]]
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdApplyOrAtom [[Operator
    (ParsecT CustomError String RuntimeM) PrimitiveDataPattern]]
table
        ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> String
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"primitive data pattern"
  where
    table :: [[Operator Parser PrimitiveDataPattern]]
    table :: [[Operator
    (ParsecT CustomError String RuntimeM) PrimitiveDataPattern]]
table =
      [ [ ParsecT
  CustomError
  String
  RuntimeM
  (PrimitiveDataPattern
   -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> Operator
     (ParsecT CustomError String RuntimeM) PrimitiveDataPattern
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDConsPat (PrimitiveDataPattern
 -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT
     CustomError
     String
     RuntimeM
     (PrimitiveDataPattern
      -> PrimitiveDataPattern -> PrimitiveDataPattern)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"::") ]
      ]

    pdApplyOrAtom :: Parser PrimitiveDataPattern
    pdApplyOrAtom :: ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdApplyOrAtom = String -> [PrimitiveDataPattern] -> PrimitiveDataPattern
forall var. String -> [PDPatternBase var] -> PDPatternBase var
PDInductivePat (String -> [PrimitiveDataPattern] -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT
     CustomError
     String
     RuntimeM
     ([PrimitiveDataPattern] -> PrimitiveDataPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
upperId ParsecT
  CustomError
  String
  RuntimeM
  ([PrimitiveDataPattern] -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM [PrimitiveDataPattern]
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM [PrimitiveDataPattern]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdAtom
                ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDSnocPat (PrimitiveDataPattern
 -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT
     CustomError
     String
     RuntimeM
     (PrimitiveDataPattern -> PrimitiveDataPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"snoc" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdAtom) ParsecT
  CustomError
  String
  RuntimeM
  (PrimitiveDataPattern -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdAtom
                ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdAtom

pdAtom :: Parser PrimitiveDataPattern
pdAtom :: ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdAtom = PrimitiveDataPattern
forall var. PDPatternBase var
PDWildCard    PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"_"
     ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar      (String -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
patVarLiteral
     ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar      (String -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident
     ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConstantExpr -> PrimitiveDataPattern
forall var. ConstantExpr -> PDPatternBase var
PDConstantPat (ConstantExpr -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM ConstantExpr
constantExpr
     ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdCollection
     ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ([PrimitiveDataPattern] -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. Parser a -> ([a] -> a) -> Parser a
makeTupleOrParen ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdPattern [PrimitiveDataPattern] -> PrimitiveDataPattern
forall var. [PDPatternBase var] -> PDPatternBase var
PDTuplePat
  where
    pdCollection :: Parser PrimitiveDataPattern
    pdCollection :: ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdCollection = do
      [PrimitiveDataPattern]
elts <- ParsecT CustomError String RuntimeM [PrimitiveDataPattern]
-> ParsecT CustomError String RuntimeM [PrimitiveDataPattern]
forall a. Parser a -> Parser a
brackets (ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [PrimitiveDataPattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdPattern ParsecT CustomError String RuntimeM ()
comma)
      PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall (m :: * -> *) a. Monad m => a -> m a
return ((PrimitiveDataPattern
 -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> PrimitiveDataPattern
-> [PrimitiveDataPattern]
-> PrimitiveDataPattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDConsPat PrimitiveDataPattern
forall var. PDPatternBase var
PDEmptyPat [PrimitiveDataPattern]
elts)

--
-- Tokens
--

-- Space Comsumer
sc :: Parser ()
sc :: ParsecT CustomError String RuntimeM ()
sc = ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 ParsecT CustomError String RuntimeM ()
lineCmnt ParsecT CustomError String RuntimeM ()
blockCmnt
  where
    lineCmnt :: ParsecT CustomError String RuntimeM ()
lineCmnt  = Tokens String -> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment String
Tokens String
"--"
    blockCmnt :: ParsecT CustomError String RuntimeM ()
blockCmnt = Tokens String
-> Tokens String -> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockCommentNested String
Tokens String
"{-" String
Tokens String
"-}"

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = ParsecT CustomError String RuntimeM () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT CustomError String RuntimeM ()
sc

positiveIntegerLiteral :: Parser Integer
positiveIntegerLiteral :: ParsecT CustomError String RuntimeM Integer
positiveIntegerLiteral = ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall a. Parser a -> Parser a
lexeme ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
                     ParsecT CustomError String RuntimeM Integer
-> String -> ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"unsinged integer"

charLiteral :: Parser Char
charLiteral :: ParsecT CustomError String RuntimeM Char
charLiteral = ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'') (String -> ParsecT CustomError String RuntimeM ()
symbol String
"\'") ParsecT CustomError String RuntimeM Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral
          ParsecT CustomError String RuntimeM Char
-> String -> ParsecT CustomError String RuntimeM Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"character"

stringLiteral :: Parser String
stringLiteral :: ParsecT CustomError String RuntimeM String
stringLiteral = Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\"' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT CustomError String RuntimeM Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (String -> ParsecT CustomError String RuntimeM ()
symbol String
"\"")
          ParsecT CustomError String RuntimeM String
-> String -> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"string"

boolLiteral :: Parser Bool
boolLiteral :: ParsecT CustomError String RuntimeM Bool
boolLiteral = String -> ParsecT CustomError String RuntimeM ()
reserved String
"True"  ParsecT CustomError String RuntimeM ()
-> Bool -> ParsecT CustomError String RuntimeM Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
          ParsecT CustomError String RuntimeM Bool
-> ParsecT CustomError String RuntimeM Bool
-> ParsecT CustomError String RuntimeM Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT CustomError String RuntimeM ()
reserved String
"False" ParsecT CustomError String RuntimeM ()
-> Bool -> ParsecT CustomError String RuntimeM Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
          ParsecT CustomError String RuntimeM Bool
-> String -> ParsecT CustomError String RuntimeM Bool
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"boolean"

positiveFloatLiteral :: Parser Double
positiveFloatLiteral :: ParsecT CustomError String RuntimeM Double
positiveFloatLiteral = ParsecT CustomError String RuntimeM Double
-> ParsecT CustomError String RuntimeM Double
forall a. Parser a -> Parser a
lexeme ParsecT CustomError String RuntimeM Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float
           ParsecT CustomError String RuntimeM Double
-> String -> ParsecT CustomError String RuntimeM Double
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"unsigned float"

varWithIndicesLiteral :: Parser VarWithIndices
varWithIndicesLiteral :: Parser VarWithIndices
varWithIndicesLiteral =
  Parser VarWithIndices -> Parser VarWithIndices
forall a. Parser a -> Parser a
lexeme (String -> [VarIndex] -> VarWithIndices
VarWithIndices (String -> [VarIndex] -> VarWithIndices)
-> ParsecT CustomError String RuntimeM String
-> ParsecT
     CustomError String RuntimeM ([VarIndex] -> VarWithIndices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident' ParsecT CustomError String RuntimeM ([VarIndex] -> VarWithIndices)
-> ParsecT CustomError String RuntimeM [VarIndex]
-> Parser VarWithIndices
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM [VarIndex]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM VarIndex
varIndex)

varWithIndicesLiteral' :: Parser VarWithIndices
varWithIndicesLiteral' :: Parser VarWithIndices
varWithIndicesLiteral' =
  Parser VarWithIndices -> Parser VarWithIndices
forall a. Parser a -> Parser a
lexeme (String -> [VarIndex] -> VarWithIndices
VarWithIndices (String -> [VarIndex] -> VarWithIndices)
-> ParsecT CustomError String RuntimeM String
-> ParsecT
     CustomError String RuntimeM ([VarIndex] -> VarWithIndices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident' ParsecT CustomError String RuntimeM ([VarIndex] -> VarWithIndices)
-> ParsecT CustomError String RuntimeM [VarIndex]
-> Parser VarWithIndices
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM [VarIndex]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM VarIndex
varIndex)

varIndex :: Parser VarIndex
varIndex :: ParsecT CustomError String RuntimeM VarIndex
varIndex = (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM VarIndex
subscript)
       ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'~' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM VarIndex
supscript)
       ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall a. Parser a -> Parser a
parens ([VarIndex] -> VarIndex
VGroupScripts ([VarIndex] -> VarIndex)
-> ParsecT CustomError String RuntimeM [VarIndex]
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM [VarIndex]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM VarIndex
varIndex)
       ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall a. Parser a -> Parser a
braces ([VarIndex] -> VarIndex
VSymmScripts ([VarIndex] -> VarIndex)
-> ParsecT CustomError String RuntimeM [VarIndex]
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM [VarIndex]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM VarIndex
varIndex)
       ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall a. Parser a -> Parser a
brackets ([VarIndex] -> VarIndex
VAntiSymmScripts ([VarIndex] -> VarIndex)
-> ParsecT CustomError String RuntimeM [VarIndex]
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM [VarIndex]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM VarIndex
varIndex)
  where
    subscript :: ParsecT CustomError String RuntimeM VarIndex
subscript = String -> VarIndex
VSubscript (String -> VarIndex)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident'
            ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
              (String
n, Integer
s) <- Parser (String, Integer) -> Parser (String, Integer)
forall a. Parser a -> Parser a
parens (Parser (String, Integer) -> Parser (String, Integer))
-> Parser (String, Integer) -> Parser (String, Integer)
forall a b. (a -> b) -> a -> b
$ (,) (String -> Integer -> (String, Integer))
-> ParsecT CustomError String RuntimeM String
-> ParsecT
     CustomError String RuntimeM (Integer -> (String, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident' ParsecT CustomError String RuntimeM (Integer -> (String, Integer))
-> ParsecT CustomError String RuntimeM Integer
-> Parser (String, Integer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Integer
positiveIntegerLiteral)
              Char
_ <- Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"..." ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_'
              String
e <- ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a. Parser a -> Parser a
parens (ParsecT CustomError String RuntimeM String
 -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a b. (a -> b) -> a -> b
$ Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
n ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
ident'
              VarIndex -> ParsecT CustomError String RuntimeM VarIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Integer -> String -> VarIndex
VMultiSubscript String
n Integer
s String
e))
    supscript :: ParsecT CustomError String RuntimeM VarIndex
supscript = String -> VarIndex
VSuperscript (String -> VarIndex)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident'
            ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
              (String
n, Integer
s) <- Parser (String, Integer) -> Parser (String, Integer)
forall a. Parser a -> Parser a
parens (Parser (String, Integer) -> Parser (String, Integer))
-> Parser (String, Integer) -> Parser (String, Integer)
forall a b. (a -> b) -> a -> b
$ (,) (String -> Integer -> (String, Integer))
-> ParsecT CustomError String RuntimeM String
-> ParsecT
     CustomError String RuntimeM (Integer -> (String, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident' ParsecT CustomError String RuntimeM (Integer -> (String, Integer))
-> ParsecT CustomError String RuntimeM Integer
-> Parser (String, Integer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Integer
positiveIntegerLiteral)
              Char
_ <- Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"..." ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'~'
              String
e <- ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a. Parser a -> Parser a
parens (ParsecT CustomError String RuntimeM String
 -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a b. (a -> b) -> a -> b
$ Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
n ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
ident'
              VarIndex -> ParsecT CustomError String RuntimeM VarIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Integer -> String -> VarIndex
VMultiSuperscript String
n Integer
s String
e))

patVarLiteral :: Parser String
patVarLiteral :: ParsecT CustomError String RuntimeM String
patVarLiteral = Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'$' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
ident

-- Parse infix (binary operator) literal.
-- If the operator is prefixed with '!', |isWedge| is turned to true.
infixLiteral :: String -> Parser Op
infixLiteral :: String -> ParsecT CustomError String RuntimeM Op
infixLiteral String
sym =
  ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (do Maybe Char
wedge <- ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'!')
          String
opSym <- String -> ParsecT CustomError String RuntimeM String
operator' String
sym
          [Op]
ops   <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
exprOps
          let opInfo :: Op
opInfo = String -> [Op] -> Op
findOpFrom String
opSym [Op]
ops
          Op -> ParsecT CustomError String RuntimeM Op
forall (m :: * -> *) a. Monad m => a -> m a
return (Op -> ParsecT CustomError String RuntimeM Op)
-> Op -> ParsecT CustomError String RuntimeM Op
forall a b. (a -> b) -> a -> b
$ Op
opInfo { isWedge :: Bool
isWedge = Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
wedge })
   ParsecT CustomError String RuntimeM Op
-> String -> ParsecT CustomError String RuntimeM Op
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"infix"
  where
    -- operator without try
    operator' :: String -> Parser String
    operator' :: String -> ParsecT CustomError String RuntimeM String
operator' String
sym = Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
sym ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomError String RuntimeM Char
opChar ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
sc

reserved :: String -> Parser ()
reserved :: String -> ParsecT CustomError String RuntimeM ()
reserved String
w = (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a. Parser a -> Parser a
lexeme (ParsecT CustomError String RuntimeM ()
 -> ParsecT CustomError String RuntimeM ())
-> (ParsecT CustomError String RuntimeM ()
    -> ParsecT CustomError String RuntimeM ())
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
w ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomError String RuntimeM Char
identChar)

symbol :: String -> Parser ()
symbol :: String -> ParsecT CustomError String RuntimeM ()
symbol String
sym = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM ()
-> Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT CustomError String RuntimeM ()
sc String
Tokens String
sym) ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT CustomError String RuntimeM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

operator :: String -> Parser String
operator :: String -> ParsecT CustomError String RuntimeM String
operator String
sym = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM String
 -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a b. (a -> b) -> a -> b
$ Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
sym ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomError String RuntimeM Char
opChar ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
sc

-- |infixLiteral| for pattern infixes.
patInfixLiteral :: String -> Parser Op
patInfixLiteral :: String -> ParsecT CustomError String RuntimeM Op
patInfixLiteral String
sym =
  ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (do String
opSym <- Tokens String
-> ParsecT CustomError String RuntimeM (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
sym ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomError String RuntimeM Char
patOpChar ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
sc
          [Op]
ops   <- (RState -> [Op]) -> ParsecT CustomError String RuntimeM [Op]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> [Op]
patternOps
          let opInfo :: Op
opInfo = String -> [Op] -> Op
findOpFrom String
opSym [Op]
ops
          Op -> ParsecT CustomError String RuntimeM Op
forall (m :: * -> *) a. Monad m => a -> m a
return Op
opInfo)

-- Characters that can consist expression operators.
opChar :: Parser Char
opChar :: ParsecT CustomError String RuntimeM Char
opChar = [Token String]
-> ParsecT CustomError String RuntimeM (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"%^&*-+\\|:<>?!./'#@$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"∧")

-- Characters that can consist pattern operators.
-- ! ? # @ $ are omitted because they can appear at the beginning of atomPattern
patOpChar :: Parser Char
patOpChar :: ParsecT CustomError String RuntimeM Char
patOpChar = [Token String]
-> ParsecT CustomError String RuntimeM (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token String]
"%^&*-+\\|:<>./'"

newPatOp :: Parser String
newPatOp :: ParsecT CustomError String RuntimeM String
newPatOp = (:) (Char -> String -> String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Char
patOpChar ParsecT CustomError String RuntimeM (String -> String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM Char
patOpChar ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token String]
-> ParsecT CustomError String RuntimeM (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token String]
"!?#@$")

-- Characters that consist identifiers.
-- Note that 'alphaNumChar' can also parse greek letters.
identChar :: Parser Char
identChar :: ParsecT CustomError String RuntimeM Char
identChar = ParsecT CustomError String RuntimeM Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
        ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token String]
-> ParsecT CustomError String RuntimeM (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf ([Char
'?', Char
'\'', Char
'/'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mathSymbols)

identString :: Parser String
identString :: ParsecT CustomError String RuntimeM String
identString = do
  [String]
strs <- ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM String
substr
  String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT CustomError String RuntimeM String)
-> String -> ParsecT CustomError String RuntimeM String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
strs
  where
    substr :: ParsecT CustomError String RuntimeM String
substr = ((:) (Char -> String -> String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'.' ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token String -> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'.')) ParsecT CustomError String RuntimeM (String -> String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM Char
opChar)
         ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM Char
identChar

-- Non-alphabetical symbols that are allowed for identifiers
mathSymbols :: String
mathSymbols :: String
mathSymbols = String
"∂∇"

parens :: Parser a -> Parser a
parens :: Parser a -> Parser a
parens = ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM () -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT CustomError String RuntimeM ()
symbol String
"(") (String -> ParsecT CustomError String RuntimeM ()
symbol String
")")

braces :: Parser a -> Parser a
braces :: Parser a -> Parser a
braces = ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM () -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT CustomError String RuntimeM ()
symbol String
"{") (String -> ParsecT CustomError String RuntimeM ()
symbol String
"}")

brackets :: Parser a -> Parser a
brackets :: Parser a -> Parser a
brackets  = ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM () -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT CustomError String RuntimeM ()
symbol String
"[") (String -> ParsecT CustomError String RuntimeM ()
symbol String
"]")

comma :: Parser ()
comma :: ParsecT CustomError String RuntimeM ()
comma = String -> ParsecT CustomError String RuntimeM ()
symbol String
","

-- Notes on identifiers:
-- * Identifiers must be able to include greek letters and some symbols in
--   |mathSymbols|.
-- * Only identifiers starting with capital English letters ('A' - 'Z') can be
--   parsed as |upperId|. Identifiers starting with capital Greek letters must
--   be regarded as |lowerId|.

lowerId :: Parser String
lowerId :: ParsecT CustomError String RuntimeM String
lowerId = (ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a. Parser a -> Parser a
lexeme (ParsecT CustomError String RuntimeM String
 -> ParsecT CustomError String RuntimeM String)
-> (ParsecT CustomError String RuntimeM String
    -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (ParsecT CustomError String RuntimeM String
p ParsecT CustomError String RuntimeM String
-> (String -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *). MonadFail m => String -> m String
check)
  where
    p :: ParsecT CustomError String RuntimeM String
p = (:) (Char -> String -> String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> Bool)
-> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token String -> Bool
checkHead ParsecT CustomError String RuntimeM (String -> String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM String
identString
    checkHead :: Char -> Bool
checkHead Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
mathSymbols Bool -> Bool -> Bool
|| Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isAsciiUpper Char
c)
    check :: String -> m String
check String
x = if String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lowerReservedWords
                then String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"keyword " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be an identifier"
                else String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

upperId :: Parser String
upperId :: ParsecT CustomError String RuntimeM String
upperId = (ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a. Parser a -> Parser a
lexeme (ParsecT CustomError String RuntimeM String
 -> ParsecT CustomError String RuntimeM String)
-> (ParsecT CustomError String RuntimeM String
    -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (ParsecT CustomError String RuntimeM String
p ParsecT CustomError String RuntimeM String
-> (String -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *). MonadFail m => String -> m String
check)
  where
    p :: ParsecT CustomError String RuntimeM String
p = (:) (Char -> String -> String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> Bool)
-> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token String -> Bool
isAsciiUpper ParsecT CustomError String RuntimeM (String -> String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
    check :: String -> m String
check String
x = if String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
upperReservedWords
                then String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"keyword " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be an identifier"
                else String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

-- union of lowerId and upperId
ident :: Parser String
ident :: ParsecT CustomError String RuntimeM String
ident = (ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a. Parser a -> Parser a
lexeme (ParsecT CustomError String RuntimeM String
 -> ParsecT CustomError String RuntimeM String)
-> (ParsecT CustomError String RuntimeM String
    -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (ParsecT CustomError String RuntimeM String
p ParsecT CustomError String RuntimeM String
-> (String -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *). MonadFail m => String -> m String
check)
  where
    p :: ParsecT CustomError String RuntimeM String
p = (:) (Char -> String -> String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> Bool)
-> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token String -> Bool
checkHead ParsecT CustomError String RuntimeM (String -> String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM String
identString
    checkHead :: Char -> Bool
checkHead Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
mathSymbols Bool -> Bool -> Bool
|| Char -> Bool
isLetter Char
c
    check :: String -> m String
check String
x = if String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([String]
lowerReservedWords [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
upperReservedWords)
                then String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"keyword " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be an identifier"
                else String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

-- |ident| not followed by a space
ident' :: Parser String
ident' :: ParsecT CustomError String RuntimeM String
ident' = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM String
p ParsecT CustomError String RuntimeM String
-> (String -> ParsecT CustomError String RuntimeM String)
-> ParsecT CustomError String RuntimeM String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT CustomError String RuntimeM String
forall (m :: * -> *). MonadFail m => String -> m String
check)
  where
    p :: ParsecT CustomError String RuntimeM String
p = (:) (Char -> String -> String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token String -> Bool)
-> ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token String -> Bool
checkHead ParsecT CustomError String RuntimeM (String -> String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM String
identString
    checkHead :: Char -> Bool
checkHead Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
mathSymbols Bool -> Bool -> Bool
|| Char -> Bool
isLetter Char
c
    check :: String -> m String
check String
x = if String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([String]
lowerReservedWords [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
upperReservedWords)
                then String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"keyword " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be an identifier"
                else String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

upperReservedWords :: [String]
upperReservedWords :: [String]
upperReservedWords =
  [ String
"True"
  , String
"False"
  ]

lowerReservedWords :: [String]
lowerReservedWords :: [String]
lowerReservedWords =
  [ String
"loadFile"
  , String
"load"
  , String
"def"
  , String
"if"
  , String
"then"
  , String
"else"
  , String
"seq"
  , String
"capply"
  , String
"memoizedLambda"
  , String
"cambda"
  , String
"let"
  , String
"in"
  , String
"where"
  , String
"withSymbols"
  , String
"loop"
  , String
"forall"
  , String
"match"
  , String
"matchDFS"
  , String
"matchAll"
  , String
"matchAllDFS"
  , String
"as"
  , String
"with"
  , String
"matcher"
  , String
"do"
  , String
"something"
  , String
"undefined"
  , String
"algebraicDataMatcher"
  , String
"generateTensor"
  , String
"tensor"
  , String
"contract"
  , String
"tensorMap"
  , String
"tensorMap2"
  , String
"transpose"
  , String
"subrefs"
  , String
"subrefs!"
  , String
"suprefs"
  , String
"suprefs!"
  , String
"userRefs"
  , String
"userRefs!"
  , String
"function"
  , String
"infixl"
  , String
"infixr"
  , String
"infix"
  ]

--
-- Utils
--

makeTupleOrParen :: Parser a -> ([a] -> a) -> Parser a
makeTupleOrParen :: Parser a -> ([a] -> a) -> Parser a
makeTupleOrParen Parser a
parser [a] -> a
tupleCtor = do
  [a]
elems <- Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
parens (Parser [a] -> Parser [a]) -> Parser [a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ Parser a -> ParsecT CustomError String RuntimeM () -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser a
parser ParsecT CustomError String RuntimeM ()
comma
  case [a]
elems of
    [a
elem] -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
elem
    [a]
_      -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ [a] -> a
tupleCtor [a]
elems

indentGuardEQ :: Pos -> Parser Pos
indentGuardEQ :: Pos -> Parser Pos
indentGuardEQ Pos
pos = ParsecT CustomError String RuntimeM ()
-> Ordering -> Pos -> Parser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
L.indentGuard ParsecT CustomError String RuntimeM ()
sc Ordering
EQ Pos
pos

indentGuardGT :: Pos -> Parser Pos
indentGuardGT :: Pos -> Parser Pos
indentGuardGT Pos
pos = ParsecT CustomError String RuntimeM ()
-> Ordering -> Pos -> Parser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
L.indentGuard ParsecT CustomError String RuntimeM ()
sc Ordering
GT Pos
pos

-- Variant of 'some' that requires every element to be at the same indentation level
alignSome :: Parser a -> Parser [a]
alignSome :: Parser a -> Parser [a]
alignSome Parser a
p = do
  Pos
pos <- Parser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  Parser a -> Parser [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Pos -> Parser Pos
indentGuardEQ Pos
pos Parser Pos -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p)

-- Useful for parsing syntax like function applications, where all 'arguments'
-- should be indented deeper than the 'function'.
indentBlock :: Parser a -> Parser b -> Parser (a, [b])
indentBlock :: Parser a -> Parser b -> Parser (a, [b])
indentBlock Parser a
phead Parser b
parg = do
  Pos
pos  <- Parser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  a
head <- Parser a
phead
  [b]
args <- Parser b -> ParsecT CustomError String RuntimeM [b]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Pos -> Parser Pos
indentGuardGT Pos
pos Parser Pos -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser b
parg)
  (a, [b]) -> Parser (a, [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
head, [b]
args)

indented :: Parser Pos
indented :: Parser Pos
indented = Pos -> Parser Pos
indentGuardGT Pos
pos1

infixToOperator :: (Op -> Parser (a -> a -> a)) -> Op -> Operator Parser a
infixToOperator :: (Op -> Parser (a -> a -> a))
-> Op -> Operator (ParsecT CustomError String RuntimeM) a
infixToOperator Op -> Parser (a -> a -> a)
opToParser Op
op =
  case Op -> Assoc
assoc Op
op of
    Assoc
E.InfixL -> Parser (a -> a -> a)
-> Operator (ParsecT CustomError String RuntimeM) a
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> Parser (a -> a -> a)
opToParser Op
op)
    Assoc
E.InfixR -> Parser (a -> a -> a)
-> Operator (ParsecT CustomError String RuntimeM) a
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> Parser (a -> a -> a)
opToParser Op
op)
    Assoc
E.InfixN -> Parser (a -> a -> a)
-> Operator (ParsecT CustomError String RuntimeM) a
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> Parser (a -> a -> a)
opToParser Op
op)

tupleOrSome :: Parser a -> Parser [a]
tupleOrSome :: Parser a -> Parser [a]
tupleOrSome Parser a
p = Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
parens (Parser a -> ParsecT CustomError String RuntimeM () -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser a
p ParsecT CustomError String RuntimeM ()
comma) Parser [a] -> Parser [a] -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a -> Parser [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser a
p