{-# LANGUAGE CPP, OverloadedStrings, LambdaCase #-}
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
module Language.Hakaru.Parser.Maple where

import           Prelude             hiding (not, and, sum, product)
import           Control.Monad.Identity
import           Data.Text           (Text)
import qualified Data.Text           as Text
import           Data.Ratio
#if __GLASGOW_HASKELL__ < 710
import           Data.Functor        ((<$>))
import           Control.Applicative (Applicative(..))
#endif
import           Text.Parsec
import           Text.Parsec.Text
import qualified Text.Parsec.Token   as Token
import           Text.Parsec.Language

import           Language.Hakaru.Parser.AST hiding (Less, Equal)

----------------------------------------------------------------

style :: GenLanguageDef Text st Identity
style :: GenLanguageDef Text st Identity
style = LanguageDef :: forall s u (m :: * -> *).
String
-> String
-> String
-> Bool
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> [String]
-> [String]
-> Bool
-> GenLanguageDef s u m
Token.LanguageDef
    { commentStart :: String
Token.commentStart   = String
"(*"
    , commentEnd :: String
Token.commentEnd     = String
"*)"
    , commentLine :: String
Token.commentLine    = String
"#"
    , nestedComments :: Bool
Token.nestedComments = Bool
True
    , identStart :: ParsecT Text st Identity Char
Token.identStart     = ParsecT Text st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT Text st Identity Char
-> ParsecT Text st Identity Char -> ParsecT Text st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
    , identLetter :: ParsecT Text st Identity Char
Token.identLetter    = ParsecT Text st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT Text st Identity Char
-> ParsecT Text st Identity Char -> ParsecT Text st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_"
    , opStart :: ParsecT Text st Identity Char
Token.opStart        = GenLanguageDef Text st Identity -> ParsecT Text st Identity Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
Token.opLetter GenLanguageDef Text st Identity
forall st. GenLanguageDef Text st Identity
style
    , opLetter :: ParsecT Text st Identity Char
Token.opLetter       = String -> ParsecT Text st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-*/<>="
    , reservedOpNames :: [String]
Token.reservedOpNames= []
    , reservedNames :: [String]
Token.reservedNames  = []
    , caseSensitive :: Bool
Token.caseSensitive  = Bool
False
    }

type TokenParser a = Token.GenTokenParser Text a Identity

lexer :: TokenParser ()
lexer :: TokenParser ()
lexer = GenLanguageDef Text () Identity -> TokenParser ()
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
Token.makeTokenParser GenLanguageDef Text () Identity
forall st. GenLanguageDef Text st Identity
style

integer :: Parser Integer
integer :: Parser Integer
integer = TokenParser () -> Parser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
Token.integer TokenParser ()
lexer

parens :: Parser a -> Parser a
parens :: Parser a -> Parser a
parens = TokenParser ()
-> forall a.
   ParsecT Text () Identity a -> ParsecT Text () Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
Token.parens TokenParser ()
lexer

identifier :: Parser Text
identifier :: Parser Text
identifier = String -> Text
Text.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser () -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
Token.identifier TokenParser ()
lexer

stringLiteral :: Parser Text
stringLiteral :: Parser Text
stringLiteral = String -> Text
Text.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser () -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
Token.stringLiteral TokenParser ()
lexer

comma :: Parser String
comma :: ParsecT Text () Identity String
comma = TokenParser () -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
Token.comma TokenParser ()
lexer

commaSep :: Parser a -> Parser [a]
commaSep :: Parser a -> Parser [a]
commaSep = TokenParser ()
-> forall a.
   ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m [a]
Token.commaSep TokenParser ()
lexer

symTable :: [(Text, Text)]
symTable :: [(Text, Text)]
symTable =
    [ (Text
"Gaussian",    Text
"normal")
    , (Text
"BetaD",       Text
"beta")
    , (Text
"GammaD",      Text
"gamma")
    , (Text
"PoissonD",    Text
"poisson")
    , (Text
"Weight",      Text
"weight")
    , (Text
"Lebesgue",    Text
"lebesgue")
    , (Text
"Counting",    Text
"counting")
    , (Text
"Uniform",     Text
"uniform")
    , (Text
"Ret",         Text
"dirac")
    , (Text
"Categorical", Text
"categorical")
    , (Text
"Geometric",   Text
"geometric")
    , (Text
"Not",         Text
"not")
    , (Text
"Pi",          Text
"pi")
    , (Text
"ln",          Text
"log")
    , (Text
"Beta",        Text
"betaFunc")
    , (Text
"GAMMA",       Text
"gammaFunc")
    , (Text
"csgn",        Text
"signum")
    -- Type symbols
    , (Text
"Real",        Text
"real")
    , (Text
"Prob",        Text
"prob")
    , (Text
"Measure",     Text
"measure")
    , (Text
"Bool",        Text
"bool")
    ]

rename :: Text -> Text
rename :: Text -> Text
rename Text
x =
    case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
x [(Text, Text)]
symTable of
    Just Text
x' -> Text
x'
    Maybe Text
Nothing -> Text
x

arg :: Parser a -> Parser [a]
arg :: Parser a -> Parser [a]
arg Parser a
e = Parser [a] -> Parser [a]
forall a. ParsecT Text () Identity a -> ParsecT Text () Identity a
parens (Parser a -> Parser [a]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
commaSep Parser a
e)

text :: Text -> Parser Text
text :: Text -> Parser Text
text = (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Text
Text.pack (ParsecT Text () Identity String -> Parser Text)
-> (String -> ParsecT Text () Identity String)
-> String
-> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String -> Parser Text) -> (Text -> String) -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
Text.unpack

----------------------------------------------------------------
-- | Grammar of Inert Expressions

data NumOp = Pos | Neg
    deriving (NumOp -> NumOp -> Bool
(NumOp -> NumOp -> Bool) -> (NumOp -> NumOp -> Bool) -> Eq NumOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumOp -> NumOp -> Bool
$c/= :: NumOp -> NumOp -> Bool
== :: NumOp -> NumOp -> Bool
$c== :: NumOp -> NumOp -> Bool
Eq, Int -> NumOp -> ShowS
[NumOp] -> ShowS
NumOp -> String
(Int -> NumOp -> ShowS)
-> (NumOp -> String) -> ([NumOp] -> ShowS) -> Show NumOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumOp] -> ShowS
$cshowList :: [NumOp] -> ShowS
show :: NumOp -> String
$cshow :: NumOp -> String
showsPrec :: Int -> NumOp -> ShowS
$cshowsPrec :: Int -> NumOp -> ShowS
Show)

data ArgOp
    = Float | Power  | Rational
    | Func  | ExpSeq | Sum_
    | Prod_ | Less   | Equal
    | NotEq | Not_   | And_
    | Range | List
    deriving (ArgOp -> ArgOp -> Bool
(ArgOp -> ArgOp -> Bool) -> (ArgOp -> ArgOp -> Bool) -> Eq ArgOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgOp -> ArgOp -> Bool
$c/= :: ArgOp -> ArgOp -> Bool
== :: ArgOp -> ArgOp -> Bool
$c== :: ArgOp -> ArgOp -> Bool
Eq, Int -> ArgOp -> ShowS
[ArgOp] -> ShowS
ArgOp -> String
(Int -> ArgOp -> ShowS)
-> (ArgOp -> String) -> ([ArgOp] -> ShowS) -> Show ArgOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgOp] -> ShowS
$cshowList :: [ArgOp] -> ShowS
show :: ArgOp -> String
$cshow :: ArgOp -> String
showsPrec :: Int -> ArgOp -> ShowS
$cshowsPrec :: Int -> ArgOp -> ShowS
Show)

data InertExpr
    = InertName Text
    | InertNum  NumOp Integer
    | InertArgs ArgOp [InertExpr]
    deriving (InertExpr -> InertExpr -> Bool
(InertExpr -> InertExpr -> Bool)
-> (InertExpr -> InertExpr -> Bool) -> Eq InertExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InertExpr -> InertExpr -> Bool
$c/= :: InertExpr -> InertExpr -> Bool
== :: InertExpr -> InertExpr -> Bool
$c== :: InertExpr -> InertExpr -> Bool
Eq, Int -> InertExpr -> ShowS
[InertExpr] -> ShowS
InertExpr -> String
(Int -> InertExpr -> ShowS)
-> (InertExpr -> String)
-> ([InertExpr] -> ShowS)
-> Show InertExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InertExpr] -> ShowS
$cshowList :: [InertExpr] -> ShowS
show :: InertExpr -> String
$cshow :: InertExpr -> String
showsPrec :: Int -> InertExpr -> ShowS
$cshowsPrec :: Int -> InertExpr -> ShowS
Show)

----------------------------------------------------------------
-- Parsing String into Inert Expression

func :: Parser InertExpr
func :: Parser InertExpr
func =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_FUNCTION" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Func)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

name :: Parser InertExpr
name :: Parser InertExpr
name =
    Text -> InertExpr
InertName
    (Text -> InertExpr) -> Parser Text -> Parser InertExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_NAME" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser Text
forall a. ParsecT Text () Identity a -> ParsecT Text () Identity a
parens Parser Text
stringLiteral)

localname :: Parser InertExpr
localname :: Parser InertExpr
localname =
    Text -> InertExpr
InertName
    (Text -> InertExpr) -> Parser Text -> Parser InertExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_LOCALNAME"
        Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser Text
forall a. ParsecT Text () Identity a -> ParsecT Text () Identity a
parens
            (  Parser Text
stringLiteral
            Parser Text -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity String
comma
            Parser Text -> Parser Integer -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Integer
integer))

assignedname :: Parser InertExpr
assignedname :: Parser InertExpr
assignedname =
    Text -> InertExpr
InertName
    (Text -> InertExpr) -> Parser Text -> Parser InertExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_ASSIGNEDNAME"
        Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser Text
forall a. ParsecT Text () Identity a -> ParsecT Text () Identity a
parens
            (  Parser Text
stringLiteral
            Parser Text -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity String
comma
            Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
stringLiteral))

assignedlocalname :: Parser InertExpr
assignedlocalname :: Parser InertExpr
assignedlocalname =
    Text -> InertExpr
InertName
    (Text -> InertExpr) -> Parser Text -> Parser InertExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_ASSIGNEDLOCALNAME"
        Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser Text
forall a. ParsecT Text () Identity a -> ParsecT Text () Identity a
parens
            (  Parser Text
stringLiteral
            Parser Text -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity String
comma
            Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
stringLiteral
            Parser Text -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity String
comma
            Parser Text -> Parser Integer -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Integer
integer))

expseq :: Parser InertExpr
expseq :: Parser InertExpr
expseq =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_EXPSEQ" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
ExpSeq)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

intpos :: Parser InertExpr
intpos :: Parser InertExpr
intpos =
    NumOp -> Integer -> InertExpr
InertNum
    (NumOp -> Integer -> InertExpr)
-> ParsecT Text () Identity NumOp
-> ParsecT Text () Identity (Integer -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_INTPOS" Parser Text
-> ParsecT Text () Identity NumOp -> ParsecT Text () Identity NumOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NumOp -> ParsecT Text () Identity NumOp
forall (m :: * -> *) a. Monad m => a -> m a
return NumOp
Pos)
    ParsecT Text () Identity (Integer -> InertExpr)
-> Parser Integer -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Integer -> Parser Integer
forall a. ParsecT Text () Identity a -> ParsecT Text () Identity a
parens Parser Integer
integer

intneg :: Parser InertExpr
intneg :: Parser InertExpr
intneg =
    NumOp -> Integer -> InertExpr
InertNum
    (NumOp -> Integer -> InertExpr)
-> ParsecT Text () Identity NumOp
-> ParsecT Text () Identity (Integer -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_INTNEG" Parser Text
-> ParsecT Text () Identity NumOp -> ParsecT Text () Identity NumOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NumOp -> ParsecT Text () Identity NumOp
forall (m :: * -> *) a. Monad m => a -> m a
return NumOp
Neg)
    ParsecT Text () Identity (Integer -> InertExpr)
-> Parser Integer -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> Integer) -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
forall a. Num a => a -> a
negate (Parser Integer -> Parser Integer
forall a. ParsecT Text () Identity a -> ParsecT Text () Identity a
parens Parser Integer
integer)

float :: Parser InertExpr
float :: Parser InertExpr
float  =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_FLOAT" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Float)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

power :: Parser InertExpr
power :: Parser InertExpr
power =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_POWER" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Power)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

range :: Parser InertExpr
range :: Parser InertExpr
range =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_RANGE" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Range)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

and :: Parser InertExpr
and :: Parser InertExpr
and =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_AND" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
And_)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

list :: Parser InertExpr
list :: Parser InertExpr
list =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_LIST" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
List)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

sum :: Parser InertExpr
sum :: Parser InertExpr
sum =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_SUM" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Sum_)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

product :: Parser InertExpr
product :: Parser InertExpr
product =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_PROD" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Prod_)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

rational :: Parser InertExpr
rational :: Parser InertExpr
rational =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_RATIONAL" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Rational)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

lessthan :: Parser InertExpr
lessthan :: Parser InertExpr
lessthan =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_LESSTHAN" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Less)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

not :: Parser InertExpr
not :: Parser InertExpr
not =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_NOT" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Not_)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

lesseq :: Parser InertExpr
lesseq :: Parser InertExpr
lesseq = do
    Text
_ <- Text -> Parser Text
text Text
"_Inert_LESSEQ"
    [InertExpr]
args <- Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr
    InertExpr -> Parser InertExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (InertExpr -> Parser InertExpr) -> InertExpr -> Parser InertExpr
forall a b. (a -> b) -> a -> b
$ ArgOp -> [InertExpr] -> InertExpr
InertArgs ArgOp
Not_
               [ ArgOp -> [InertExpr] -> InertExpr
InertArgs ArgOp
Less ([InertExpr] -> [InertExpr]
forall a. [a] -> [a]
reverse [InertExpr]
args)]

equal :: Parser InertExpr
equal :: Parser InertExpr
equal =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_EQUATION" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
Equal)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

noteq :: Parser InertExpr
noteq :: Parser InertExpr
noteq =
    ArgOp -> [InertExpr] -> InertExpr
InertArgs
    (ArgOp -> [InertExpr] -> InertExpr)
-> ParsecT Text () Identity ArgOp
-> ParsecT Text () Identity ([InertExpr] -> InertExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
text Text
"_Inert_INEQUAT" Parser Text
-> ParsecT Text () Identity ArgOp -> ParsecT Text () Identity ArgOp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ArgOp -> ParsecT Text () Identity ArgOp
forall (m :: * -> *) a. Monad m => a -> m a
return ArgOp
NotEq)
    ParsecT Text () Identity ([InertExpr] -> InertExpr)
-> ParsecT Text () Identity [InertExpr] -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InertExpr -> ParsecT Text () Identity [InertExpr]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
arg Parser InertExpr
expr

expr :: Parser InertExpr
expr :: Parser InertExpr
expr =  Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
func
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
name
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
list
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
and
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
not
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
lessthan
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
lesseq
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
equal
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
noteq
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
assignedname
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
assignedlocalname
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
localname
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
expseq
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
intpos
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
intneg
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
range
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
power
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
sum
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
product
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser InertExpr
rational
    Parser InertExpr -> Parser InertExpr -> Parser InertExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser InertExpr
float

parseMaple :: Text -> Either ParseError InertExpr
parseMaple :: Text -> Either ParseError InertExpr
parseMaple Text
txt =
    Parser InertExpr
-> () -> String -> Text -> Either ParseError InertExpr
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser (Parser InertExpr
expr Parser InertExpr -> ParsecT Text () Identity () -> Parser InertExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) () (Text -> String
Text.unpack Text
txt) ((Char -> Bool) -> Text -> Text
Text.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
txt)

----------------------------------------------------------------
-- Parsing InertExpr to AST' Text

collapseNaryOp :: NaryOp -> [AST' Text] -> [AST' Text]
collapseNaryOp :: NaryOp -> [AST' Text] -> [AST' Text]
collapseNaryOp NaryOp
op =
    (AST' Text -> [AST' Text]) -> [AST' Text] -> [AST' Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case
                NaryOp NaryOp
op' [AST' Text]
e | NaryOp
op NaryOp -> NaryOp -> Bool
forall a. Eq a => a -> a -> Bool
== NaryOp
op' ->  [AST' Text]
e
                AST' Text
t                        -> [AST' Text
t])


maple2AST :: InertExpr -> AST' Text
maple2AST :: InertExpr -> AST' Text
maple2AST (InertNum NumOp
Pos Integer
i)       = Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text) -> Literal' -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer -> Literal'
Nat (Integer -> Literal') -> Integer -> Literal'
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
i
maple2AST (InertNum NumOp
Neg Integer
i)       = Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text) -> Literal' -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer -> Literal'
Int (Integer -> Literal') -> Integer -> Literal'
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
i
maple2AST (InertName Text
"infinity") = AST' Text
forall a. AST' a
Infinity'
maple2AST (InertName Text
t)          = Text -> AST' Text
forall a. a -> AST' a
Var (Text -> Text
rename Text
t)

maple2AST (InertArgs ArgOp
Float [InertNum NumOp
Pos Integer
a, InertNum NumOp
_ Integer
b]) = 
    Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text)
-> (Rational -> Literal') -> Rational -> AST' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal'
Prob (Rational -> AST' Text) -> Rational -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
10 Rational -> Integer -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
b)

maple2AST (InertArgs ArgOp
Float [InertNum NumOp
Neg Integer
a, InertNum NumOp
_ Integer
b]) = 
    Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text)
-> (Rational -> Literal') -> Rational -> AST' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal'
Real (Rational -> AST' Text) -> Rational -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
10 Rational -> Integer -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
b)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Let", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertName Text
x, InertExpr
e2]]) =
    Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a
Let Text
x (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Bind", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertName Text
x, InertExpr
e2]]) =
    Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a
Bind Text
x (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Datum", InertArgs ArgOp
ExpSeq [InertName Text
h, InertExpr
d]]) =
    Text -> InertExpr -> AST' Text
mapleDatum2AST Text
h InertExpr
d

maple2AST (InertArgs ArgOp
Func [InertName Text
"Counting", InertExpr
_]) =
    Text -> AST' Text
forall a. a -> AST' a
Var Text
"counting"

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"lam", InertArgs ArgOp
ExpSeq [InertName Text
x, InertExpr
typ, InertExpr
e1]]) =
    Text -> TypeAST' -> AST' Text -> AST' Text
forall a. a -> TypeAST' -> AST' a -> AST' a
Lam Text
x (InertExpr -> TypeAST'
maple2Type InertExpr
typ) (InertExpr -> AST' Text
maple2AST InertExpr
e1)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"app", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertExpr
e2]]) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"NegativeBinomial", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertExpr
e2]]) =
    Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a
Bind Text
"i" (Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a
op2 Text
"gamma" AST' Text
r (AST' Text -> AST' Text
recip_ (AST' Text -> AST' Text) -> AST' Text -> AST' Text
forall a b. (a -> b) -> a -> b
$ AST' Text -> AST' Text
recip_ AST' Text
p AST' Text -> AST' Text -> AST' Text
forall a. IsString a => AST' a -> AST' a -> AST' a
-. (Literal' -> AST' Text
forall a. Literal' -> AST' a
lit (Literal' -> AST' Text) -> Literal' -> AST' Text
forall a b. (a -> b) -> a -> b
$ Rational -> Literal'
Prob Rational
1)))
         (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"poisson") (Text -> AST' Text
forall a. a -> AST' a
Var Text
"i"))
    where recip_ :: AST' Text -> AST' Text
recip_     = AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"recip")
          AST' a
x -. :: AST' a -> AST' a -> AST' a
-. AST' a
y     = NaryOp -> [AST' a] -> AST' a
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
Sum [AST' a
x, AST' a -> AST' a -> AST' a
forall a. AST' a -> AST' a -> AST' a
App (a -> AST' a
forall a. a -> AST' a
Var a
"negate") AST' a
y]
          op2 :: a -> AST' a -> AST' a -> AST' a
op2  a
s AST' a
x AST' a
y = AST' a -> AST' a -> AST' a
forall a. AST' a -> AST' a -> AST' a
App (AST' a -> AST' a -> AST' a
forall a. AST' a -> AST' a -> AST' a
App (a -> AST' a
forall a. a -> AST' a
Var a
s) AST' a
x) AST' a
y
          lit :: Literal' -> AST' a
lit        = Literal' -> AST' a
forall a. Literal' -> AST' a
ULiteral
          r :: AST' Text
r          = InertExpr -> AST' Text
maple2AST InertExpr
e1
          p :: AST' Text
p          = InertExpr -> AST' Text
maple2AST InertExpr
e2

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Msum", InertArgs ArgOp
ExpSeq []]) =
    Text -> AST' Text
forall a. a -> AST' a
Var Text
"reject"

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Msum", InertArgs ArgOp
ExpSeq [InertExpr]
es]) =
    [AST' Text] -> AST' Text
forall a. [AST' a] -> AST' a
Msum ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"ary", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertName Text
x, InertExpr
e2]]) =
    Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a
Array Text
x (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"idx", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertExpr
e2]]) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
Index (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"piecewise", InertArgs ArgOp
ExpSeq [InertExpr]
es]) = [InertExpr] -> AST' Text
go [InertExpr]
es where
  go :: [InertExpr] -> AST' Text
go []           = String -> AST' Text
forall a. HasCallStack => String -> a
error String
"Invalid 0-ary piecewise?"
  go [InertExpr
_]          = String -> AST' Text
forall a. HasCallStack => String -> a
error String
"Invalid 1-ary piecewise?"
  go [InertExpr
e1,InertExpr
e2]      = AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a -> AST' a
If (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2) (Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Integer -> Literal'
Nat Integer
0))
  go [InertExpr
e1,InertExpr
e2,InertExpr
e3]   = AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a -> AST' a
If (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2) (InertExpr -> AST' Text
maple2AST InertExpr
e3)
  -- BUG! piecewise(a<b,2,a=b,1) doesn't mean piecewise(a<b,2,1) in Maple
  go [InertExpr
e1,InertExpr
e2,InertExpr
_,InertExpr
e3] = AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a -> AST' a
If (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2) (InertExpr -> AST' Text
maple2AST InertExpr
e3)
  go (InertExpr
e1:InertExpr
e2:[InertExpr]
rest) = AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a -> AST' a
If (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2) ([InertExpr] -> AST' Text
go [InertExpr]
rest)

maple2AST (InertArgs ArgOp
Func [InertName Text
"PARTITION"
        ,InertArgs ArgOp
ExpSeq [InertArgs ArgOp
List [InertArgs ArgOp
ExpSeq [InertExpr]
es]]]) = 
  AST' Text
-> (AST' Text -> AST' Text) -> Maybe (AST' Text) -> AST' Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> AST' Text
forall a. a -> AST' a
Var Text
"reject") AST' Text -> AST' Text
forall a. a -> a
id (Maybe (AST' Text) -> AST' Text) -> Maybe (AST' Text) -> AST' Text
forall a b. (a -> b) -> a -> b
$ 
  (InertExpr -> Maybe (AST' Text) -> Maybe (AST' Text))
-> Maybe (AST' Text) -> [InertExpr] -> Maybe (AST' Text)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InertExpr -> Maybe (AST' Text) -> Maybe (AST' Text)
piece2AST Maybe (AST' Text)
forall a. Maybe a
Nothing [InertExpr]
es 
    where piece2AST :: InertExpr -> Maybe (AST' Text) -> Maybe (AST' Text)
piece2AST (InertArgs ArgOp
Func [InertName Text
"Piece", InertArgs ArgOp
ExpSeq [InertExpr]
cs]) Maybe (AST' Text)
e  
            | [AST' Text
c,AST' Text
v] <- (InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
cs = AST' Text -> Maybe (AST' Text)
forall a. a -> Maybe a
Just (AST' Text -> Maybe (AST' Text)) -> AST' Text -> Maybe (AST' Text)
forall a b. (a -> b) -> a -> b
$ AST' Text
-> (AST' Text -> AST' Text) -> Maybe (AST' Text) -> AST' Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AST' Text
v (AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a -> AST' a
If AST' Text
c AST' Text
v) Maybe (AST' Text)
e
          piece2AST InertExpr
x Maybe (AST' Text)
_ = String -> Maybe (AST' Text)
forall a. HasCallStack => String -> a
error (String -> Maybe (AST' Text)) -> String -> Maybe (AST' Text)
forall a b. (a -> b) -> a -> b
$ String
"Invalid PARTITION contents: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ InertExpr -> String
forall a. Show a => a -> String
show InertExpr
x

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"max", InertArgs ArgOp
ExpSeq [InertExpr]
es]) =
    NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
Max ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"min", InertArgs ArgOp
ExpSeq [InertExpr]
es]) =
    NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
Min ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Ei", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertExpr
e2]]) =
    Text -> AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a -> AST' a
Integrate Text
"t" (InertExpr -> AST' Text
maple2AST InertExpr
e2) AST' Text
forall a. AST' a
Infinity'
    (NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
Prod [ AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"exp")   (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"negate") (Text -> AST' Text
forall a. a -> AST' a
Var Text
"t"))
                 , AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"recip")
                       (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"^") (Text -> AST' Text
forall a. a -> AST' a
Var Text
"t")) (InertExpr -> AST' Text
maple2AST InertExpr
e1))
                 ])

maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"case"
        , InertArgs ArgOp
ExpSeq
            [InertExpr
e1, InertArgs ArgOp
Func
                [ InertName Text
"Branches"
                , InertArgs ArgOp
ExpSeq [InertExpr]
bs]]]) =
    AST' Text -> [Branch' Text] -> AST' Text
forall a. AST' a -> [Branch' a] -> AST' a
Case (InertExpr -> AST' Text
maple2AST InertExpr
e1) ((InertExpr -> Branch' Text) -> [InertExpr] -> [Branch' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> Branch' Text
branch [InertExpr]
bs)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Plate", InertArgs ArgOp
ExpSeq [InertExpr
e1, InertName Text
x, InertExpr
e2]]) =
    Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a
Plate Text
x (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"Or", InertArgs ArgOp
ExpSeq [InertExpr]
es]) =
    NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
Or ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

maple2AST (InertArgs ArgOp
Func
        [InertName Text
"And", InertArgs ArgOp
ExpSeq [InertExpr]
es]) =
    NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
And ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"int"
        , InertArgs ArgOp
ExpSeq
           [ InertExpr
f
           , InertArgs ArgOp
Equal
             [ InertName Text
x
             , InertArgs ArgOp
Range [InertExpr
lo, InertExpr
hi]]]]) =
    Text -> AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a -> AST' a
Integrate Text
x (InertExpr -> AST' Text
maple2AST InertExpr
lo) (InertExpr -> AST' Text
maple2AST InertExpr
hi) (InertExpr -> AST' Text
maple2AST InertExpr
f)

maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"Int"
        , InertArgs ArgOp
ExpSeq
           [ InertExpr
f
           , InertArgs ArgOp
Equal
             [ InertName Text
x
             , InertArgs ArgOp
Range [InertExpr
lo, InertExpr
hi]]]]) =
    Text -> AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a -> AST' a
Integrate Text
x (InertExpr -> AST' Text
maple2AST InertExpr
lo) (InertExpr -> AST' Text
maple2AST InertExpr
hi) (InertExpr -> AST' Text
maple2AST InertExpr
f)

maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"SumIE"
        , InertArgs ArgOp
ExpSeq
           [ InertExpr
f
           , InertArgs ArgOp
Equal
             [ InertName Text
x
             , InertArgs ArgOp
Range [InertExpr
lo, InertExpr
hi]]]]) =
    Text -> AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a -> AST' a
Summate Text
x (InertExpr -> AST' Text
maple2AST InertExpr
lo) (InertExpr -> AST' Text
maple2AST InertExpr
hi) (InertExpr -> AST' Text
maple2AST InertExpr
f)

maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"ProductIE"
        , InertArgs ArgOp
ExpSeq
           [ InertExpr
f
           , InertArgs ArgOp
Equal
             [ InertName Text
x
             , InertArgs ArgOp
Range [InertExpr
lo, InertExpr
hi]]]]) =
    Text -> AST' Text -> AST' Text -> AST' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> AST' a -> AST' a
Product Text
x (InertExpr -> AST' Text
maple2AST InertExpr
lo) (InertExpr -> AST' Text
maple2AST InertExpr
hi) (InertExpr -> AST' Text
maple2AST InertExpr
f)

maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"BucketIE"
        , InertArgs ArgOp
ExpSeq
           [ InertExpr
f
           , InertArgs ArgOp
Equal
             [ InertName Text
x
             , InertArgs ArgOp
Range [InertExpr
lo, InertExpr
hi]]]]) =
    Text -> AST' Text -> AST' Text -> Reducer' Text -> AST' Text
forall a. a -> AST' a -> AST' a -> Reducer' a -> AST' a
Bucket Text
x (InertExpr -> AST' Text
maple2AST InertExpr
lo) (InertExpr -> AST' Text
maple2AST InertExpr
hi) (InertExpr -> Reducer' Text
maple2ReducerAST InertExpr
f)

-- TODO: This logic should be in SymbolResolve
maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"fst"
        , InertArgs ArgOp
ExpSeq [ InertExpr
e1 ]]) =
    AST' Text -> [Branch' Text] -> AST' Text
forall a. AST' a -> [Branch' a] -> AST' a
Case (InertExpr -> AST' Text
maple2AST InertExpr
e1)
         [ Pattern' Text -> AST' Text -> Branch' Text
forall a. Pattern' Text -> AST' a -> Branch' a
Branch' (PDatum Text -> Pattern' Text
forall a. PDatum a -> Pattern' a
PData' (Text -> [Pattern' Text] -> PDatum Text
forall a. Text -> [Pattern' a] -> PDatum a
DV Text
"pair" [Text -> Pattern' Text
forall a. a -> Pattern' a
PVar' Text
"y",Text -> Pattern' Text
forall a. a -> Pattern' a
PVar' Text
"z"])) (Text -> AST' Text
forall a. a -> AST' a
Var Text
"y")]

-- TODO: This logic should be in SymbolResolve
maple2AST (InertArgs ArgOp
Func
        [ InertName Text
"snd"
        , InertArgs ArgOp
ExpSeq [ InertExpr
e1 ]]) =
    AST' Text -> [Branch' Text] -> AST' Text
forall a. AST' a -> [Branch' a] -> AST' a
Case (InertExpr -> AST' Text
maple2AST InertExpr
e1)
         [ Pattern' Text -> AST' Text -> Branch' Text
forall a. Pattern' Text -> AST' a -> Branch' a
Branch' (PDatum Text -> Pattern' Text
forall a. PDatum a -> Pattern' a
PData' (Text -> [Pattern' Text] -> PDatum Text
forall a. Text -> [Pattern' a] -> PDatum a
DV Text
"pair" [Text -> Pattern' Text
forall a. a -> Pattern' a
PVar' Text
"y",Text -> Pattern' Text
forall a. a -> Pattern' a
PVar' Text
"z"])) (Text -> AST' Text
forall a. a -> AST' a
Var Text
"z")]

maple2AST (InertArgs ArgOp
Func
        [InertExpr
f, InertArgs ArgOp
ExpSeq [InertExpr]
es]) =
    (AST' Text -> AST' Text -> AST' Text)
-> AST' Text -> [AST' Text] -> AST' Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (InertExpr -> AST' Text
maple2AST InertExpr
f) ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

maple2AST (InertArgs ArgOp
List [InertArgs ArgOp
ExpSeq [InertExpr]
es]) = [AST' Text] -> AST' Text
forall a. [AST' a] -> AST' a
ArrayLiteral ([AST' Text] -> AST' Text) -> [AST' Text] -> AST' Text
forall a b. (a -> b) -> a -> b
$ (InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es

maple2AST (InertArgs ArgOp
And_  [InertExpr]
es) = NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
And  (NaryOp -> [AST' Text] -> [AST' Text]
collapseNaryOp NaryOp
And  ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es))
maple2AST (InertArgs ArgOp
Sum_  [InertExpr]
es) = NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
Sum  (NaryOp -> [AST' Text] -> [AST' Text]
collapseNaryOp NaryOp
Sum  ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es))
maple2AST (InertArgs ArgOp
Prod_ [InertExpr]
es) = NaryOp -> [AST' Text] -> AST' Text
forall a. NaryOp -> [AST' a] -> AST' a
NaryOp NaryOp
Prod (NaryOp -> [AST' Text] -> [AST' Text]
collapseNaryOp NaryOp
Prod ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es))

maple2AST (InertArgs ArgOp
Not_ [InertExpr
e])  =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"not") (InertExpr -> AST' Text
maple2AST InertExpr
e)

maple2AST (InertArgs ArgOp
Less [InertExpr]
es)  =
    (AST' Text -> AST' Text -> AST' Text)
-> AST' Text -> [AST' Text] -> AST' Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"less")  ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

-- Special case to undo the "piecewise(x=true,...)" created by our Maple code
-- (in the Hakaru:-make_piece function), to avoid the error produced by Maple
-- "piecewise(x,...)".  (This "=true" is also removed by NewSLO:-applyintegrand
-- if Maple ever substitutes something for x, but that may never happen.)
maple2AST (InertArgs ArgOp
Equal [InertExpr
e, InertName Text
"true"]) = InertExpr -> AST' Text
maple2AST InertExpr
e
maple2AST (InertArgs ArgOp
Equal [InertName Text
"true", InertExpr
e]) = InertExpr -> AST' Text
maple2AST InertExpr
e

maple2AST (InertArgs ArgOp
Equal [InertExpr]
es) =
    (AST' Text -> AST' Text -> AST' Text)
-> AST' Text -> [AST' Text] -> AST' Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"equal") ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es)

maple2AST (InertArgs ArgOp
NotEq [InertExpr]
es) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"not") ((AST' Text -> AST' Text -> AST' Text)
-> AST' Text -> [AST' Text] -> AST' Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"equal") ((InertExpr -> AST' Text) -> [InertExpr] -> [AST' Text]
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> AST' Text
maple2AST [InertExpr]
es))

maple2AST (InertArgs ArgOp
Power [InertExpr
x, InertNum NumOp
Pos Integer
y]) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"^")  (InertExpr -> AST' Text
maple2AST InertExpr
x)) (InertExpr -> AST' Text
maple2AST (NumOp -> Integer -> InertExpr
InertNum NumOp
Pos Integer
y))
maple2AST (InertArgs ArgOp
Power [InertExpr
x, InertNum NumOp
Neg (-1)]) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"recip")  (InertExpr -> AST' Text
maple2AST InertExpr
x)
maple2AST (InertArgs ArgOp
Power [InertExpr
x, 
                            InertArgs ArgOp
Rational
                            [InertNum NumOp
Pos Integer
1, InertNum NumOp
Pos Integer
y]]) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"natroot") (InertExpr -> AST' Text
maple2AST InertExpr
x)) (Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text)
-> (Integer -> Literal') -> Integer -> AST' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal'
Nat (Integer -> AST' Text) -> Integer -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer
y)

maple2AST (InertArgs ArgOp
Power [InertExpr
x, 
                            InertArgs ArgOp
Rational
                            [InertNum NumOp
Neg (-1), InertNum NumOp
Pos Integer
y]]) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"recip")
        (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"natroot") (InertExpr -> AST' Text
maple2AST InertExpr
x)) (Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text)
-> (Integer -> Literal') -> Integer -> AST' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal'
Nat (Integer -> AST' Text) -> Integer -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer
y))

maple2AST (InertArgs ArgOp
Power [InertExpr
x, InertExpr
y]) =
    AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
App (Text -> AST' Text
forall a. a -> AST' a
Var Text
"**") (InertExpr -> AST' Text
maple2AST InertExpr
x)) (InertExpr -> AST' Text
maple2AST InertExpr
y)
maple2AST (InertArgs ArgOp
Rational [InertNum NumOp
Pos Integer
x, InertNum NumOp
Pos Integer
y]) =
    Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text)
-> (Rational -> Literal') -> Rational -> AST' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal'
Prob (Rational -> AST' Text) -> Rational -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
y
maple2AST (InertArgs ArgOp
Rational [InertNum NumOp
_ Integer
x, InertNum NumOp
_ Integer
y]) =
    Literal' -> AST' Text
forall a. Literal' -> AST' a
ULiteral (Literal' -> AST' Text)
-> (Rational -> Literal') -> Rational -> AST' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal'
Real (Rational -> AST' Text) -> Rational -> AST' Text
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
y

maple2AST InertExpr
x = String -> AST' Text
forall a. HasCallStack => String -> a
error (String -> AST' Text) -> String -> AST' Text
forall a b. (a -> b) -> a -> b
$ String
"Can't handle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ InertExpr -> String
forall a. Show a => a -> String
show InertExpr
x

----------------------------------------------------------------

maple2ReducerAST :: InertExpr -> Reducer' Text
maple2ReducerAST :: InertExpr -> Reducer' Text
maple2ReducerAST
 (InertArgs ArgOp
Func
  [ InertName Text
"Fanout"
  , InertArgs ArgOp
ExpSeq [ InertExpr
e1, InertExpr
e2 ]]) =
  Reducer' Text -> Reducer' Text -> Reducer' Text
forall a. Reducer' a -> Reducer' a -> Reducer' a
R_Fanout (InertExpr -> Reducer' Text
maple2ReducerAST InertExpr
e1) (InertExpr -> Reducer' Text
maple2ReducerAST InertExpr
e2)

maple2ReducerAST
 (InertArgs ArgOp
Func
  [ InertName Text
"Index"
  , InertArgs ArgOp
ExpSeq [ InertExpr
e1, InertName Text
x, InertExpr
e2, InertExpr
e3]]) =
  Text -> AST' Text -> AST' Text -> Reducer' Text -> Reducer' Text
forall a. a -> AST' a -> AST' a -> Reducer' a -> Reducer' a
R_Index Text
x (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> AST' Text
maple2AST InertExpr
e2) (InertExpr -> Reducer' Text
maple2ReducerAST InertExpr
e3)

maple2ReducerAST
 (InertArgs ArgOp
Func
  [ InertName Text
"Split"
  , InertArgs ArgOp
ExpSeq [ InertExpr
e1, InertExpr
e2, InertExpr
e3]]) =
  AST' Text -> Reducer' Text -> Reducer' Text -> Reducer' Text
forall a. AST' a -> Reducer' a -> Reducer' a -> Reducer' a
R_Split (InertExpr -> AST' Text
maple2AST InertExpr
e1) (InertExpr -> Reducer' Text
maple2ReducerAST InertExpr
e2) (InertExpr -> Reducer' Text
maple2ReducerAST InertExpr
e3)

maple2ReducerAST
 (InertArgs ArgOp
Func
  [ InertName Text
"Nop"
  , InertArgs ArgOp
ExpSeq []]) = Reducer' Text
forall a. Reducer' a
R_Nop

maple2ReducerAST
 (InertArgs ArgOp
Func
  [ InertName Text
"Add"
  , InertArgs ArgOp
ExpSeq [InertExpr
e1]]) = AST' Text -> Reducer' Text
forall a. AST' a -> Reducer' a
R_Add (InertExpr -> AST' Text
maple2AST InertExpr
e1)

maple2ReducerAST InertExpr
_ = String -> Reducer' Text
forall a. HasCallStack => String -> a
error String
"TODO: maple2ReducerAST, so many cases..."

mapleDatum2AST :: Text -> InertExpr -> AST' Text
mapleDatum2AST :: Text -> InertExpr -> AST' Text
mapleDatum2AST Text
h InertExpr
d = case (Text
h, InertExpr -> [AST' Text]
maple2DCode InertExpr
d) of
  (Text
"pair", [AST' Text
x,AST' Text
y]) -> AST' Text -> AST' Text -> AST' Text
forall a. AST' a -> AST' a -> AST' a
Pair AST' Text
x AST' Text
y
  (Text
"unit", []   ) -> AST' Text
forall a. AST' a
Unit
  (Text, [AST' Text])
_               -> String -> AST' Text
forall a. HasCallStack => String -> a
error (String -> AST' Text) -> String -> AST' Text
forall a b. (a -> b) -> a -> b
$ String
"TODO: mapleDatum2AST " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
h
    
maple2Type :: InertExpr -> TypeAST'
maple2Type :: InertExpr -> TypeAST'
maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HInt",
             InertArgs ArgOp
ExpSeq
             [InertArgs ArgOp
Func
              [InertName Text
"Bound",
               InertArgs ArgOp
ExpSeq
               [InertName Text
">=",InertNum NumOp
Pos Integer
0]]]])
    = Text -> TypeAST'
TypeVar Text
"nat"
maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HInt",
             InertArgs ArgOp
ExpSeq []])
    = Text -> TypeAST'
TypeVar Text
"int"
maple2Type (InertArgs ArgOp
Func
            [InertName Text
nm,
             InertArgs ArgOp
ExpSeq
             [InertArgs ArgOp
Func
              [InertName Text
"Bound",
               InertArgs ArgOp
ExpSeq
               [InertName Text
">=",InertNum NumOp
Pos Integer
0]]]])
    | Text
nm Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"HReal", Text
"AlmostEveryReal" ]
    = Text -> TypeAST'
TypeVar Text
"prob"
maple2Type (InertArgs ArgOp
Func
            [InertName Text
nm,
             InertArgs ArgOp
ExpSeq []])
    | Text
nm Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"HReal", Text
"AlmostEveryReal" ]
    = Text -> TypeAST'
TypeVar Text
"real"

maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HData",
             InertArgs ArgOp
ExpSeq
             [InertArgs ArgOp
Func
              [InertName Text
"DatumStruct",
               InertArgs ArgOp
ExpSeq
               [InertName Text
"unit",
                InertArgs ArgOp
List
                [InertArgs ArgOp
ExpSeq []]]]]])
     = Text -> TypeAST'
TypeVar Text
"unit"

maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HData",
             InertArgs ArgOp
ExpSeq
             [InertArgs ArgOp
Func
              [InertName Text
"DatumStruct",
               InertArgs ArgOp
ExpSeq
               [InertName Text
"true",
                InertArgs ArgOp
List
                [InertArgs ArgOp
ExpSeq []]]],
              InertArgs ArgOp
Func
              [InertName Text
"DatumStruct",
               InertArgs ArgOp
ExpSeq
               [InertName Text
"false",
                InertArgs ArgOp
List
                [InertArgs ArgOp
ExpSeq []]]]]])
     = Text -> TypeAST'
TypeVar Text
"bool"

maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HData",
             InertArgs ArgOp
ExpSeq
             [InertArgs ArgOp
Func
              [InertName Text
"DatumStruct",
               InertArgs ArgOp
ExpSeq
               [InertName Text
"pair",
                InertArgs ArgOp
List
                [InertArgs ArgOp
ExpSeq
                 [InertArgs ArgOp
Func
                  [InertName Text
"Konst",
                   InertArgs ArgOp
ExpSeq [InertExpr
x]],
                  InertArgs ArgOp
Func
                  [InertName Text
"Konst",
                   InertArgs ArgOp
ExpSeq [InertExpr
y]]]]]]]])
     = Text -> [TypeAST'] -> TypeAST'
TypeApp Text
"pair" ((InertExpr -> TypeAST') -> [InertExpr] -> [TypeAST']
forall a b. (a -> b) -> [a] -> [b]
map InertExpr -> TypeAST'
maple2Type [InertExpr
x, InertExpr
y])

maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HArray",
             InertArgs ArgOp
ExpSeq
             [InertExpr
x]])
     = Text -> [TypeAST'] -> TypeAST'
TypeApp Text
"array" [InertExpr -> TypeAST'
maple2Type InertExpr
x]

maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HFunction",
             InertArgs ArgOp
ExpSeq
             [InertExpr
x, InertExpr
y]])
     = TypeAST' -> TypeAST' -> TypeAST'
TypeFun (InertExpr -> TypeAST'
maple2Type InertExpr
x) (InertExpr -> TypeAST'
maple2Type InertExpr
y)

maple2Type (InertArgs ArgOp
Func
            [InertName Text
"HMeasure",
             InertArgs ArgOp
ExpSeq
             [InertExpr
x]])
     = Text -> [TypeAST'] -> TypeAST'
TypeApp Text
"measure" [InertExpr -> TypeAST'
maple2Type InertExpr
x]

maple2Type InertExpr
x = String -> TypeAST'
forall a. HasCallStack => String -> a
error (String
"TODO: maple2Type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ InertExpr -> String
forall a. Show a => a -> String
show InertExpr
x)


branch :: InertExpr -> Branch' Text
branch :: InertExpr -> Branch' Text
branch (InertArgs ArgOp
Func
        [InertName Text
"Branch",
         InertArgs ArgOp
ExpSeq [InertExpr
pat, InertExpr
e]]) =
    Pattern' Text -> AST' Text -> Branch' Text
forall a. Pattern' Text -> AST' a -> Branch' a
Branch' (InertExpr -> Pattern' Text
maple2Pattern InertExpr
pat) (InertExpr -> AST' Text
maple2AST InertExpr
e)
branch InertExpr
_ = String -> Branch' Text
forall a. HasCallStack => String -> a
error String
"Branch: got some ill-formed case statement back?"


maple2Pattern :: InertExpr -> Pattern' Text
maple2Pattern :: InertExpr -> Pattern' Text
maple2Pattern (InertName Text
"PWild") = Pattern' Text
forall a. Pattern' a
PWild'
maple2Pattern (InertArgs ArgOp
Func
               [InertName Text
"PVar",
                InertArgs ArgOp
ExpSeq
                [InertName Text
x]]) = Text -> Pattern' Text
forall a. a -> Pattern' a
PVar' Text
x
maple2Pattern (InertArgs ArgOp
Func
               [InertName Text
"PDatum",
                InertArgs ArgOp
ExpSeq
                [InertName Text
hint, InertExpr
args]]) =
    PDatum Text -> Pattern' Text
forall a. PDatum a -> Pattern' a
PData' (Text -> [Pattern' Text] -> PDatum Text
forall a. Text -> [Pattern' a] -> PDatum a
DV Text
hint (InertExpr -> [Pattern' Text]
maple2Patterns InertExpr
args))
maple2Pattern InertExpr
e = String -> Pattern' Text
forall a. HasCallStack => String -> a
error (String -> Pattern' Text) -> String -> Pattern' Text
forall a b. (a -> b) -> a -> b
$ String
"TODO: maple2AST{pattern} " String -> ShowS
forall a. [a] -> [a] -> [a]
++ InertExpr -> String
forall a. Show a => a -> String
show InertExpr
e

maple2DCode :: InertExpr -> [AST' Text]
maple2DCode :: InertExpr -> [AST' Text]
maple2DCode (InertArgs ArgOp
Func [InertName Text
"Inl", InertArgs ArgOp
ExpSeq [InertExpr
e]]) = InertExpr -> [AST' Text]
maple2DCode InertExpr
e
maple2DCode (InertArgs ArgOp
Func [InertName Text
"Inr", InertArgs ArgOp
ExpSeq [InertExpr
e]]) = InertExpr -> [AST' Text]
maple2DCode InertExpr
e
maple2DCode (InertArgs ArgOp
Func [InertName Text
"Et" , InertArgs ArgOp
ExpSeq [InertArgs ArgOp
Func [InertName Text
"Konst", InertArgs ArgOp
ExpSeq [InertExpr
x]], InertExpr
e]]) = InertExpr -> AST' Text
maple2AST InertExpr
x AST' Text -> [AST' Text] -> [AST' Text]
forall a. a -> [a] -> [a]
: InertExpr -> [AST' Text]
maple2DCode InertExpr
e
maple2DCode (InertName Text
"Done") = []
maple2DCode InertExpr
e = String -> [AST' Text]
forall a. HasCallStack => String -> a
error (String -> [AST' Text]) -> String -> [AST' Text]
forall a b. (a -> b) -> a -> b
$ String
"maple2DCode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ InertExpr -> String
forall a. Show a => a -> String
show InertExpr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not InertExpr of a datum"

maple2Patterns :: InertExpr -> [Pattern' Text]
maple2Patterns :: InertExpr -> [Pattern' Text]
maple2Patterns (InertArgs ArgOp
Func [InertName Text
"PInl", InertArgs ArgOp
ExpSeq [InertExpr
e]]) = InertExpr -> [Pattern' Text]
maple2Patterns InertExpr
e
maple2Patterns (InertArgs ArgOp
Func [InertName Text
"PInr", InertArgs ArgOp
ExpSeq [InertExpr
e]]) = InertExpr -> [Pattern' Text]
maple2Patterns InertExpr
e
maple2Patterns (InertArgs ArgOp
Func [InertName Text
"PEt" , InertArgs ArgOp
ExpSeq [InertArgs ArgOp
Func [InertName Text
"PKonst", InertArgs ArgOp
ExpSeq [InertExpr
x]], InertExpr
e]]) = InertExpr -> Pattern' Text
maple2Pattern InertExpr
x Pattern' Text -> [Pattern' Text] -> [Pattern' Text]
forall a. a -> [a] -> [a]
: InertExpr -> [Pattern' Text]
maple2Patterns InertExpr
e
maple2Patterns (InertName Text
"PDone") = []
maple2Patterns InertExpr
e = String -> [Pattern' Text]
forall a. HasCallStack => String -> a
error (String -> [Pattern' Text]) -> String -> [Pattern' Text]
forall a b. (a -> b) -> a -> b
$ String
"maple2Patterns: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ InertExpr -> String
forall a. Show a => a -> String
show InertExpr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not InertExpr of a pattern"