79 lines
1.9 KiB
Haskell
79 lines
1.9 KiB
Haskell
|
module Parser (parseFormula) where
|
||
|
|
|
||
|
|
import Lexer
|
||
|
|
import FOLSyntax
|
||
|
|
import Text.Parsec
|
||
|
|
import Text.Parsec.String (Parser)
|
||
|
|
import Data.Functor
|
||
|
|
|
||
|
|
import Prelude hiding (pred, all)
|
||
|
|
|
||
|
|
|
||
|
|
term :: Parser Term
|
||
|
|
term = try fun <|> var
|
||
|
|
|
||
|
|
fun :: Parser Term
|
||
|
|
fun =
|
||
|
|
Fun
|
||
|
|
<$> identifier
|
||
|
|
<*> parens (term `sepBy` comma)
|
||
|
|
|
||
|
|
var :: Parser Term
|
||
|
|
var = Var <$> identifier
|
||
|
|
|
||
|
|
|
||
|
|
formula :: Parser Formula
|
||
|
|
formula = neg <|> impl <|> all <|> exists <|> pred <|> true <|> false <?> "formula"
|
||
|
|
|
||
|
|
pred :: Parser Formula
|
||
|
|
pred =
|
||
|
|
Pred
|
||
|
|
<$> identifier
|
||
|
|
<*> parens (term `sepBy` comma)
|
||
|
|
|
||
|
|
neg :: Parser Formula
|
||
|
|
neg =
|
||
|
|
Neg
|
||
|
|
<$> (reservedOp "!" *> negFormula)
|
||
|
|
where negFormula = neg <|> all <|> exists <|> true <|> false <|> parens formula <|> pred <?> "formula under neg"
|
||
|
|
|
||
|
|
impl :: Parser Formula
|
||
|
|
impl = foldr1 Impl <$> implFormula `sepBy` reservedOp "->"
|
||
|
|
where implFormula = neg <|> disj <|> conj <|> all <|> exists <|> true <|> false <|> parens formula <|> pred <?> "formula under impl"
|
||
|
|
|
||
|
|
disj :: Parser Formula
|
||
|
|
disj = foldr1 Disj <$> disjFormula `sepBy` reservedOp "\\/"
|
||
|
|
where disjFormula = neg <|> conj <|> all <|> exists <|> true <|> false <|> parens formula <|> pred <?> "formula under disj"
|
||
|
|
|
||
|
|
conj :: Parser Formula
|
||
|
|
conj = foldr1 Conj <$> conjFormula `sepBy` reservedOp "/\\"
|
||
|
|
where conjFormula = neg <|> all <|> exists <|> true <|> false <|> parens formula <|> pred <?> "formula under conj"
|
||
|
|
|
||
|
|
all :: Parser Formula
|
||
|
|
all =
|
||
|
|
All
|
||
|
|
<$> (reserved "forall" *> identifier)
|
||
|
|
<*> (dot *> formula)
|
||
|
|
|
||
|
|
exists :: Parser Formula
|
||
|
|
exists =
|
||
|
|
Exists
|
||
|
|
<$> (reserved "exists" *> identifier)
|
||
|
|
<*> (dot *> formula)
|
||
|
|
|
||
|
|
true :: Parser Formula
|
||
|
|
true = reserved "true" $> T
|
||
|
|
|
||
|
|
false :: Parser Formula
|
||
|
|
false = reserved "false" $> F
|
||
|
|
|
||
|
|
-- runners
|
||
|
|
contents :: Parser a -> Parser a
|
||
|
|
contents p = do
|
||
|
|
whiteSpace
|
||
|
|
r <- p
|
||
|
|
eof
|
||
|
|
return r
|
||
|
|
|
||
|
|
parseFormula :: String -> Either ParseError Formula
|
||
|
|
parseFormula = parse (contents formula) "stdin"
|