49 lines
1.2 KiB
Haskell
49 lines
1.2 KiB
Haskell
module Logic.Statement.Parse where
|
|
|
|
import Logic.Parse
|
|
( Parser(..)
|
|
, Input(..)
|
|
, ParseError
|
|
, expected
|
|
, parseToken
|
|
, parseIf
|
|
)
|
|
import Logic.Statement (Statement(..))
|
|
|
|
import Control.Applicative (Alternative((<|>), some))
|
|
import Data.Char (isAlphaNum)
|
|
|
|
stmtAtom :: Parser Statement
|
|
stmtAtom = Atom <$> parse
|
|
where
|
|
parse = some $ parseIf "statement variable" $ \char -> isAlphaNum char || char == '_'
|
|
|
|
stmtNot :: Parser Statement
|
|
stmtNot = Not <$> (parseToken "!" *> stmt)
|
|
|
|
stmtBinary :: Parser Statement
|
|
stmtBinary = parseToken "(" *> body <* parseToken ")"
|
|
where
|
|
body = (\s1 f s2 -> f s1 s2) <$> stmt <*> parseConnective <*> stmt
|
|
|
|
parseConnective =
|
|
fmap (const And) (parseToken "&")
|
|
<|> fmap (const Or) (parseToken "|")
|
|
<|> fmap (const Implies) (parseToken "->")
|
|
<|> fmap (const Iff) (parseToken "<->")
|
|
<|> fail
|
|
|
|
fail = Parser $ \input -> Left $ expected "connective" input
|
|
|
|
stmt :: Parser Statement
|
|
stmt = Parser $ \input ->
|
|
let
|
|
parser =
|
|
case inputSeq input of
|
|
[] -> fail
|
|
('!':_) -> stmtNot
|
|
('(':_) -> stmtBinary
|
|
_ -> stmtAtom <|> fail
|
|
in runParser parser input
|
|
where
|
|
fail = Parser $ \input -> Left $ expected "statement" input
|