{-# LANGUAGE PatternGuards #-}
module Lambdabot.Plugin.Haskell.Pl.Parser (parsePF) where
import Lambdabot.Plugin.Haskell.Pl.Common
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as T
import Control.Applicative ((<*))
import Data.List
tp :: T.TokenParser st
tp :: forall st. TokenParser st
tp = GenLanguageDef [Char] st Identity
-> GenTokenParser [Char] st Identity
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
T.makeTokenParser (GenLanguageDef [Char] st Identity
-> GenTokenParser [Char] st Identity)
-> GenLanguageDef [Char] st Identity
-> GenTokenParser [Char] st Identity
forall a b. (a -> b) -> a -> b
$ GenLanguageDef [Char] st Identity
forall st. LanguageDef st
haskellStyle {
reservedNames :: [[Char]]
reservedNames = [[Char]
"if",[Char]
"then",[Char]
"else",[Char]
"let",[Char]
"in"]
}
parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = GenTokenParser [Char] () Identity -> forall a. Parser a -> Parser a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.parens GenTokenParser [Char] () Identity
forall st. TokenParser st
tp
brackets :: Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets = GenTokenParser [Char] () Identity -> forall a. Parser a -> Parser a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.brackets GenTokenParser [Char] () Identity
forall st. TokenParser st
tp
symbol :: String -> Parser String
symbol :: [Char] -> Parser [Char]
symbol = GenTokenParser [Char] () Identity -> [Char] -> Parser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> [Char] -> ParsecT s u m [Char]
T.symbol GenTokenParser [Char] () Identity
forall st. TokenParser st
tp
modName :: CharParser st String
modName :: forall st. CharParser st [Char]
modName = do
Char
c <- [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char
'A'..Char
'Z']
[Char]
cs <- ParsecT [Char] st Identity Char -> CharParser st [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] 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 [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_'")
[Char] -> CharParser st [Char]
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs)
qualified :: CharParser st String -> CharParser st String
qualified :: forall st. CharParser st [Char] -> CharParser st [Char]
qualified CharParser st [Char]
p = do
[[Char]]
qs <- CharParser st [Char] -> ParsecT [Char] st Identity [[Char]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CharParser st [Char] -> ParsecT [Char] st Identity [[Char]])
-> CharParser st [Char] -> ParsecT [Char] st Identity [[Char]]
forall a b. (a -> b) -> a -> b
$ CharParser st [Char] -> CharParser st [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st [Char] -> CharParser st [Char])
-> CharParser st [Char] -> CharParser st [Char]
forall a b. (a -> b) -> a -> b
$ CharParser st [Char]
forall st. CharParser st [Char]
modName CharParser st [Char]
-> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' CharParser st [Char]
-> ParsecT [Char] st Identity Char -> CharParser st [Char]
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] 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 [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
opchars)
[Char]
nm <- CharParser st [Char]
p
[Char] -> CharParser st [Char]
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> CharParser st [Char]) -> [Char] -> CharParser st [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." ([[Char]]
qs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
nm])
atomic :: Parser String
atomic :: Parser [Char]
atomic = Parser [Char] -> Parser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> Parser [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"()") Parser [Char] -> Parser [Char] -> Parser [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Char] -> Parser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> [Char])
-> ParsecT [Char] () Identity Integer -> Parser [Char]
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` GenTokenParser [Char] () Identity
-> ParsecT [Char] () Identity Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
T.natural GenTokenParser [Char] () Identity
forall st. TokenParser st
tp) Parser [Char] -> Parser [Char] -> Parser [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Char] -> Parser [Char]
forall st. CharParser st [Char] -> CharParser st [Char]
qualified (GenTokenParser [Char] () Identity -> Parser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
T.identifier GenTokenParser [Char] () Identity
forall st. TokenParser st
tp)
reserved :: String -> Parser ()
reserved :: [Char] -> Parser ()
reserved = GenTokenParser [Char] () Identity -> [Char] -> Parser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> [Char] -> ParsecT s u m ()
T.reserved GenTokenParser [Char] () Identity
forall st. TokenParser st
tp
charLiteral :: Parser Char
charLiteral :: Parser Char
charLiteral = GenTokenParser [Char] () Identity -> Parser Char
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Char
T.charLiteral GenTokenParser [Char] () Identity
forall st. TokenParser st
tp
stringLiteral :: Parser String
stringLiteral :: Parser [Char]
stringLiteral = GenTokenParser [Char] () Identity -> Parser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
T.stringLiteral GenTokenParser [Char] () Identity
forall st. TokenParser st
tp
table :: [[Operator Char st Expr]]
table :: forall st. [[Operator Char st Expr]]
table = Operator Char st Expr
-> [[Operator Char st Expr]] -> [[Operator Char st Expr]]
forall {a}. a -> [[a]] -> [[a]]
addToFirst Operator Char st Expr
forall st. Operator Char st Expr
def ([[Operator Char st Expr]] -> [[Operator Char st Expr]])
-> [[Operator Char st Expr]] -> [[Operator Char st Expr]]
forall a b. (a -> b) -> a -> b
$ ([([Char], (Assoc, Int))] -> [Operator Char st Expr])
-> [[([Char], (Assoc, Int))]] -> [[Operator Char st Expr]]
forall a b. (a -> b) -> [a] -> [b]
map ((([Char], (Assoc, Int)) -> Operator Char st Expr)
-> [([Char], (Assoc, Int))] -> [Operator Char st Expr]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], (Assoc, Int)) -> Operator Char st Expr
forall st. ([Char], (Assoc, Int)) -> Operator Char st Expr
inf) [[([Char], (Assoc, Int))]]
operators where
addToFirst :: a -> [[a]] -> [[a]]
addToFirst a
y ([a]
x:[[a]]
xs) = ((a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
x)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
xs)
addToFirst a
_ [[a]]
_ = Bool -> [[a]] -> [[a]]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False [[a]]
forall a. a
bt
def :: Operator Char st Expr
def :: forall st. Operator Char st Expr
def = GenParser Char st (Expr -> Expr -> Expr)
-> Assoc -> Operator Char st Expr
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix (GenParser Char st (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr))
-> GenParser Char st (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ do
[Char]
name <- CharParser st [Char]
forall st. CharParser st [Char]
parseOp
Bool -> ParsecT [Char] st Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Char] st Identity ())
-> Bool -> ParsecT [Char] st Identity ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Assoc, Int) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Assoc, Int) -> Bool) -> Maybe (Assoc, Int) -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe (Assoc, Int)
lookupOp [Char]
name
ParsecT [Char] st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
(Expr -> Expr -> Expr) -> GenParser Char st (Expr -> Expr -> Expr)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr))
-> (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Expr -> Expr -> Expr
App (Fixity -> [Char] -> Expr
Var Fixity
Inf [Char]
name) Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2
) Assoc
AssocLeft
inf :: (String, (Assoc, Int)) -> Operator Char st Expr
inf :: forall st. ([Char], (Assoc, Int)) -> Operator Char st Expr
inf ([Char]
name, (Assoc
assoc, Int
_)) = GenParser Char st (Expr -> Expr -> Expr)
-> Assoc -> Operator Char st Expr
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix (GenParser Char st (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr))
-> GenParser Char st (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ do
[Char]
_ <- [Char] -> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
name
ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ())
-> ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
opchars
ParsecT [Char] st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
let name' :: [Char]
name' = if [Char] -> Char
forall a. (?callStack::CallStack) => [a] -> a
head [Char]
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
then [Char] -> [Char]
forall a. (?callStack::CallStack) => [a] -> [a]
tail ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. (?callStack::CallStack) => [a] -> [a]
tail ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
name
else [Char]
name
(Expr -> Expr -> Expr) -> GenParser Char st (Expr -> Expr -> Expr)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr))
-> (Expr -> Expr -> Expr)
-> GenParser Char st (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Expr -> Expr -> Expr
App (Fixity -> [Char] -> Expr
Var Fixity
Inf [Char]
name') Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2
) Assoc
assoc
parseOp :: CharParser st String
parseOp :: forall st. CharParser st [Char]
parseOp = (ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') (ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char])
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall st. CharParser st [Char] -> CharParser st [Char]
qualified (GenTokenParser [Char] st Identity
-> ParsecT [Char] st Identity [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
T.identifier GenTokenParser [Char] st Identity
forall st. TokenParser st
tp))
ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
[Char]
op <- ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall st. CharParser st [Char] -> CharParser st [Char]
qualified (ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char])
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Char])
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
opchars
Bool -> ParsecT [Char] st Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Char] st Identity ())
-> Bool -> ParsecT [Char] st Identity ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
op [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
reservedOps
[Char] -> ParsecT [Char] st Identity [Char]
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
op)
pattern :: Parser Pattern
pattern :: Parser Pattern
pattern = OperatorTable Char () Pattern -> Parser Pattern -> Parser Pattern
forall tok st a.
OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
buildExpressionParser OperatorTable Char () Pattern
ptable (([Char] -> Pattern
PVar ([Char] -> Pattern) -> Parser [Char] -> Parser Pattern
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
( Parser [Char]
atomic
Parser [Char] -> Parser [Char] -> Parser [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> Parser [Char]
symbol [Char]
"_" Parser [Char] -> Parser [Char] -> Parser [Char]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Parser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"")))
Parser Pattern -> Parser Pattern -> Parser Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Pattern -> Parser Pattern
forall a. Parser a -> Parser a
parens Parser Pattern
pattern)
Parser Pattern -> [Char] -> Parser Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"pattern" where
ptable :: OperatorTable Char () Pattern
ptable = [[GenParser Char () (Pattern -> Pattern -> Pattern)
-> Assoc -> Operator Char () Pattern
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> Parser [Char]
symbol [Char]
":" Parser [Char]
-> GenParser Char () (Pattern -> Pattern -> Pattern)
-> GenParser Char () (Pattern -> Pattern -> Pattern)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Pattern -> Pattern -> Pattern)
-> GenParser Char () (Pattern -> Pattern -> Pattern)
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern -> Pattern -> Pattern
PCons) Assoc
AssocRight],
[GenParser Char () (Pattern -> Pattern -> Pattern)
-> Assoc -> Operator Char () Pattern
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> Parser [Char]
symbol [Char]
"," Parser [Char]
-> GenParser Char () (Pattern -> Pattern -> Pattern)
-> GenParser Char () (Pattern -> Pattern -> Pattern)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Pattern -> Pattern -> Pattern)
-> GenParser Char () (Pattern -> Pattern -> Pattern)
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern -> Pattern -> Pattern
PTuple) Assoc
AssocNone]]
lambda :: Parser Expr
lambda :: Parser Expr
lambda = do
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"\\"
[Pattern]
vs <- Parser Pattern -> ParsecT [Char] () Identity [Pattern]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Pattern
pattern
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"->"
Expr
e <- Bool -> Parser Expr
myParser Bool
False
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ (Pattern -> Expr -> Expr) -> Expr -> [Pattern] -> Expr
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pattern -> Expr -> Expr
Lambda Expr
e [Pattern]
vs
Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"lambda abstraction"
var :: Parser Expr
var :: Parser Expr
var = Parser Expr -> Parser Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> Expr
makeVar ([Char] -> Expr) -> Parser [Char] -> Parser Expr
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Char]
atomic Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
parens (Parser Expr -> Parser Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser Expr
unaryNegation Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr -> Parser Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser Expr
rightSection
Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr -> Parser Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> Expr
makeVar ([Char] -> Expr) -> Parser [Char] -> Parser Expr
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser Char -> Parser [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))
Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr
tuple) Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr
list Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Fixity -> [Char] -> Expr
Var Fixity
Pref ([Char] -> Expr) -> (Char -> [Char]) -> Char -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
forall a. Show a => a -> [Char]
show) (Char -> Expr) -> Parser Char -> Parser Expr
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser Char
charLiteral
Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> Expr
stringVar ([Char] -> Expr) -> Parser [Char] -> Parser Expr
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Char]
stringLiteral)
Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"variable" where
makeVar :: [Char] -> Expr
makeVar [Char]
v | Just (Assoc, Int)
_ <- [Char] -> Maybe (Assoc, Int)
lookupOp [Char]
v = Fixity -> [Char] -> Expr
Var Fixity
Inf [Char]
v
| Bool
otherwise = Fixity -> [Char] -> Expr
Var Fixity
Pref [Char]
v
stringVar :: String -> Expr
stringVar :: [Char] -> Expr
stringVar [Char]
str = [Expr] -> Expr
makeList ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ (Fixity -> [Char] -> Expr
Var Fixity
Pref ([Char] -> Expr) -> (Char -> [Char]) -> Char -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
forall a. Show a => a -> [Char]
show) (Char -> Expr) -> [Char] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
`map` [Char]
str
list :: Parser Expr
list :: Parser Expr
list = [Parser Expr] -> Parser Expr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((Parser Expr -> Parser Expr) -> [Parser Expr] -> [Parser Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Parser Expr -> Parser Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser Expr -> Parser Expr)
-> (Parser Expr -> Parser Expr) -> Parser Expr -> Parser Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
brackets) [Parser Expr]
plist) Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"list" where
plist :: [Parser Expr]
plist = [
(Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Expr
e1 Expr
e2 -> Expr
cons Expr -> Expr -> Expr
`App` Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2) Expr
nil ([Expr] -> Expr)
-> ParsecT [Char] () Identity [Expr] -> Parser Expr
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
(Bool -> Parser Expr
myParser Bool
False Parser Expr -> Parser [Char] -> ParsecT [Char] () Identity [Expr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` [Char] -> Parser [Char]
symbol [Char]
","),
do Expr
e <- Bool -> Parser Expr
myParser Bool
False
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
".."
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Fixity -> [Char] -> Expr
Var Fixity
Pref [Char]
"enumFrom" Expr -> Expr -> Expr
`App` Expr
e,
do Expr
e <- Bool -> Parser Expr
myParser Bool
False
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
","
Expr
e' <- Bool -> Parser Expr
myParser Bool
False
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
".."
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Fixity -> [Char] -> Expr
Var Fixity
Pref [Char]
"enumFromThen" Expr -> Expr -> Expr
`App` Expr
e Expr -> Expr -> Expr
`App` Expr
e',
do Expr
e <- Bool -> Parser Expr
myParser Bool
False
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
".."
Expr
e' <- Bool -> Parser Expr
myParser Bool
False
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Fixity -> [Char] -> Expr
Var Fixity
Pref [Char]
"enumFromTo" Expr -> Expr -> Expr
`App` Expr
e Expr -> Expr -> Expr
`App` Expr
e',
do Expr
e <- Bool -> Parser Expr
myParser Bool
False
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
","
Expr
e' <- Bool -> Parser Expr
myParser Bool
False
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
".."
Expr
e'' <- Bool -> Parser Expr
myParser Bool
False
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Fixity -> [Char] -> Expr
Var Fixity
Pref [Char]
"enumFromThenTo" Expr -> Expr -> Expr
`App` Expr
e Expr -> Expr -> Expr
`App` Expr
e' Expr -> Expr -> Expr
`App` Expr
e''
]
tuple :: Parser Expr
tuple :: Parser Expr
tuple = do
[Expr]
elts <- Bool -> Parser Expr
myParser Bool
False Parser Expr -> Parser [Char] -> ParsecT [Char] () Identity [Expr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` [Char] -> Parser [Char]
symbol [Char]
","
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Expr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
elts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
let name :: Expr
name = Fixity -> [Char] -> Expr
Var Fixity
Pref ([Char] -> Expr) -> [Char] -> Expr
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Expr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
elts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
','
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expr -> Expr -> Expr
App Expr
name [Expr]
elts
Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"tuple"
unaryNegation :: Parser Expr
unaryNegation :: Parser Expr
unaryNegation = do
[Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"-"
Expr
e <- Bool -> Parser Expr
myParser Bool
False
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Fixity -> [Char] -> Expr
Var Fixity
Pref [Char]
"negate" Expr -> Expr -> Expr
`App` Expr
e
Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"unary negation"
rightSection :: Parser Expr
rightSection :: Parser Expr
rightSection = do
Expr
v <- Fixity -> [Char] -> Expr
Var Fixity
Inf ([Char] -> Expr) -> Parser [Char] -> Parser Expr
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Char]
forall st. CharParser st [Char]
parseOp
Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
let rs :: Expr -> Expr
rs Expr
e = Expr
flip' Expr -> Expr -> Expr
`App` Expr
v Expr -> Expr -> Expr
`App` Expr
e
Expr -> Parser Expr -> Parser Expr
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Expr
v (Expr -> Expr
rs (Expr -> Expr) -> Parser Expr -> Parser Expr
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Bool -> Parser Expr
myParser Bool
False)
Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"right section"
myParser :: Bool -> Parser Expr
myParser :: Bool -> Parser Expr
myParser Bool
b = Parser Expr
lambda Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> Parser Expr
expr Bool
b
expr :: Bool -> Parser Expr
expr :: Bool -> Parser Expr
expr Bool
b = OperatorTable Char () Expr -> Parser Expr -> Parser Expr
forall tok st a.
OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
buildExpressionParser OperatorTable Char () Expr
forall st. [[Operator Char st Expr]]
table (Bool -> Parser Expr
term Bool
b) Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"expression"
decl :: Parser Decl
decl :: Parser Decl
decl = do
[Char]
f <- Parser [Char]
atomic
[Pattern]
args <- Parser Pattern
pattern Parser Pattern
-> Parser [Char] -> ParsecT [Char] () Identity [Pattern]
forall a b. Parser a -> Parser b -> Parser [a]
`endsIn` [Char] -> Parser [Char]
symbol [Char]
"="
Expr
e <- Bool -> Parser Expr
myParser Bool
False
Decl -> Parser Decl
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl -> Parser Decl) -> Decl -> Parser Decl
forall a b. (a -> b) -> a -> b
$ [Char] -> Expr -> Decl
Define [Char]
f ((Pattern -> Expr -> Expr) -> Expr -> [Pattern] -> Expr
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pattern -> Expr -> Expr
Lambda Expr
e [Pattern]
args)
letbind :: Parser Expr
letbind :: Parser Expr
letbind = do
[Char] -> Parser ()
reserved [Char]
"let"
[Decl]
ds <- Parser Decl
decl Parser Decl -> Parser [Char] -> ParsecT [Char] () Identity [Decl]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` [Char] -> Parser [Char]
symbol [Char]
";"
[Char] -> Parser ()
reserved [Char]
"in"
Expr
e <- Bool -> Parser Expr
myParser Bool
False
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ [Decl] -> Expr -> Expr
Let [Decl]
ds Expr
e
ifexpr :: Parser Expr
ifexpr :: Parser Expr
ifexpr = do
[Char] -> Parser ()
reserved [Char]
"if"
Expr
p <- Bool -> Parser Expr
myParser Bool
False
[Char] -> Parser ()
reserved [Char]
"then"
Expr
e1 <- Bool -> Parser Expr
myParser Bool
False
[Char] -> Parser ()
reserved [Char]
"else"
Expr
e2 <- Bool -> Parser Expr
myParser Bool
False
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Expr
if' Expr -> Expr -> Expr
`App` Expr
p Expr -> Expr -> Expr
`App` Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2
term :: Bool -> Parser Expr
term :: Bool -> Parser Expr
term Bool
b = Parser Expr
application Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr
lambda Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr
letbind Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr
ifexpr Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
b Parser () -> Parser Expr -> Parser Expr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Parser Char -> Parser ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ([Char] -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
")") Parser () -> Parser Expr -> Parser Expr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fixity -> [Char] -> Expr
Var Fixity
Pref [Char]
"")))
Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"simple term"
application :: Parser Expr
application :: Parser Expr
application = do
Expr
e:[Expr]
es <- Parser Expr -> ParsecT [Char] () Identity [Expr]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser Expr -> ParsecT [Char] () Identity [Expr])
-> Parser Expr -> ParsecT [Char] () Identity [Expr]
forall a b. (a -> b) -> a -> b
$ Parser Expr
var Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
parens (Bool -> Parser Expr
myParser Bool
True)
Expr -> Parser Expr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expr -> Expr -> Expr
App Expr
e [Expr]
es
Parser Expr -> [Char] -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"application"
endsIn :: Parser a -> Parser b -> Parser [a]
endsIn :: forall a b. Parser a -> Parser b -> Parser [a]
endsIn Parser a
p Parser b
end = do
[a]
xs <- Parser a -> Parser [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser a
p
b
_ <- Parser b
end
[a] -> Parser [a]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Parser [a]) -> [a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs
input :: Parser TopLevel
input :: Parser TopLevel
input = do
Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
TopLevel
tl <- Parser TopLevel -> Parser TopLevel
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
[Char]
f <- Parser [Char]
atomic
[Pattern]
args <- Parser Pattern
pattern Parser Pattern
-> Parser [Char] -> ParsecT [Char] () Identity [Pattern]
forall a b. Parser a -> Parser b -> Parser [a]
`endsIn` [Char] -> Parser [Char]
symbol [Char]
"="
Expr
e <- Bool -> Parser Expr
myParser Bool
False
TopLevel -> Parser TopLevel
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopLevel -> Parser TopLevel) -> TopLevel -> Parser TopLevel
forall a b. (a -> b) -> a -> b
$ Bool -> Decl -> TopLevel
TLD Bool
True (Decl -> TopLevel) -> Decl -> TopLevel
forall a b. (a -> b) -> a -> b
$ [Char] -> Expr -> Decl
Define [Char]
f ((Pattern -> Expr -> Expr) -> Expr -> [Pattern] -> Expr
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pattern -> Expr -> Expr
Lambda Expr
e [Pattern]
args)
) Parser TopLevel -> Parser TopLevel -> Parser TopLevel
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Expr -> TopLevel
TLE (Expr -> TopLevel) -> Parser Expr -> Parser TopLevel
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Bool -> Parser Expr
myParser Bool
False
Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
TopLevel -> Parser TopLevel
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TopLevel
tl
parsePF :: String -> Either String TopLevel
parsePF :: [Char] -> Either [Char] TopLevel
parsePF [Char]
inp = case Parser TopLevel
-> () -> [Char] -> [Char] -> Either ParseError TopLevel
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser Parser TopLevel
input () [Char]
"" [Char]
inp of
Left ParseError
err -> [Char] -> Either [Char] TopLevel
forall a b. a -> Either a b
Left ([Char] -> Either [Char] TopLevel)
-> [Char] -> Either [Char] TopLevel
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
Right TopLevel
e -> TopLevel -> Either [Char] TopLevel
forall a b. b -> Either a b
Right (TopLevel -> Either [Char] TopLevel)
-> TopLevel -> Either [Char] TopLevel
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr) -> TopLevel -> TopLevel
mapTopLevel Expr -> Expr
postprocess TopLevel
e
postprocess :: Expr -> Expr
postprocess :: Expr -> Expr
postprocess (Var Fixity
f [Char]
v) = (Fixity -> [Char] -> Expr
Var Fixity
f [Char]
v)
postprocess (App Expr
e1 (Var Fixity
Pref [Char]
"")) = Expr -> Expr
postprocess Expr
e1
postprocess (App Expr
e1 Expr
e2) = Expr -> Expr -> Expr
App (Expr -> Expr
postprocess Expr
e1) (Expr -> Expr
postprocess Expr
e2)
postprocess (Lambda Pattern
v Expr
e) = Pattern -> Expr -> Expr
Lambda Pattern
v (Expr -> Expr
postprocess Expr
e)
postprocess (Let [Decl]
ds Expr
e) = [Decl] -> Expr -> Expr
Let ((Expr -> Expr) -> Decl -> Decl
mapDecl Expr -> Expr
postprocess (Decl -> Decl) -> [Decl] -> [Decl]
forall a b. (a -> b) -> [a] -> [b]
`map` [Decl]
ds) (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
postprocess Expr
e where
mapDecl :: (Expr -> Expr) -> Decl -> Decl
mapDecl :: (Expr -> Expr) -> Decl -> Decl
mapDecl Expr -> Expr
f (Define [Char]
foo Expr
e') = [Char] -> Expr -> Decl
Define [Char]
foo (Expr -> Decl) -> Expr -> Decl
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
f Expr
e'