95 lines
No EOL
2.4 KiB
Haskell
95 lines
No EOL
2.4 KiB
Haskell
module Parser (parseFormula, parseFormulaE) where
|
|
|
|
import Lexer
|
|
( comma,
|
|
dot,
|
|
identifier,
|
|
parens,
|
|
reserved,
|
|
reservedOp,
|
|
whiteSpace )
|
|
import FOLSyntax ( Formula(..), Term(..) )
|
|
import Text.Parsec ( sepBy, eof, (<?>), (<|>), parse, try )
|
|
import Text.Parsec.String (Parser)
|
|
import Data.Functor ( ($>) )
|
|
|
|
import Prelude hiding (pred, all)
|
|
import Data.Either.Extra (mapLeft)
|
|
|
|
|
|
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
|
|
|
|
|
|
fromRight :: Either a b -> b
|
|
fromRight (Left _) = error "fromRight called on left value!"
|
|
fromRight (Right b) = b
|
|
|
|
parseFormulaE :: String -> Either String Formula
|
|
parseFormulaE str = mapLeft show (parse (contents formula) "stdin" str)
|
|
|
|
parseFormula :: String -> Formula
|
|
parseFormula = fromRight . parse (contents formula) "stdin" |