{-# 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                     (catMaybes, 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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
$c== :: CustomError -> CustomError -> Bool
== :: CustomError -> CustomError -> Bool
$c/= :: CustomError -> CustomError -> Bool
/= :: 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
$ccompare :: CustomError -> CustomError -> Ordering
compare :: CustomError -> CustomError -> Ordering
$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
>= :: CustomError -> CustomError -> Bool
$cmax :: CustomError -> CustomError -> CustomError
max :: CustomError -> CustomError -> CustomError
$cmin :: CustomError -> CustomError -> CustomError
min :: CustomError -> CustomError -> 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 :: forall a. Parser a -> String -> RuntimeM (Either String a)
doParse Parser a
p String
input = do
  Either (ParseErrorBundle String CustomError) a
result <- Parser a
-> String
-> String
-> ReaderT
     EgisonOpts
     (StateT RState IO)
     (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 a. a -> ReaderT EgisonOpts (StateT RState IO) 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 a. a -> ReaderT EgisonOpts (StateT RState IO) 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TopExpr
patternFunctionExpr ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
defineExpr)
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
declareSymbolExpr
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TopExpr
patternInductiveExpr
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
inductiveExpr
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
classExpr
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
instanceExpr
      ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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"

-- | Parse pattern inductive type declaration
-- e.g., inductive pattern MyList a := | myNil | myCons a (MyList a)
--       inductive pattern [a] := | (::) a [a] | (++) [a] [a]
patternInductiveExpr :: Parser TopExpr
patternInductiveExpr :: ParsecT CustomError String RuntimeM TopExpr
patternInductiveExpr = ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TopExpr
 -> ParsecT CustomError String RuntimeM TopExpr)
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ do
  Pos
pos <- ParsecT CustomError String RuntimeM Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"inductive"
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"pattern"
  -- Type name can be either uppercase identifier or list type [a]
  (String
typeName, [String]
typeParams) <- ParsecT CustomError String RuntimeM (String, [String])
-> ParsecT CustomError String RuntimeM (String, [String])
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM (String, [String])
listTypeName ParsecT CustomError String RuntimeM (String, [String])
-> ParsecT CustomError String RuntimeM (String, [String])
-> ParsecT CustomError String RuntimeM (String, [String])
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM (String, [String])
regularTypeName
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
  -- Parse constructors - they must be indented more than the 'inductive pattern' keyword
  -- or on the same line separated by |
  [PatternConstructor]
constructors <- Pos -> Parser [PatternConstructor]
patternConstructors Pos
pos
  TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopExpr -> ParsecT CustomError String RuntimeM TopExpr)
-> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [PatternConstructor] -> TopExpr
PatternInductiveDecl String
typeName [String]
typeParams [PatternConstructor]
constructors
  where
    regularTypeName :: ParsecT CustomError String RuntimeM (String, [String])
regularTypeName = do
      String
name <- ParsecT CustomError String RuntimeM String
upperId
      [String]
params <- 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
typeVarIdent
      (String, [String])
-> ParsecT CustomError String RuntimeM (String, [String])
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [String]
params)
    listTypeName :: ParsecT CustomError String RuntimeM (String, [String])
listTypeName = do
      -- Parse [a] as type name "[]" with type parameter "a"
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"["
      String
param <- ParsecT CustomError String RuntimeM String
typeVarIdent
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"]"
      (String, [String])
-> ParsecT CustomError String RuntimeM (String, [String])
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"[]", [String
param])

-- | Parse constructors for pattern inductive type
patternConstructors :: Pos -> Parser [PatternConstructor]
patternConstructors :: Pos -> Parser [PatternConstructor]
patternConstructors Pos
basePos = do
  -- Optional leading |
  Maybe ()
_ <- ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|")
  PatternConstructor
first <- Parser PatternConstructor
patternConstructor
  [PatternConstructor]
rest <- Parser PatternConstructor -> Parser [PatternConstructor]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser PatternConstructor -> Parser [PatternConstructor])
-> Parser PatternConstructor -> Parser [PatternConstructor]
forall a b. (a -> b) -> a -> b
$ Parser PatternConstructor -> Parser PatternConstructor
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser PatternConstructor -> Parser PatternConstructor)
-> Parser PatternConstructor -> Parser PatternConstructor
forall a b. (a -> b) -> a -> b
$ do
    -- Either | separator or indented on new line
    (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|" ParsecT CustomError String RuntimeM ()
-> Parser PatternConstructor -> Parser PatternConstructor
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser PatternConstructor
patternConstructor) Parser PatternConstructor
-> Parser PatternConstructor -> Parser PatternConstructor
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Pos -> ParsecT CustomError String RuntimeM Pos
indentGuardGT Pos
basePos ParsecT CustomError String RuntimeM Pos
-> Parser PatternConstructor -> Parser PatternConstructor
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser PatternConstructor
patternConstructor)
  [PatternConstructor] -> Parser [PatternConstructor]
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatternConstructor
first PatternConstructor -> [PatternConstructor] -> [PatternConstructor]
forall a. a -> [a] -> [a]
: [PatternConstructor]
rest)

-- | Parse a single pattern constructor
-- e.g., [], myNil, myCons a (MyList a), (::) a [a], (++) [a] [a]
-- Note: Infix operator notation (e.g., a :: [a]) is not supported.
--       Only prefix notation with operators in parentheses (e.g., (::) a [a]) is allowed.
patternConstructor :: Parser PatternConstructor
patternConstructor :: Parser PatternConstructor
patternConstructor = Parser PatternConstructor
prefixPatternConstructor
  where
    -- Prefix notation: [], myNil, myCons a (MyList a), (::) a [a]
    prefixPatternConstructor :: Parser PatternConstructor
prefixPatternConstructor = do
      String
name <- ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM String
emptyListConstructor ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM String
parenOperator ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM String
lowerId  -- Pattern constructors can be [], operator in parens, or lowercase identifier
      -- Parse argument types
      [TypeExpr]
args <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
inductiveArgType)
      PatternConstructor -> Parser PatternConstructor
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatternConstructor -> Parser PatternConstructor)
-> PatternConstructor -> Parser PatternConstructor
forall a b. (a -> b) -> a -> b
$ String -> [TypeExpr] -> PatternConstructor
PatternConstructor String
name [TypeExpr]
args
    
    -- Empty list constructor: []
    emptyListConstructor :: ParsecT CustomError String RuntimeM String
emptyListConstructor = do
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"[]"
      String -> ParsecT CustomError String RuntimeM String
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"[]"
    
    parenOperator :: ParsecT CustomError String RuntimeM [Token String]
parenOperator = do
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"("
      [Token String]
op <- ParsecT CustomError String RuntimeM (Token String)
-> ParsecT CustomError String RuntimeM [Token String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([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 -> ParsecT CustomError String RuntimeM ()
symbol String
")"
      [Token String]
-> ParsecT CustomError String RuntimeM [Token String]
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Token String]
op

-- | Parse inductive data type declaration
-- e.g., inductive Ordering := | Less | Equal | Greater
--       inductive Nat := | O | S Nat
--       inductive Ordering := Less | Equal | Greater  (also valid)
inductiveExpr :: Parser TopExpr
inductiveExpr :: ParsecT CustomError String RuntimeM TopExpr
inductiveExpr = ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TopExpr
 -> ParsecT CustomError String RuntimeM TopExpr)
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ do
  Pos
pos <- ParsecT CustomError String RuntimeM Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"inductive"
  String
typeName <- ParsecT CustomError String RuntimeM String
upperId
  -- Parse optional type parameters (lowercase identifiers)
  [String]
typeParams <- 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
typeVarIdent
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
  -- Parse constructors - they must be indented more than the 'inductive' keyword
  -- or on the same line separated by |
  [InductiveConstructor]
constructors <- Pos -> Parser [InductiveConstructor]
inductiveConstructors Pos
pos
  TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopExpr -> ParsecT CustomError String RuntimeM TopExpr)
-> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [InductiveConstructor] -> TopExpr
InductiveDecl String
typeName [String]
typeParams [InductiveConstructor]
constructors

-- | Parse constructors for inductive data type
-- Constructors must be indented more than the base position, or separated by |
inductiveConstructors :: Pos -> Parser [InductiveConstructor]
inductiveConstructors :: Pos -> Parser [InductiveConstructor]
inductiveConstructors Pos
basePos = do
  -- Optional leading |
  Maybe ()
_ <- ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|")
  InductiveConstructor
first <- Parser InductiveConstructor
inductiveConstructor
  [InductiveConstructor]
rest <- Parser InductiveConstructor -> Parser [InductiveConstructor]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser InductiveConstructor -> Parser [InductiveConstructor])
-> Parser InductiveConstructor -> Parser [InductiveConstructor]
forall a b. (a -> b) -> a -> b
$ Parser InductiveConstructor -> Parser InductiveConstructor
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser InductiveConstructor -> Parser InductiveConstructor)
-> Parser InductiveConstructor -> Parser InductiveConstructor
forall a b. (a -> b) -> a -> b
$ do
    -- Either | separator or indented on new line
    (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|" ParsecT CustomError String RuntimeM ()
-> Parser InductiveConstructor -> Parser InductiveConstructor
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser InductiveConstructor
inductiveConstructor) Parser InductiveConstructor
-> Parser InductiveConstructor -> Parser InductiveConstructor
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Pos -> ParsecT CustomError String RuntimeM Pos
indentGuardGT Pos
basePos ParsecT CustomError String RuntimeM Pos
-> Parser InductiveConstructor -> Parser InductiveConstructor
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser InductiveConstructor
inductiveConstructor)
  [InductiveConstructor] -> Parser [InductiveConstructor]
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InductiveConstructor
first InductiveConstructor
-> [InductiveConstructor] -> [InductiveConstructor]
forall a. a -> [a] -> [a]
: [InductiveConstructor]
rest)

-- | Parse a single constructor
-- e.g., Less, S Nat, Node Tree Tree
inductiveConstructor :: Parser InductiveConstructor
inductiveConstructor :: Parser InductiveConstructor
inductiveConstructor = do
  String
name <- ParsecT CustomError String RuntimeM String
upperId
  -- Parse argument types using typeAtom (handles both uppercase and lowercase)
  [TypeExpr]
args <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
inductiveArgType)
  InductiveConstructor -> Parser InductiveConstructor
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InductiveConstructor -> Parser InductiveConstructor)
-> InductiveConstructor -> Parser InductiveConstructor
forall a b. (a -> b) -> a -> b
$ String -> [TypeExpr] -> InductiveConstructor
InductiveConstructor String
name [TypeExpr]
args

-- | Parse an argument type for inductive constructor
-- Only parses simple type atoms that are clearly types
inductiveArgType :: Parser TypeExpr
inductiveArgType :: ParsecT CustomError String RuntimeM TypeExpr
inductiveArgType = ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TypeExpr
 -> ParsecT CustomError String RuntimeM TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ do
  -- Don't parse if next token is | (constructor separator)
  ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> ParsecT CustomError String RuntimeM ()
symbol String
"|")
  -- Parse type atom, but use a restricted version that only accepts:
  -- - Builtin types (Integer, Bool, etc.)
  -- - Type names (uppercase identifiers)
  -- - Type variables (lowercase, but short to avoid function names)
  -- - List types [a]
  -- - Tuple types (a, b)
  ParsecT CustomError String RuntimeM TypeExpr
inductiveTypeAtom

-- | Restricted type atom parser for inductive constructors
inductiveTypeAtom :: Parser TypeExpr
inductiveTypeAtom :: ParsecT CustomError String RuntimeM TypeExpr
inductiveTypeAtom =
      TypeExpr
TEInt     TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Integer"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEMathExpr TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"MathExpr"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEFloat   TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Float"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEBool    TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Bool"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEChar    TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Char"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEString  TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"String"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEList    (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
brackets ParsecT CustomError String RuntimeM TypeExpr
typeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TypeExpr
TEVar     (String -> TypeExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
typeNameIdent     -- Uppercase type names (Nat, Tree, etc.)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TypeExpr
TEVar     (String -> TypeExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
inductiveTypeVar  -- Short lowercase type variables
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
inductiveParenType              -- Parenthesized types like (Tree a)
  ParsecT CustomError String RuntimeM TypeExpr
-> String -> ParsecT CustomError String RuntimeM TypeExpr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"type expression in inductive constructor"

-- | Parse parenthesized type in inductive context
-- Handles both simple parens (Tree a) and tuples (a, b)
inductiveParenType :: Parser TypeExpr
inductiveParenType :: ParsecT CustomError String RuntimeM TypeExpr
inductiveParenType = ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
parens (ParsecT CustomError String RuntimeM TypeExpr
 -> ParsecT CustomError String RuntimeM TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ do
  Maybe TypeExpr
first <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM (Maybe TypeExpr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomError String RuntimeM TypeExpr
inductiveTypeExprInParen
  case Maybe TypeExpr
first of
    Maybe TypeExpr
Nothing -> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ [TypeExpr] -> TypeExpr
TETuple []  -- Unit type: ()
    Just TypeExpr
t -> do
      Maybe [TypeExpr]
rest <- ParsecT CustomError String RuntimeM [TypeExpr]
-> ParsecT CustomError String RuntimeM (Maybe [TypeExpr])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT CustomError String RuntimeM ()
symbol String
"," ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [TypeExpr]
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
inductiveTypeExprInParen ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` String -> ParsecT CustomError String RuntimeM ()
symbol String
",")
      TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ case Maybe [TypeExpr]
rest of
        Maybe [TypeExpr]
Nothing  -> TypeExpr
t              -- Just parenthesized: (Tree a)
        Just [TypeExpr]
ts  -> [TypeExpr] -> TypeExpr
TETuple (TypeExpr
tTypeExpr -> [TypeExpr] -> [TypeExpr]
forall a. a -> [a] -> [a]
:[TypeExpr]
ts) -- Tuple: (a, b)

-- | Type expression inside parentheses in inductive context
-- Allows function types and type applications
inductiveTypeExprInParen :: Parser TypeExpr
inductiveTypeExprInParen :: ParsecT CustomError String RuntimeM TypeExpr
inductiveTypeExprInParen = ParsecT CustomError String RuntimeM TypeExpr
typeExprWithApp

-- | Parse type variable in inductive context (must be short)
inductiveTypeVar :: Parser String
inductiveTypeVar :: ParsecT CustomError String RuntimeM String
inductiveTypeVar = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
lexeme (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
$ ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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
$ do
  Char
c <- ParsecT CustomError String RuntimeM Char
ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
  String
cs <- 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
identChar
  let name :: String
name = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
  -- Reject if it looks like a keyword or function name (> 2 chars usually)
  -- Common type vars: a, b, c, t, k, v, xs, elem
  if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 Bool -> Bool -> Bool
|| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
inductiveReserved
    then String -> ParsecT CustomError String RuntimeM String
forall a. String -> ParsecT CustomError String RuntimeM a
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
"Not a type variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    else String -> ParsecT CustomError String RuntimeM String
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
  where
    inductiveReserved :: [String]
inductiveReserved = [String
"def", String
"let", String
"if", String
"match", String
"load", String
"assert", String
"true", String
"false", String
"class", String
"instance", String
"where"]

-- | Parse type class declaration
-- e.g., class Eq a where
--         (==) (x: a) (y: a) : Bool
--         (/=) (x: a) (y: a) : Bool := not (x == y)
--       class Ord a extends Eq a where
--         compare (x: a) (y: a) : Ordering
classExpr :: Parser TopExpr
classExpr :: ParsecT CustomError String RuntimeM TopExpr
classExpr = ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TopExpr
 -> ParsecT CustomError String RuntimeM TopExpr)
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ do
  Pos
pos <- ParsecT CustomError String RuntimeM Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"class"
  -- Parse optional superclass constraints: extends Eq a
  ([ConstraintExpr]
superclasses, String
classNm, [String]
typeParams) <- Parser ([ConstraintExpr], String, [String])
classHeader
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"where"
  -- Parse methods - use alignSome for consistent indentation handling
  [ClassMethod]
methods <- ParsecT CustomError String RuntimeM ClassMethod
-> ParsecT CustomError String RuntimeM [ClassMethod]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM ClassMethod
 -> ParsecT CustomError String RuntimeM [ClassMethod])
-> ParsecT CustomError String RuntimeM ClassMethod
-> ParsecT CustomError String RuntimeM [ClassMethod]
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM ClassMethod
-> ParsecT CustomError String RuntimeM ClassMethod
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM ClassMethod
 -> ParsecT CustomError String RuntimeM ClassMethod)
-> ParsecT CustomError String RuntimeM ClassMethod
-> ParsecT CustomError String RuntimeM ClassMethod
forall a b. (a -> b) -> a -> b
$ do
    Pos
_ <- Pos -> ParsecT CustomError String RuntimeM Pos
indentGuardGT Pos
pos
    -- Check that this looks like a method definition
    ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> ParsecT CustomError String RuntimeM ()
reserved String
"def" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT CustomError String RuntimeM ()
reserved String
"class" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT CustomError String RuntimeM ()
reserved String
"instance" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT CustomError String RuntimeM ()
reserved String
"inductive")
    ParsecT CustomError String RuntimeM ClassMethod
classMethod
  TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopExpr -> ParsecT CustomError String RuntimeM TopExpr)
-> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ ClassDecl -> TopExpr
ClassDeclExpr (ClassDecl -> TopExpr) -> ClassDecl -> TopExpr
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> [ConstraintExpr] -> [ClassMethod] -> ClassDecl
ClassDecl String
classNm [String]
typeParams [ConstraintExpr]
superclasses [ClassMethod]
methods

-- | Parse class header: "Ord a extends Eq a" or "Eq a"
-- Note: type parameters are parsed until "where" or "extends" is encountered
classHeader :: Parser ([ConstraintExpr], String, [String])
classHeader :: Parser ([ConstraintExpr], String, [String])
classHeader = Parser ([ConstraintExpr], String, [String])
-> Parser ([ConstraintExpr], String, [String])
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser ([ConstraintExpr], String, [String])
withExtends Parser ([ConstraintExpr], String, [String])
-> Parser ([ConstraintExpr], String, [String])
-> Parser ([ConstraintExpr], String, [String])
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ([ConstraintExpr], String, [String])
forall {a}.
ParsecT CustomError String RuntimeM ([a], String, [String])
withoutExtends
  where
    withExtends :: Parser ([ConstraintExpr], String, [String])
withExtends = do
      String
classNm <- ParsecT CustomError String RuntimeM String
upperId
      [String]
typeParams <- 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]
someTill ParsecT CustomError String RuntimeM String
typeVarIdent (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (String -> ParsecT CustomError String RuntimeM ()
reserved String
"extends"))
      String -> ParsecT CustomError String RuntimeM ()
reserved String
"extends"
      -- Parse superclass constraints (single constraint only for now)
      String
superClassName <- ParsecT CustomError String RuntimeM String
upperId
      [String]
superTypeArgs <- 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]
manyTill ParsecT CustomError String RuntimeM String
typeVarIdent (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (String -> ParsecT CustomError String RuntimeM ()
reserved String
"where"))
      let constraints :: [ConstraintExpr]
constraints = [String -> [TypeExpr] -> ConstraintExpr
ConstraintExpr String
superClassName ((String -> TypeExpr) -> [String] -> [TypeExpr]
forall a b. (a -> b) -> [a] -> [b]
map String -> TypeExpr
TEVar [String]
superTypeArgs)]
      ([ConstraintExpr], String, [String])
-> Parser ([ConstraintExpr], String, [String])
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConstraintExpr]
constraints, String
classNm, [String]
typeParams)

    withoutExtends :: ParsecT CustomError String RuntimeM ([a], String, [String])
withoutExtends = do
      String
classNm <- ParsecT CustomError String RuntimeM String
upperId
      [String]
typeParams <- 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]
manyTill ParsecT CustomError String RuntimeM String
typeVarIdent (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (String -> ParsecT CustomError String RuntimeM ()
reserved String
"where"))
      ([a], String, [String])
-> ParsecT CustomError String RuntimeM ([a], String, [String])
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], String
classNm, [String]
typeParams)

-- | Parse a single class method
-- e.g., (==) (x: a) (y: a) : Bool
--       (/=) (x: a) (y: a) : Bool := not (x == y)
classMethod :: Parser ClassMethod
classMethod :: ParsecT CustomError String RuntimeM ClassMethod
classMethod = do
  String
name <- ParsecT CustomError String RuntimeM String
methodName'
  [TypedParam]
params <- ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM [TypedParam]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypedParam
typedParam)
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
  -- Use typeAtomSimple to avoid consuming too much
  TypeExpr
retType <- ParsecT CustomError String RuntimeM TypeExpr
typeAtomSimple
  -- Check if there's a default implementation on the same line (not crossing to new unindented line)
  Maybe Expr
defaultImpl <- 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
 -> ParsecT CustomError String RuntimeM (Maybe Expr))
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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
$ do
    ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
    ParsecT CustomError String RuntimeM Expr
expr
  ClassMethod -> ParsecT CustomError String RuntimeM ClassMethod
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassMethod -> ParsecT CustomError String RuntimeM ClassMethod)
-> ClassMethod -> ParsecT CustomError String RuntimeM ClassMethod
forall a b. (a -> b) -> a -> b
$ String -> [TypedParam] -> TypeExpr -> Maybe Expr -> ClassMethod
ClassMethod String
name [TypedParam]
params TypeExpr
retType Maybe Expr
defaultImpl

-- | Parse method name (can be operator in parens or regular identifier)
methodName' :: Parser String
methodName' :: ParsecT CustomError String RuntimeM String
methodName' = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM String
parenOperator ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM String
lowerId
  where
    parenOperator :: ParsecT CustomError String RuntimeM [Token String]
parenOperator = do
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"("
      [Token String]
op <- ParsecT CustomError String RuntimeM (Token String)
-> ParsecT CustomError String RuntimeM [Token String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([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 -> ParsecT CustomError String RuntimeM ()
symbol String
")"
      [Token String]
-> ParsecT CustomError String RuntimeM [Token String]
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Token String]
op

-- | Parse type class instance declaration
-- e.g., instance Eq Integer where
--         (==) x y := x = y
--       instance Eq a => Eq [a] where
--         (==) xs ys := ...
instanceExpr :: Parser TopExpr
instanceExpr :: ParsecT CustomError String RuntimeM TopExpr
instanceExpr = ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TopExpr
 -> ParsecT CustomError String RuntimeM TopExpr)
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ do
  Pos
pos <- ParsecT CustomError String RuntimeM Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"instance"
  -- Parse optional instance constraints: Eq a =>
  ([ConstraintExpr]
constraints, String
classNm, [TypeExpr]
instTypes) <- Parser ([ConstraintExpr], String, [TypeExpr])
instanceHeader
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"where"
  -- Parse method implementations (indented)
  [InstanceMethod]
methods <- Pos -> Parser [InstanceMethod]
instanceMethodsParser Pos
pos
  TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopExpr -> ParsecT CustomError String RuntimeM TopExpr)
-> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ InstanceDecl -> TopExpr
InstanceDeclExpr (InstanceDecl -> TopExpr) -> InstanceDecl -> TopExpr
forall a b. (a -> b) -> a -> b
$ [ConstraintExpr]
-> String -> [TypeExpr] -> [InstanceMethod] -> InstanceDecl
InstanceDecl [ConstraintExpr]
constraints String
classNm [TypeExpr]
instTypes [InstanceMethod]
methods

-- | Parse instance header: "Eq Integer" or "{Eq a} Eq [a]"
-- Note: instance types are parsed until "where" is encountered
instanceHeader :: Parser ([ConstraintExpr], String, [TypeExpr])
instanceHeader :: Parser ([ConstraintExpr], String, [TypeExpr])
instanceHeader = Parser ([ConstraintExpr], String, [TypeExpr])
-> Parser ([ConstraintExpr], String, [TypeExpr])
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser ([ConstraintExpr], String, [TypeExpr])
withConstraints Parser ([ConstraintExpr], String, [TypeExpr])
-> Parser ([ConstraintExpr], String, [TypeExpr])
-> Parser ([ConstraintExpr], String, [TypeExpr])
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ([ConstraintExpr], String, [TypeExpr])
forall {a}.
ParsecT CustomError String RuntimeM ([a], String, [TypeExpr])
withoutConstraints
  where
    -- New syntax: {Eq a} Eq [a]
    withConstraints :: Parser ([ConstraintExpr], String, [TypeExpr])
withConstraints = do
      [ConstraintExpr]
constraints <- Parser [ConstraintExpr]
typeConstraints
      String
classNm <- ParsecT CustomError String RuntimeM String
upperId
      [TypeExpr]
instTypes <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
someTill ParsecT CustomError String RuntimeM TypeExpr
typeAtomSimple (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (String -> ParsecT CustomError String RuntimeM ()
reserved String
"where"))
      ([ConstraintExpr], String, [TypeExpr])
-> Parser ([ConstraintExpr], String, [TypeExpr])
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConstraintExpr]
constraints, String
classNm, [TypeExpr]
instTypes)

    withoutConstraints :: ParsecT CustomError String RuntimeM ([a], String, [TypeExpr])
withoutConstraints = do
      String
classNm <- ParsecT CustomError String RuntimeM String
upperId
      [TypeExpr]
instTypes <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
someTill ParsecT CustomError String RuntimeM TypeExpr
typeAtomSimple (ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (String -> ParsecT CustomError String RuntimeM ()
reserved String
"where"))
      ([a], String, [TypeExpr])
-> ParsecT CustomError String RuntimeM ([a], String, [TypeExpr])
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], String
classNm, [TypeExpr]
instTypes)

-- | Parse instance methods
instanceMethodsParser :: Pos -> Parser [InstanceMethod]
instanceMethodsParser :: Pos -> Parser [InstanceMethod]
instanceMethodsParser Pos
basePos = [InstanceMethod]
-> Parser [InstanceMethod] -> Parser [InstanceMethod]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (Parser [InstanceMethod] -> Parser [InstanceMethod])
-> Parser [InstanceMethod] -> Parser [InstanceMethod]
forall a b. (a -> b) -> a -> b
$ do
  Pos
_ <- Pos -> ParsecT CustomError String RuntimeM Pos
indentGuardGT Pos
basePos
  Parser InstanceMethod -> Parser [InstanceMethod]
forall a. Parser a -> Parser [a]
alignSome Parser InstanceMethod
instanceMethod

-- | Parse a single instance method
-- e.g., (==) x y := x = y
instanceMethod :: Parser InstanceMethod
instanceMethod :: Parser InstanceMethod
instanceMethod = do
  String
name <- ParsecT CustomError String RuntimeM String
methodName'
  [String]
params <- 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
lowerId
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
  Expr
body <- ParsecT CustomError String RuntimeM Expr
expr
  InstanceMethod -> Parser InstanceMethod
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstanceMethod -> Parser InstanceMethod)
-> InstanceMethod -> Parser InstanceMethod
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Expr -> InstanceMethod
InstanceMethod String
name [String]
params Expr
body

-- 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 = 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))
                                     newop
                                     (patternOps 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 = 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))
                                  newop
                                  (exprOps 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> (a -> ParsecT CustomError String RuntimeM b)
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> (a -> ParsecT CustomError String RuntimeM b)
-> ParsecT CustomError String RuntimeM b
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 { 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 a. a -> ParsecT CustomError String RuntimeM a
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 a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot declare infix starting with '!'"
    check String
x | String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedOp = String -> ParsecT CustomError String RuntimeM String
forall a. String -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedPOp = String -> ParsecT CustomError String RuntimeM String
forall a. String -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return String
x

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

-- | Parse pattern function declaration
-- e.g., def pattern twin {a} (p1 : a) (p2 : MyList a) : MyList a := ...
patternFunctionExpr :: Parser TopExpr
patternFunctionExpr :: ParsecT CustomError String RuntimeM TopExpr
patternFunctionExpr = do
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"pattern"
  [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
varWithIdx <- Parser VarWithIndices -> Parser VarWithIndices
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VarWithIndices
varWithIndicesLiteral
  let (String
name, [VarIndex]
_indices) = VarWithIndices -> (String, [VarIndex])
extractVarWithIndices VarWithIndices
varWithIdx
  -- Parse optional type parameters: {a, b}
  [String]
typeParams <- [String]
-> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
braces (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
$ ParsecT CustomError String RuntimeM String
typeVarIdent 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]
`sepBy1` String -> ParsecT CustomError String RuntimeM ()
symbol String
",")
  -- Parse parameters with types: (p1 : a) (p2 : MyList a)
  [(String, TypeExpr)]
params <- ParsecT CustomError String RuntimeM (String, TypeExpr)
-> ParsecT CustomError String RuntimeM [(String, TypeExpr)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomError String RuntimeM (String, TypeExpr)
 -> ParsecT CustomError String RuntimeM [(String, TypeExpr)])
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
-> ParsecT CustomError String RuntimeM [(String, TypeExpr)]
forall a b. (a -> b) -> a -> b
$
    ParsecT CustomError String RuntimeM (String, TypeExpr)
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM (String, TypeExpr)
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
parens (ParsecT CustomError String RuntimeM (String, TypeExpr)
 -> ParsecT CustomError String RuntimeM (String, TypeExpr))
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
forall a b. (a -> b) -> a -> b
$ do
      String
paramName <- ParsecT CustomError String RuntimeM String
lowerId
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
      TypeExpr
paramType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
      (String, TypeExpr)
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
paramName, TypeExpr
paramType)
    ) ParsecT CustomError String RuntimeM (String, TypeExpr)
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
      String
paramName <- ParsecT CustomError String RuntimeM String
lowerId
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
      TypeExpr
paramType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
      (String, TypeExpr)
-> ParsecT CustomError String RuntimeM (String, TypeExpr)
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
paramName, TypeExpr
paramType)
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
  TypeExpr
retType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
  -- Parse pattern body
  Pattern
body <- Parser Pattern
pattern
  TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopExpr -> ParsecT CustomError String RuntimeM TopExpr)
-> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> [(String, TypeExpr)]
-> TypeExpr
-> Pattern
-> TopExpr
PatternFunctionDecl String
name [String]
typeParams [(String, TypeExpr)]
params TypeExpr
retType Pattern
body

declareSymbolExpr :: Parser TopExpr
declareSymbolExpr :: ParsecT CustomError String RuntimeM TopExpr
declareSymbolExpr = ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TopExpr
 -> ParsecT CustomError String RuntimeM TopExpr)
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"declare"
  String
keyword <- ParsecT CustomError String RuntimeM String
lowerId
  -- Check that the keyword is "symbol"
  if String
keyword String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"symbol"
    then String -> ParsecT CustomError String RuntimeM ()
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected 'symbol' after 'declare'"
    else () -> ParsecT CustomError String RuntimeM ()
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Parse comma-separated list of symbol names
  [String]
names <- 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]
sepBy1 ParsecT CustomError String RuntimeM String
ident (String -> ParsecT CustomError String RuntimeM ()
symbol String
",")
  -- Parse optional type annotation (must be simple type, not function type)
  Maybe TypeExpr
mType <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM (Maybe TypeExpr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomError String RuntimeM TypeExpr
 -> ParsecT CustomError String RuntimeM (Maybe TypeExpr))
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM (Maybe TypeExpr)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TypeExpr
 -> ParsecT CustomError String RuntimeM TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ do
    ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
    -- Use typeAtomSimple to avoid parsing across lines
    ParsecT CustomError String RuntimeM TypeExpr
typeAtomSimple
  TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopExpr -> ParsecT CustomError String RuntimeM TopExpr)
-> TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe TypeExpr -> TopExpr
DeclareSymbol [String]
names Maybe TypeExpr
mType

defineExpr :: Parser TopExpr
defineExpr :: ParsecT CustomError String RuntimeM TopExpr
defineExpr = ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TopExpr
defineWithType ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
-> ParsecT CustomError String RuntimeM TopExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TopExpr
defineWithoutType
  where
    defineWithoutType :: ParsecT CustomError String RuntimeM TopExpr
defineWithoutType = 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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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))

    defineWithType :: ParsecT CustomError String RuntimeM TopExpr
defineWithType = 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
varWithIdx <- Parser VarWithIndices -> Parser VarWithIndices
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VarWithIndices
varWithIndicesLiteral
      let (String
name, [VarIndex]
indices) = VarWithIndices -> (String, [VarIndex])
extractVarWithIndices VarWithIndices
varWithIdx
      -- Parse optional type class constraints: {a : Eq, b : Ord}
      [ConstraintExpr]
constraints <- [ConstraintExpr]
-> Parser [ConstraintExpr] -> Parser [ConstraintExpr]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] Parser [ConstraintExpr]
typeConstraints
      [TypedParam]
typedParams <- ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM [TypedParam]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM TypedParam
typedParam
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
      TypeExpr
retType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
      Expr
body <- ParsecT CustomError String RuntimeM Expr
expr
      let typedVar :: TypedVarWithIndices
typedVar = String
-> [VarIndex]
-> [ConstraintExpr]
-> [TypedParam]
-> TypeExpr
-> TypedVarWithIndices
TypedVarWithIndices String
name [VarIndex]
indices [ConstraintExpr]
constraints [TypedParam]
typedParams TypeExpr
retType
      TopExpr -> ParsecT CustomError String RuntimeM TopExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedVarWithIndices -> Expr -> TopExpr
DefineWithType TypedVarWithIndices
typedVar Expr
body)

-- | Extract name and indices from VarWithIndices
extractVarWithIndices :: VarWithIndices -> (String, [VarIndex])
extractVarWithIndices :: VarWithIndices -> (String, [VarIndex])
extractVarWithIndices (VarWithIndices String
name [VarIndex]
indices) = (String
name, [VarIndex]
indices)

-- | Parse type class constraints: {Eq a, Ord b}
-- Type variables without constraints are ignored (they are inferred automatically)
-- Format: {Eq a, Ord b}  -- className typeVar
--         {}  -- empty (no constraints)
typeConstraints :: Parser [ConstraintExpr]
typeConstraints :: Parser [ConstraintExpr]
typeConstraints = Parser [ConstraintExpr] -> Parser [ConstraintExpr]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
braces (Parser [ConstraintExpr] -> Parser [ConstraintExpr])
-> Parser [ConstraintExpr] -> Parser [ConstraintExpr]
forall a b. (a -> b) -> a -> b
$ ([Maybe ConstraintExpr] -> [ConstraintExpr]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ConstraintExpr] -> [ConstraintExpr])
-> ParsecT CustomError String RuntimeM [Maybe ConstraintExpr]
-> Parser [ConstraintExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
typeConstraintOrVar ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [Maybe ConstraintExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` String -> ParsecT CustomError String RuntimeM ()
symbol String
",")) Parser [ConstraintExpr]
-> Parser [ConstraintExpr] -> Parser [ConstraintExpr]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ConstraintExpr] -> Parser [ConstraintExpr]
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    typeConstraintOrVar :: ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
typeConstraintOrVar = (ConstraintExpr -> Maybe ConstraintExpr
forall a. a -> Maybe a
Just (ConstraintExpr -> Maybe ConstraintExpr)
-> ParsecT CustomError String RuntimeM ConstraintExpr
-> ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM ConstraintExpr
-> ParsecT CustomError String RuntimeM ConstraintExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM ConstraintExpr
typeConstraint) ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
-> ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
-> ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM String
typeVar ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
-> ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ConstraintExpr
-> ParsecT CustomError String RuntimeM (Maybe ConstraintExpr)
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConstraintExpr
forall a. Maybe a
Nothing)
    
    -- Format: {Eq a} - className typeVar
    typeConstraint :: ParsecT CustomError String RuntimeM ConstraintExpr
typeConstraint = do
      String
className <- ParsecT CustomError String RuntimeM String
upperId
      String
typeVar <- ParsecT CustomError String RuntimeM String
typeVarIdent
      ConstraintExpr
-> ParsecT CustomError String RuntimeM ConstraintExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstraintExpr
 -> ParsecT CustomError String RuntimeM ConstraintExpr)
-> ConstraintExpr
-> ParsecT CustomError String RuntimeM ConstraintExpr
forall a b. (a -> b) -> a -> b
$ String -> [TypeExpr] -> ConstraintExpr
ConstraintExpr String
className [String -> TypeExpr
TEVar String
typeVar]
    
    -- Type variable without constraint (ignored)
    typeVar :: ParsecT CustomError String RuntimeM String
typeVar = ParsecT CustomError String RuntimeM String
typeVarIdent

-- | Parse a typed parameter: supports both simple (x: a) and tuple ((x: a), (y: b)) patterns
typedParam :: Parser TypedParam
typedParam :: ParsecT CustomError String RuntimeM TypedParam
typedParam = ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
parens ParsecT CustomError String RuntimeM TypedParam
typedParamInner

-- Parse the inner part of a typed parameter (inside parentheses)
typedParamInner :: Parser TypedParam
typedParamInner :: ParsecT CustomError String RuntimeM TypedParam
typedParamInner = ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypedParam
typedTupleParam ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
typedSimpleParam

-- Parse a tuple pattern with typed elements: (x: a), (y: b) or x: a, y: b
typedTupleParam :: Parser TypedParam
typedTupleParam :: ParsecT CustomError String RuntimeM TypedParam
typedTupleParam = do
  TypedParam
first <- ParsecT CustomError String RuntimeM TypedParam
typedTupleElement
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
","
  [TypedParam]
rest <- ParsecT CustomError String RuntimeM TypedParam
typedTupleElement ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [TypedParam]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` String -> ParsecT CustomError String RuntimeM ()
symbol String
","
  TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedParam -> ParsecT CustomError String RuntimeM TypedParam)
-> TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a b. (a -> b) -> a -> b
$ [TypedParam] -> TypedParam
TPTuple (TypedParam
first TypedParam -> [TypedParam] -> [TypedParam]
forall a. a -> [a] -> [a]
: [TypedParam]
rest)

-- Parse an element in a typed tuple
typedTupleElement :: Parser TypedParam
typedTupleElement :: ParsecT CustomError String RuntimeM TypedParam
typedTupleElement =
      ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
parens ParsecT CustomError String RuntimeM TypedParam
typedParamInner)  -- Nested: ((x: a))
  ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypedParam
typedWildcard             -- Wildcard with type: _: a
  ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypedParam
typedInvertedVar         -- Inverted variable with type: !x: a
  ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypedParam
typedVar                  -- Variable with type: x: a
  ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
untypedWildcard               -- Just wildcard: _
  ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
untypedVar                    -- Just variable: x

-- Simple typed parameter: x: a, !x: a, or _: a
typedSimpleParam :: Parser TypedParam
typedSimpleParam :: ParsecT CustomError String RuntimeM TypedParam
typedSimpleParam = ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypedParam
typedWildcard ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypedParam
typedInvertedVar ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM TypedParam
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypedParam
typedVar

typedVar :: Parser TypedParam
typedVar :: ParsecT CustomError String RuntimeM TypedParam
typedVar = do
  String
paramName <- ParsecT CustomError String RuntimeM String
ident
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
  TypeExpr
paramType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
  TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedParam -> ParsecT CustomError String RuntimeM TypedParam)
-> TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a b. (a -> b) -> a -> b
$ String -> TypeExpr -> TypedParam
TPVar String
paramName TypeExpr
paramType

typedInvertedVar :: Parser TypedParam
typedInvertedVar :: ParsecT CustomError String RuntimeM TypedParam
typedInvertedVar = do
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"!"
  String
paramName <- ParsecT CustomError String RuntimeM String
ident
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
  TypeExpr
paramType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
  TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedParam -> ParsecT CustomError String RuntimeM TypedParam)
-> TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a b. (a -> b) -> a -> b
$ String -> TypeExpr -> TypedParam
TPInvertedVar String
paramName TypeExpr
paramType

typedWildcard :: Parser TypedParam
typedWildcard :: ParsecT CustomError String RuntimeM TypedParam
typedWildcard = do
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"_"
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
  TypeExpr
paramType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
  TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedParam -> ParsecT CustomError String RuntimeM TypedParam)
-> TypedParam -> ParsecT CustomError String RuntimeM TypedParam
forall a b. (a -> b) -> a -> b
$ TypeExpr -> TypedParam
TPWildcard TypeExpr
paramType

untypedVar :: Parser TypedParam
untypedVar :: ParsecT CustomError String RuntimeM TypedParam
untypedVar = String -> TypedParam
TPUntypedVar (String -> TypedParam)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TypedParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
ident

untypedWildcard :: Parser TypedParam
untypedWildcard :: ParsecT CustomError String RuntimeM TypedParam
untypedWildcard = TypedParam
TPUntypedWildcard TypedParam
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypedParam
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"_"

-- | Parse a type expression (used in typedParam - stops at closing paren/comma)
typeExpr :: Parser TypeExpr
typeExpr :: ParsecT CustomError String RuntimeM TypeExpr
typeExpr = ParsecT CustomError String RuntimeM TypeExpr
typeExprWithApp

typeAtomOrParenType :: Parser TypeExpr
typeAtomOrParenType :: ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType =
      ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
parenTypeOrTuple  -- Allow (a -> b) or (a, b) as a type atom
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
typeAtom

-- Parse parenthesized type or tuple type (including unit type ())
parenTypeOrTuple :: Parser TypeExpr
parenTypeOrTuple :: ParsecT CustomError String RuntimeM TypeExpr
parenTypeOrTuple = ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
parens (ParsecT CustomError String RuntimeM TypeExpr
 -> ParsecT CustomError String RuntimeM TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ do
  Maybe TypeExpr
first <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM (Maybe TypeExpr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomError String RuntimeM TypeExpr
typeExprWithApp
  case Maybe TypeExpr
first of
    Maybe TypeExpr
Nothing -> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ [TypeExpr] -> TypeExpr
TETuple []  -- Unit type: ()
    Just TypeExpr
t -> do
      Maybe [TypeExpr]
rest <- ParsecT CustomError String RuntimeM [TypeExpr]
-> ParsecT CustomError String RuntimeM (Maybe [TypeExpr])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT CustomError String RuntimeM ()
symbol String
"," ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [TypeExpr]
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeExprWithApp ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` String -> ParsecT CustomError String RuntimeM ()
symbol String
",")
      TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ case Maybe [TypeExpr]
rest of
        Maybe [TypeExpr]
Nothing  -> TypeExpr
t              -- Just parenthesized: (a -> b) or (Maybe a)
        Just [TypeExpr]
ts  -> [TypeExpr] -> TypeExpr
TETuple (TypeExpr
tTypeExpr -> [TypeExpr] -> [TypeExpr]
forall a. a -> [a] -> [a]
:[TypeExpr]
ts) -- Tuple: (a, b, c)

-- | Type expression with type application support
-- e.g., Maybe a, List Integer, Tree a b
typeExprWithApp :: Parser TypeExpr
typeExprWithApp :: ParsecT CustomError String RuntimeM TypeExpr
typeExprWithApp = do
  [TypeExpr]
atoms <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM [TypeExpr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM TypeExpr
typeAtomSimple
  Maybe TypeExpr
rest <- ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM (Maybe TypeExpr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT CustomError String RuntimeM ()
symbol String
"->" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeExprWithApp)
  let baseType :: TypeExpr
baseType = case [TypeExpr]
atoms of
                   [TypeExpr
t]    -> TypeExpr
t
                   (TypeExpr
t:[TypeExpr]
ts) -> TypeExpr -> [TypeExpr] -> TypeExpr
TEApp TypeExpr
t [TypeExpr]
ts
                   []     -> String -> TypeExpr
forall a. HasCallStack => String -> a
error String
"unreachable"
  TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ case Maybe TypeExpr
rest of
    Maybe TypeExpr
Nothing -> TypeExpr
baseType
    Just TypeExpr
r  -> TypeExpr -> TypeExpr -> TypeExpr
TEFun TypeExpr
baseType TypeExpr
r

-- | Simple type atom (no function arrows)
typeAtomSimple :: Parser TypeExpr
typeAtomSimple :: ParsecT CustomError String RuntimeM TypeExpr
typeAtomSimple =
      TypeExpr
TEInt     TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Integer"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEMathExpr TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"MathExpr"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEFloat   TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Float"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEBool    TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Bool"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEChar    TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Char"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEString  TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"String"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEIO      (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"IO" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEList    (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
brackets ParsecT CustomError String RuntimeM TypeExpr
typeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
tensorTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
vectorTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
matrixTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
diffFormTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEMatcher (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"Matcher" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEPattern (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"Pattern" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TypeExpr
TEVar     (String -> TypeExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
typeVarIdent      -- lowercase type variables (a, b, etc.)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TypeExpr
TEVar     (String -> TypeExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
typeNameIdent     -- uppercase type names (Nat, Tree, Ordering, etc.)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
parenTypeOrTuple                -- Parenthesized or tuple types
  ParsecT CustomError String RuntimeM TypeExpr
-> String -> ParsecT CustomError String RuntimeM TypeExpr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"type expression"

typeAtom :: Parser TypeExpr
typeAtom :: ParsecT CustomError String RuntimeM TypeExpr
typeAtom =
      TypeExpr
TEInt     TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Integer"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEMathExpr TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"MathExpr"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEFloat   TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Float"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEBool    TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Bool"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEChar    TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"Char"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr
TEString  TypeExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
reserved String
"String"
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEIO      (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"IO" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEList    (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
brackets ParsecT CustomError String RuntimeM TypeExpr
typeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
tensorTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
vectorTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
matrixTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM TypeExpr
diffFormTypeExpr
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEMatcher (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"Matcher" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExpr -> TypeExpr
TEPattern (TypeExpr -> TypeExpr)
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"Pattern" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TypeExpr
TEVar     (String -> TypeExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
typeVarIdent      -- lowercase type variables (a, b, etc.)
  ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
-> ParsecT CustomError String RuntimeM TypeExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TypeExpr
TEVar     (String -> TypeExpr)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
typeNameIdent     -- uppercase type names (Nat, Tree, Ordering, etc.)
  ParsecT CustomError String RuntimeM TypeExpr
-> String -> ParsecT CustomError String RuntimeM TypeExpr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"type expression"

-- | Parse an uppercase type name (for user-defined inductive types)
typeNameIdent :: Parser String
typeNameIdent :: ParsecT CustomError String RuntimeM String
typeNameIdent = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
lexeme (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
$ do
  Char
c <- ParsecT CustomError String RuntimeM Char
ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
  String
cs <- 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
identChar
  let name :: String
name = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
  -- Don't consume reserved type keywords
  if String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
typeReservedKeywords
    then String -> ParsecT CustomError String RuntimeM String
forall a. String -> ParsecT CustomError String RuntimeM a
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
"Reserved type keyword: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    else String -> ParsecT CustomError String RuntimeM String
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
  where
    typeReservedKeywords :: [String]
typeReservedKeywords = [String
"Integer", String
"MathExpr", String
"Float", String
"Bool", String
"Char", String
"String", String
"Matcher", String
"Pattern", String
"Tensor", String
"Vector", String
"Matrix", String
"IO"]

tensorTypeExpr :: Parser TypeExpr
tensorTypeExpr :: ParsecT CustomError String RuntimeM TypeExpr
tensorTypeExpr = do
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"Tensor"
  TypeExpr
elemType <- ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType  -- Allow parenthesized types like (IORef [a])
  -- TETensor now only takes the element type
  TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ TypeExpr -> TypeExpr
TETensor TypeExpr
elemType

vectorTypeExpr :: Parser TypeExpr
vectorTypeExpr :: ParsecT CustomError String RuntimeM TypeExpr
vectorTypeExpr = do
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"Vector"
  TypeExpr
elemType <- ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType
  TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ TypeExpr -> TypeExpr
TEVector TypeExpr
elemType

matrixTypeExpr :: Parser TypeExpr
matrixTypeExpr :: ParsecT CustomError String RuntimeM TypeExpr
matrixTypeExpr = do
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"Matrix"
  TypeExpr
elemType <- ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType
  TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ TypeExpr -> TypeExpr
TEMatrix TypeExpr
elemType

diffFormTypeExpr :: Parser TypeExpr
diffFormTypeExpr :: ParsecT CustomError String RuntimeM TypeExpr
diffFormTypeExpr = do
  ()
_ <- String -> ParsecT CustomError String RuntimeM ()
reserved String
"DiffForm"
  TypeExpr
elemType <- ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType
  TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr)
-> TypeExpr -> ParsecT CustomError String RuntimeM TypeExpr
forall a b. (a -> b) -> a -> b
$ TypeExpr -> TypeExpr
TEDiffForm TypeExpr
elemType


typeVarIdent :: Parser String
typeVarIdent :: ParsecT CustomError String RuntimeM String
typeVarIdent = ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
lexeme (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
$ do
  Char
c <- ParsecT CustomError String RuntimeM Char
ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
  String
cs <- 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
identChar
  let name :: String
name = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
  if String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
typeReservedWords
    then String -> ParsecT CustomError String RuntimeM String
forall a. String -> ParsecT CustomError String RuntimeM a
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
"Reserved word: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    else String -> ParsecT CustomError String RuntimeM String
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
  where
    typeReservedWords :: [String]
typeReservedWords = [String
"Integer", String
"MathExpr", String
"Float", String
"Bool", String
"Char", String
"String", String
"Matcher", String
"Pattern", String
"Tensor", String
"Vector", String
"Matrix", String
"DiffForm"]

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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Pos
indented ParsecT CustomError String RuntimeM Pos
-> ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Pos
indented ParsecT CustomError String RuntimeM Pos
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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 { 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> 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
"as" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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)
-> Parser Pattern
-> ParsecT CustomError String RuntimeM (Expr -> MatchClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Pattern
pattern ParsecT CustomError String RuntimeM (Expr -> MatchClause)
-> ParsecT CustomError String RuntimeM Expr -> Parser MatchClause
forall a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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)
-> Parser 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 ()
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Pattern
pattern) ParsecT CustomError String RuntimeM (Expr -> MatchClause)
-> ParsecT CustomError String RuntimeM Expr -> Parser MatchClause
forall a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr -> Expr) -> Parser (Expr -> Expr)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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)
-> Parser Pattern -> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"=>" ParsecT CustomError String RuntimeM ()
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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 =
        ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM Expr
typedMemoizedLambda
    ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"memoizedLambda" ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr))
  where
    -- memoizedLambda (x: Integer) : Integer -> body
    -- Note: retType must be parsed with typeAtomOrParenType to avoid consuming the "->" arrow
    typedMemoizedLambda :: ParsecT CustomError String RuntimeM Expr
typedMemoizedLambda = do
      String -> ParsecT CustomError String RuntimeM ()
reserved String
"memoizedLambda"
      [TypedParam]
params <- ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM [TypedParam]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomError String RuntimeM TypedParam
typedParam
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
      TypeExpr
retType <- ParsecT CustomError String RuntimeM TypeExpr
typeAtomOrParenType
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
"->"
      Expr
body <- ParsecT CustomError String RuntimeM Expr
expr
      Expr -> ParsecT CustomError String RuntimeM Expr
forall a. a -> ParsecT CustomError String RuntimeM a
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
$ [TypedParam] -> TypeExpr -> Expr -> Expr
TypedMemoizedLambdaExpr [TypedParam]
params TypeExpr
retType Expr
body

arg :: Parser (Arg ArgPattern)
arg :: ParsecT CustomError String RuntimeM (Arg ArgPattern)
arg = ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
InvertedArg (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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
Arg         (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
-> [[Operator (ParsecT CustomError String RuntimeM) ArgPattern]]
-> ParsecT CustomError String RuntimeM ArgPattern
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser ParsecT CustomError String RuntimeM ArgPattern
argPatternAtom [[Operator (ParsecT CustomError String RuntimeM) ArgPattern]]
table
        ParsecT CustomError String RuntimeM ArgPattern
-> String -> ParsecT CustomError String RuntimeM ArgPattern
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"argument pattern"
  where
    table :: [[Operator Parser ArgPattern]]
    table :: [[Operator (ParsecT CustomError String RuntimeM) ArgPattern]]
table =
      [ [ Parser (ArgPattern -> ArgPattern -> ArgPattern)
-> Operator (ParsecT CustomError String RuntimeM) ArgPattern
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (ArgPattern -> ArgPattern -> ArgPattern
apConsPatOp (ArgPattern -> ArgPattern -> ArgPattern)
-> ParsecT CustomError String RuntimeM ()
-> Parser (ArgPattern -> ArgPattern -> ArgPattern)
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"::")
        , Parser (ArgPattern -> ArgPattern -> ArgPattern)
-> Operator (ParsecT CustomError String RuntimeM) ArgPattern
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (ArgPattern -> ArgPattern -> ArgPattern
apSnocPatOp (ArgPattern -> ArgPattern -> ArgPattern)
-> ParsecT CustomError String RuntimeM ()
-> Parser (ArgPattern -> ArgPattern -> ArgPattern)
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"*:")
        ]
      ]
    
    apConsPatOp :: ArgPattern -> ArgPattern -> ArgPattern
    apConsPatOp :: ArgPattern -> ArgPattern -> ArgPattern
apConsPatOp ArgPattern
lhs ArgPattern
rhs = Arg ArgPattern -> ArgPattern -> ArgPattern
APConsPat (ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
Arg ArgPattern
lhs) ArgPattern
rhs
    
    apSnocPatOp :: ArgPattern -> ArgPattern -> ArgPattern
    apSnocPatOp :: ArgPattern -> ArgPattern -> ArgPattern
apSnocPatOp ArgPattern
lhs ArgPattern
rhs = ArgPattern -> Arg ArgPattern -> ArgPattern
APSnocPat ArgPattern
lhs (ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
Arg ArgPattern
rhs)

argPatternAtom :: Parser ArgPattern
argPatternAtom :: ParsecT CustomError String RuntimeM ArgPattern
argPatternAtom
  =   ArgPattern
APWildCard ArgPattern
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ArgPattern
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a. a -> ParsecT CustomError String RuntimeM a
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 a b. (a -> b -> b) -> b -> [a] -> b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 = Parser BindingExpr -> Parser BindingExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser BindingExpr
bindingWithType Parser BindingExpr -> Parser BindingExpr -> Parser BindingExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser BindingExpr
bindingWithoutType
  where
    -- Binding with type annotation: f {a : Eq} (x: Integer) : Integer := body
    bindingWithType :: Parser BindingExpr
bindingWithType = do
      VarWithIndices
varWithIdx <- Parser VarWithIndices
varWithIndicesLiteral
      let (String
name, [VarIndex]
indices) = VarWithIndices -> (String, [VarIndex])
extractVarWithIndices VarWithIndices
varWithIdx
      -- Parse optional type class constraints
      [ConstraintExpr]
constraints <- [ConstraintExpr]
-> Parser [ConstraintExpr] -> Parser [ConstraintExpr]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] Parser [ConstraintExpr]
typeConstraints
      [TypedParam]
typedParams <- ParsecT CustomError String RuntimeM TypedParam
-> ParsecT CustomError String RuntimeM [TypedParam]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomError String RuntimeM TypedParam
typedParam
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":"
      TypeExpr
retType <- ParsecT CustomError String RuntimeM TypeExpr
typeExpr
      ()
_ <- String -> ParsecT CustomError String RuntimeM ()
symbol String
":="
      Expr
body <- ParsecT CustomError String RuntimeM Expr
expr
      let typedVar :: TypedVarWithIndices
typedVar = String
-> [VarIndex]
-> [ConstraintExpr]
-> [TypedParam]
-> TypeExpr
-> TypedVarWithIndices
TypedVarWithIndices String
name [VarIndex]
indices [ConstraintExpr]
constraints [TypedParam]
typedParams TypeExpr
retType
      BindingExpr -> Parser BindingExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (BindingExpr -> Parser BindingExpr)
-> BindingExpr -> Parser BindingExpr
forall a b. (a -> b) -> a -> b
$ TypedVarWithIndices -> Expr -> BindingExpr
BindWithType TypedVarWithIndices
typedVar Expr
body

    -- Original binding without type annotation
    bindingWithoutType :: Parser BindingExpr
bindingWithoutType = 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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. HasCallStack => [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 = Parser BindingExpr -> Parser BindingExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser BindingExpr
bindArrow Parser BindingExpr -> Parser BindingExpr -> Parser BindingExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"let" ParsecT CustomError String RuntimeM ()
-> Parser BindingExpr -> Parser BindingExpr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser BindingExpr
binding) Parser BindingExpr -> Parser BindingExpr -> Parser BindingExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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
      where
        bindArrow :: Parser BindingExpr
bindArrow = do
          PrimitiveDataPattern
pat <- ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdPattern
          String -> ParsecT CustomError String RuntimeM ()
symbol String
"<-"
          Expr
e <- ParsecT CustomError String RuntimeM Expr
expr
          BindingExpr -> Parser BindingExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern -> Expr -> BindingExpr
Bind PrimitiveDataPattern
pat Expr
e)

    oneLiner :: Parser [BindingExpr]
    oneLiner :: ParsecT CustomError String RuntimeM [BindingExpr]
oneLiner = ParsecT CustomError String RuntimeM [BindingExpr]
-> ParsecT CustomError String RuntimeM [BindingExpr]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser PatternDef
patternDef)
  where
    patternDef :: Parser PatternDef
    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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (PrimitiveDataPattern, Expr)
dataCases)
      PatternDef -> Parser PatternDef
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatternDef -> Parser PatternDef)
-> PatternDef -> Parser PatternDef
forall a b. (a -> b) -> a -> b
$ PrimitivePatPattern
-> Expr -> [(PrimitiveDataPattern, Expr)] -> PatternDef
PatternDef 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ParsecT CustomError String RuntimeM ()
reserved String
"flipIndices"    ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Expr
FlipIndicesExpr    (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)

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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM [String]
-> ParsecT CustomError String RuntimeM [String]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser [Expr] -> Parser [Expr]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser [Expr]
section Parser [Expr]
-> ParsecT CustomError String RuntimeM () -> Parser [Expr]
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
x                 -- expression wrapped in parenthesis
    [Expr]
_   -> Expr -> ParsecT CustomError String RuntimeM Expr
forall a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 :: forall a. Parser a -> Parser (IndexExpr a)
index Parser a
p = a -> IndexExpr a
forall a. a -> IndexExpr a
SupSubscript (a -> IndexExpr a)
-> Parser a -> ParsecT CustomError String RuntimeM (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 (Tokens String)
-> Parser a -> Parser a
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p)
    ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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
-> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM (IndexExpr a)
subscript)
    ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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
-> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM (IndexExpr a)
superscript)
    ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM (IndexExpr a)
-> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 -> ParsecT CustomError String RuntimeM (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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p))
    ParsecT CustomError String RuntimeM (IndexExpr a)
-> String -> ParsecT CustomError String RuntimeM (IndexExpr a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"index"
  where
    subscript :: ParsecT CustomError String RuntimeM (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 (Tokens String)
-> Parser a -> Parser a
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 -> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> ParsecT CustomError String RuntimeM (IndexExpr a))
-> IndexExpr a -> ParsecT CustomError String RuntimeM (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 -> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> ParsecT CustomError String RuntimeM (IndexExpr a))
-> IndexExpr a -> ParsecT CustomError String RuntimeM (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 :: ParsecT CustomError String RuntimeM (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 (Tokens String)
-> Parser a -> Parser a
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 -> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> ParsecT CustomError String RuntimeM (IndexExpr a))
-> IndexExpr a -> ParsecT CustomError String RuntimeM (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 -> ParsecT CustomError String RuntimeM (IndexExpr a)
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexExpr a -> ParsecT CustomError String RuntimeM (IndexExpr a))
-> IndexExpr a -> ParsecT CustomError String RuntimeM (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 a. a -> ParsecT CustomError String RuntimeM a
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 (Tokens String) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Tokens String) -> Bool)
-> ParsecT CustomError String RuntimeM (Maybe (Tokens String))
-> ParsecT CustomError String RuntimeM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM (Tokens String)
-> ParsecT CustomError String RuntimeM (Maybe (Tokens String))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomError String RuntimeM (Tokens String)
-> ParsecT CustomError String RuntimeM (Tokens String)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 (Tokens String)
-> ParsecT CustomError String RuntimeM (IndexExpr Expr)
-> ParsecT CustomError String RuntimeM (Tokens String)
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr
FreshVarExpr Expr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Expr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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
-> ParsecT CustomError String RuntimeM Expr
-> ParsecT CustomError String RuntimeM Expr
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 (Tokens String)
-> ParsecT CustomError String RuntimeM Integer
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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
-> ParsecT CustomError String RuntimeM Integer
-> ParsecT CustomError String RuntimeM Integer
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 (Tokens String)
-> ParsecT CustomError String RuntimeM Integer
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConstantExpr
SomethingExpr ConstantExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConstantExpr
UndefinedExpr ConstantExpr
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 = ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM ConstantExpr
negativeFloatLiteral
          ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM ConstantExpr
negativeIntegerLiteral
          ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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"
  where
    -- Parse negative number literals (-1, -2.5, etc.)
    -- Only recognize as negative literal if there's no space after '-'
    negativeFloatLiteral :: ParsecT CustomError String RuntimeM ConstantExpr
negativeFloatLiteral = ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
lexeme (ParsecT CustomError String RuntimeM ConstantExpr
 -> ParsecT CustomError String RuntimeM ConstantExpr)
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a b. (a -> b) -> a -> b
$ do
      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 ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomError String RuntimeM Char
ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
      Double
n <- ParsecT CustomError String RuntimeM Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float
      ConstantExpr -> ParsecT CustomError String RuntimeM ConstantExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstantExpr -> ParsecT CustomError String RuntimeM ConstantExpr)
-> ConstantExpr -> ParsecT CustomError String RuntimeM ConstantExpr
forall a b. (a -> b) -> a -> b
$ Double -> ConstantExpr
FloatExpr (Double -> Double
forall a. Num a => a -> a
negate Double
n)
    
    negativeIntegerLiteral :: ParsecT CustomError String RuntimeM ConstantExpr
negativeIntegerLiteral = ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
lexeme (ParsecT CustomError String RuntimeM ConstantExpr
 -> ParsecT CustomError String RuntimeM ConstantExpr)
-> ParsecT CustomError String RuntimeM ConstantExpr
-> ParsecT CustomError String RuntimeM ConstantExpr
forall a b. (a -> b) -> a -> b
$ do
      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 ()
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomError String RuntimeM Char
ParsecT CustomError String RuntimeM (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
      Integer
n <- ParsecT CustomError String RuntimeM Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
      ConstantExpr -> ParsecT CustomError String RuntimeM ConstantExpr
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstantExpr -> ParsecT CustomError String RuntimeM ConstantExpr)
-> ConstantExpr -> ParsecT CustomError String RuntimeM ConstantExpr
forall a b. (a -> b) -> a -> b
$ Integer -> ConstantExpr
IntegerExpr (Integer -> Integer
forall a. Num a => a -> a
negate Integer
n)
--
-- Pattern
--

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

letPattern :: Parser Pattern
letPattern :: Parser Pattern
letPattern =
  String -> ParsecT CustomError String RuntimeM ()
reserved String
"let" ParsecT CustomError String RuntimeM ()
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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)
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> 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
"in" ParsecT CustomError String RuntimeM ()
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Pattern
pattern)

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

loopPattern :: Parser Pattern
loopPattern :: Parser 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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)
-> Parser Pattern
-> ParsecT CustomError String RuntimeM (Pattern -> Pattern)
forall a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Pattern
atomPattern ParsecT CustomError String RuntimeM (Pattern -> Pattern)
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser 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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
expr)
                  Pattern
as    <- Pattern -> Parser Pattern -> Parser Pattern
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Pattern
WildCard (ParsecT CustomError String RuntimeM ()
comma ParsecT CustomError String RuntimeM ()
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Pattern
pattern)
                  LoopRange -> ParsecT CustomError String RuntimeM LoopRange
forall a. a -> ParsecT CustomError String RuntimeM a
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
"i.-" [Expr
s, ConstantExpr -> Expr
ConstantExpr (Integer -> ConstantExpr
IntegerExpr Integer
1)]]

seqPattern :: Parser Pattern
seqPattern :: Parser Pattern
seqPattern = do
  [Pattern]
pats <- Parser [Pattern] -> Parser [Pattern]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
braces (Parser [Pattern] -> Parser [Pattern])
-> Parser [Pattern] -> Parser [Pattern]
forall a b. (a -> b) -> a -> b
$ Parser Pattern
-> ParsecT CustomError String RuntimeM () -> Parser [Pattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser Pattern
pattern ParsecT CustomError String RuntimeM ()
comma
  Pattern -> Parser Pattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Parser Pattern) -> Pattern -> Parser Pattern
forall a b. (a -> b) -> a -> b
$ (Pattern -> Pattern -> Pattern) -> Pattern -> [Pattern] -> Pattern
forall a b. (a -> b -> b) -> b -> [a] -> b
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 :: Parser 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
  Parser Pattern
-> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
-> Parser Pattern
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parser 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 =
  [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
-> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
forall a. [a] -> [a]
reverse ([[Operator (ParsecT CustomError String RuntimeM) Pattern]]
 -> [[Operator (ParsecT CustomError String RuntimeM) Pattern]])
-> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
-> [[Operator (ParsecT CustomError String RuntimeM) Pattern]]
forall a b. (a -> b) -> a -> b
$ ([(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)]]
 -> [[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
$ ((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 -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
    -> Int)
-> (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
-> (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
-> Int
forall a b. (a, b) -> a
fst) ([(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
 -> [[(Int,
       Operator (ParsecT CustomError String RuntimeM) Pattern)]])
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
-> [[(Int,
      Operator (ParsecT CustomError String RuntimeM) Pattern)]]
forall a b. (a -> b) -> a -> b
$ ((Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
 -> Int)
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Operator (ParsecT CustomError String RuntimeM) Pattern)
-> Int
forall a b. (a, b) -> a
fst ([(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
 -> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)])
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
-> [(Int, Operator (ParsecT CustomError String RuntimeM) Pattern)]
forall a b. (a -> b) -> a -> b
$
    (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
  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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomError String RuntimeM Pos
indented ParsecT CustomError String RuntimeM Pos
-> ParsecT CustomError String RuntimeM Op
-> ParsecT CustomError String RuntimeM Op
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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 :: Parser Pattern
applyOrAtomPattern = (do
    (Pattern
func, [Pattern]
args) <- Parser Pattern -> Parser Pattern -> Parser (Pattern, [Pattern])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentBlock (Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Pattern
atomPattern) Parser Pattern
atomPattern
    case (Pattern
func, [Pattern]
args) of
      (Pattern
_,                 []) -> Pattern -> Parser Pattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern
func
      (InductivePat String
x [], [Pattern]
_)  -> Pattern -> Parser Pattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Parser Pattern) -> Pattern -> Parser Pattern
forall a b. (a -> b) -> a -> b
$ String -> [Pattern] -> Pattern
InductiveOrPApplyPat String
x [Pattern]
args
      (Pattern, [Pattern])
_                       -> Pattern -> Parser Pattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Parser Pattern) -> Pattern -> Parser Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> [Pattern] -> Pattern
DApplyPat Pattern
func [Pattern]
args)
  Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
    (Expr
func, [Pattern]
args) <- ParsecT CustomError String RuntimeM Expr
-> Parser Pattern -> Parser (Expr, [Pattern])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentBlock ParsecT CustomError String RuntimeM Expr
atomExpr Parser Pattern
atomPattern
    Pattern -> Parser Pattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Parser Pattern) -> Pattern -> Parser Pattern
forall a b. (a -> b) -> a -> b
$ Expr -> [Pattern] -> Pattern
PApplyPat Expr
func [Pattern]
args)

collectionPattern :: Parser Pattern
collectionPattern :: Parser Pattern
collectionPattern = Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
brackets (Parser Pattern -> Parser Pattern)
-> Parser Pattern -> Parser Pattern
forall a b. (a -> b) -> a -> b
$ do
  [Pattern]
elems <- Parser Pattern
-> ParsecT CustomError String RuntimeM () -> Parser [Pattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser Pattern
pattern ParsecT CustomError String RuntimeM ()
comma
  Pattern -> Parser Pattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Parser Pattern) -> Pattern -> Parser Pattern
forall a b. (a -> b) -> a -> b
$ (Pattern -> Pattern -> Pattern) -> Pattern -> [Pattern] -> Pattern
forall a b. (a -> b -> b) -> b -> [a] -> b
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
"[]" []
      consOp :: Op
consOp = String -> [Op] -> Op
findOpFrom String
"::" [Op]
reservedPatternOp

-- (Possibly indexed) atomic pattern
atomPattern :: Parser Pattern
atomPattern :: Parser Pattern
atomPattern = do
  Pattern
pat     <- Parser 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr'
  Pattern -> Parser Pattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Parser Pattern) -> Pattern -> Parser 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' :: Parser Pattern
atomPattern' = Pattern
WildCard Pattern -> ParsecT CustomError String RuntimeM () -> Parser Pattern
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  String -> ParsecT CustomError String RuntimeM ()
symbol String
"_"
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Pattern
PatVar   (String -> Pattern)
-> ParsecT CustomError String RuntimeM String -> Parser Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomError String RuntimeM String
patVarLiteral
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern -> Pattern
NotPat   (Pattern -> Pattern) -> Parser Pattern -> Parser Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT CustomError String RuntimeM ()
symbol String
"!" ParsecT CustomError String RuntimeM ()
-> Parser Pattern -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Pattern
atomPattern)
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> Pattern
ValuePat (Expr -> Pattern)
-> ParsecT CustomError String RuntimeM Expr -> Parser 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr)
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pattern
collectionPattern
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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] -> Parser Pattern
forall a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Pattern] -> Parser [Pattern]
forall a. a -> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Pattern
VarPat   (String -> Pattern)
-> ParsecT CustomError String RuntimeM String -> Parser 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM String
lowerId)
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> Pattern
PredPat  (Expr -> Pattern)
-> ParsecT CustomError String RuntimeM Expr -> Parser 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomError String RuntimeM Expr
atomExpr)
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern
ContPat  Pattern -> ParsecT CustomError String RuntimeM () -> Parser Pattern
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"..."
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pattern -> ([Pattern] -> Pattern) -> Parser Pattern
forall a. Parser a -> ([a] -> a) -> Parser a
makeTupleOrParen Parser Pattern
pattern [Pattern] -> Pattern
TuplePat
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pattern
seqPattern
           Parser Pattern -> Parser Pattern -> Parser Pattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern
LaterPatVar Pattern -> ParsecT CustomError String RuntimeM () -> Parser Pattern
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"@"
           Parser Pattern -> String -> Parser 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 =
      [[Operator
    (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
forall a. [a] -> [a]
reverse ([[Operator
     (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
 -> [[Operator
        (ParsecT CustomError String RuntimeM) PrimitivePatPattern]])
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
forall a b. (a -> b) -> a -> b
$ ([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]]
 -> [[Operator
        (ParsecT CustomError String RuntimeM) PrimitivePatPattern]])
-> [[Op]]
-> [[Operator
       (ParsecT CustomError String RuntimeM) PrimitivePatPattern]]
forall a b. (a -> b) -> a -> b
$ (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] -> [[Op]]) -> [Op] -> [[Op]]
forall a b. (a -> b) -> a -> b
$
        (Op -> Int) -> [Op] -> [Op]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Op -> Int
priority [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 a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrimitivePatPattern
PPPatVar   PrimitivePatPattern
-> ParsecT CustomError String RuntimeM ()
-> Parser PrimitivePatPattern
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 (Tokens String)
-> ParsecT CustomError String RuntimeM String
-> ParsecT CustomError String RuntimeM String
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [PrimitivePatPattern] -> PrimitivePatPattern
PPInductivePat String
"[]" [] PrimitivePatPattern
-> ParsecT CustomError String RuntimeM ()
-> Parser PrimitivePatPattern
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 =
      [ [ Parser
  (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 ()
-> Parser
     (PrimitiveDataPattern
      -> PrimitiveDataPattern -> PrimitiveDataPattern)
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT CustomError String RuntimeM ()
symbol String
"::")
        , Parser
  (PrimitiveDataPattern
   -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> Operator
     (ParsecT CustomError String RuntimeM) PrimitiveDataPattern
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDSnocPat (PrimitiveDataPattern
 -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> ParsecT CustomError String RuntimeM ()
-> Parser
     (PrimitiveDataPattern
      -> PrimitiveDataPattern -> PrimitiveDataPattern)
forall a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 = ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomError String RuntimeM PrimitiveDataPattern
mathExprPrimitivePattern
                ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM PrimitiveDataPattern
pdAtom
    
    -- MathExpr primitive patterns
    mathExprPrimitivePattern :: Parser PrimitiveDataPattern
    mathExprPrimitivePattern :: ParsecT CustomError String RuntimeM PrimitiveDataPattern
mathExprPrimitivePattern = do
      String
name <- ParsecT CustomError String RuntimeM String
upperId
      case String
name of
        String
"Div" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDDivPat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Div requires exactly 2 arguments"
        String
"Plus" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern -> PrimitiveDataPattern
forall var. PDPatternBase var -> PDPatternBase var
PDPlusPat PrimitiveDataPattern
p
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Plus requires exactly 1 argument"
        String
"Term" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDTermPat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Term requires exactly 2 arguments"
        String
"Symbol" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDSymbolPat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Symbol requires exactly 2 arguments"
        String
"Apply1" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDApply1Pat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Apply1 requires exactly 2 arguments"
        String
"Apply2" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2, PrimitiveDataPattern
p3] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
forall var.
PDPatternBase var
-> PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDApply2Pat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2 PrimitiveDataPattern
p3
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Apply2 requires exactly 3 arguments"
        String
"Apply3" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2, PrimitiveDataPattern
p3, PrimitiveDataPattern
p4] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
forall var.
PDPatternBase var
-> PDPatternBase var
-> PDPatternBase var
-> PDPatternBase var
-> PDPatternBase var
PDApply3Pat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2 PrimitiveDataPattern
p3 PrimitiveDataPattern
p4
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Apply3 requires exactly 4 arguments"
        String
"Apply4" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2, PrimitiveDataPattern
p3, PrimitiveDataPattern
p4, PrimitiveDataPattern
p5] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
-> PrimitiveDataPattern
forall var.
PDPatternBase var
-> PDPatternBase var
-> PDPatternBase var
-> PDPatternBase var
-> PDPatternBase var
-> PDPatternBase var
PDApply4Pat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2 PrimitiveDataPattern
p3 PrimitiveDataPattern
p4 PrimitiveDataPattern
p5
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Apply4 requires exactly 5 arguments"
        String
"Quote" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern -> PrimitiveDataPattern
forall var. PDPatternBase var -> PDPatternBase var
PDQuotePat PrimitiveDataPattern
p
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Quote requires exactly 1 argument"
        String
"Function" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p1, PrimitiveDataPattern
p2] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDFunctionPat PrimitiveDataPattern
p1 PrimitiveDataPattern
p2
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Function requires exactly 2 arguments"
        String
"Sub" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern -> PrimitiveDataPattern
forall var. PDPatternBase var -> PDPatternBase var
PDSubPat PrimitiveDataPattern
p
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Sub requires exactly 1 argument"
        String
"Sup" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern -> PrimitiveDataPattern
forall var. PDPatternBase var -> PDPatternBase var
PDSupPat PrimitiveDataPattern
p
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Sup requires exactly 1 argument"
        String
"User" -> do
          [PrimitiveDataPattern]
args <- 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
          case [PrimitiveDataPattern]
args of
            [PrimitiveDataPattern
p] -> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveDataPattern
 -> ParsecT CustomError String RuntimeM PrimitiveDataPattern)
-> PrimitiveDataPattern
-> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a b. (a -> b) -> a -> b
$ PrimitiveDataPattern -> PrimitiveDataPattern
forall var. PDPatternBase var -> PDPatternBase var
PDUserPat PrimitiveDataPattern
p
            [PrimitiveDataPattern]
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"User requires exactly 1 argument"
        String
_ -> String -> ParsecT CustomError String RuntimeM PrimitiveDataPattern
forall a. String -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a MathExpr primitive pattern"

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 a b.
a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((PrimitiveDataPattern
 -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> PrimitiveDataPattern
-> [PrimitiveDataPattern]
-> PrimitiveDataPattern
forall a b. (a -> b -> b) -> b -> [a] -> b
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 :: forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
lexeme = ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
brackets ([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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomError String RuntimeM VarIndex
-> ParsecT CustomError String RuntimeM VarIndex
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
braces ([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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
              (String
n, Integer
s) <- Parser (String, Integer) -> Parser (String, Integer)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 (Tokens String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 (Tokens String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
              (String
n, Integer
s) <- Parser (String, Integer) -> Parser (String, Integer)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 (Tokens String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 (Tokens String)
-> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM Char
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a. a -> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 = isJust 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 (Tokens String)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 (Tokens String)
-> ParsecT CustomError String RuntimeM (Tokens String)
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 (Tokens String)
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM ()
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT CustomError String RuntimeM ()
forall a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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
ParsecT CustomError String RuntimeM (Token String)
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a. a -> ParsecT CustomError String RuntimeM a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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
-> ParsecT CustomError String RuntimeM ()
-> ParsecT CustomError String RuntimeM Char
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomError String RuntimeM Char
-> ParsecT CustomError String RuntimeM ()
forall a.
ParsecT CustomError String RuntimeM a
-> 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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 :: forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
parens = 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
")")

braces :: Parser a -> Parser a
braces :: forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
braces = 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
"}")

brackets :: Parser a -> Parser a
brackets :: forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
brackets  = 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
"]")

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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> (a -> ParsecT CustomError String RuntimeM b)
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lowerReservedWords
                then String -> m String
forall a. String -> m a
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 a. a -> m a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> (a -> ParsecT CustomError String RuntimeM b)
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomError String RuntimeM String
identString
    check :: String -> m String
check String
x = if String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
upperReservedWords
                then String -> m String
forall a. String -> m a
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 a. a -> m a
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.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> (a -> ParsecT CustomError String RuntimeM b)
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 a. String -> m a
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 a. a -> m a
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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
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 a b.
ParsecT CustomError String RuntimeM a
-> (a -> ParsecT CustomError String RuntimeM b)
-> ParsecT CustomError String RuntimeM b
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 a b.
ParsecT CustomError String RuntimeM (a -> b)
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 a. String -> m a
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 a. a -> m a
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
"declare"
  , 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
"flipIndices"
  , 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 :: forall a. Parser a -> ([a] -> a) -> Parser a
makeTupleOrParen Parser a
parser [a] -> a
tupleCtor = do
  [a]
elems <- Parser [a] -> Parser [a]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
elem
    [a]
_      -> a -> Parser a
forall a. a -> ParsecT CustomError String RuntimeM 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 -> ParsecT CustomError String RuntimeM Pos
indentGuardEQ Pos
pos = ParsecT CustomError String RuntimeM ()
-> Ordering -> Pos -> ParsecT CustomError String RuntimeM 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 -> ParsecT CustomError String RuntimeM Pos
indentGuardGT Pos
pos = ParsecT CustomError String RuntimeM ()
-> Ordering -> Pos -> ParsecT CustomError String RuntimeM 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 :: forall a. Parser a -> Parser [a]
alignSome Parser a
p = do
  Pos
pos <- ParsecT CustomError String RuntimeM 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 -> ParsecT CustomError String RuntimeM Pos
indentGuardEQ Pos
pos ParsecT CustomError String RuntimeM Pos -> Parser a -> Parser a
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
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 :: forall a b. Parser a -> Parser b -> Parser (a, [b])
indentBlock Parser a
phead Parser b
parg = do
  Pos
pos  <- ParsecT CustomError String RuntimeM 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 -> ParsecT CustomError String RuntimeM Pos
indentGuardGT Pos
pos ParsecT CustomError String RuntimeM Pos -> Parser b -> Parser b
forall a b.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM b
-> ParsecT CustomError String RuntimeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser b
parg)
  (a, [b]) -> Parser (a, [b])
forall a. a -> ParsecT CustomError String RuntimeM a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
head, [b]
args)

indented :: Parser Pos
indented :: ParsecT CustomError String RuntimeM Pos
indented = Pos -> ParsecT CustomError String RuntimeM Pos
indentGuardGT Pos
pos1

infixToOperator :: (Op -> Parser (a -> a -> a)) -> Op -> Operator Parser a
infixToOperator :: forall a.
(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 :: forall a. Parser a -> Parser [a]
tupleOrSome Parser a
p = Parser [a] -> Parser [a]
forall a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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 a.
ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM a
-> ParsecT CustomError String RuntimeM 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