VegOwOtenks/wwffwfwf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implemented Equivalency and Implication operators

Browse source
This commit is contained in:
VegOwOtenks 2024-10-18 18:02:51 +02:00
parent c4860e60b7
commit 091d131e69
1 changed files with 24 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
src/Lib.hs
View file

@ -34,7 +34,7 @@ import Data.Functor.Identity
data Expression = Constant Bool | Binary BinaryOperator Expression Expression | Unary UnaryOperator Expression | Variable String
deriving Show
data BinaryOperator = LogicalAnd | LogicalOr | LogicalEquality
data BinaryOperator = LogicalAnd | LogicalOr | LogicalEquality | LogicalImplication
deriving Show
data UnaryOperator = LogicalNot
deriving Show
@ -44,9 +44,9 @@ def = emptyDef{ commentStart = ""
, commentEnd = ""
, identStart = letter <|> char '_'
, identLetter = alphaNum <|> char '_'
, opStart = oneOf "&|~="
, opLetter = oneOf "&|~="
, reservedOpNames = ["&", "|", "~", "="]
, opStart = oneOf "&|~=-"
, opLetter = oneOf "&|~=-><"
, reservedOpNames = ["&", "|", "~", "=", "->", "<-->"]
, reservedNames = ["true", "false"]
}
@ -61,9 +61,6 @@ exprparser = buildExpressionParser table term <?> "expression"
table :: [[Operator String u Identity Expression]]
table = [
[
Infix (m_reservedOp "=" >> return (Binary LogicalEquality)) AssocLeft
],
[
Prefix (m_reservedOp "~" >> return (Unary LogicalNot))
],
@ -72,6 +69,15 @@ table = [
],
[
Infix (m_reservedOp "|" >> return (Binary LogicalOr)) AssocLeft
],
[
Infix (m_reservedOp "->" >> return (Binary LogicalImplication)) AssocLeft
],
[
Infix (m_reservedOp "<-->" >> return (Binary LogicalEquality)) AssocLeft
],
[
Infix (m_reservedOp "=" >> return (Binary LogicalEquality)) AssocLeft
]
]
@ -92,9 +98,14 @@ collectVariableNames (Unary _ right) = collectVariableNames right
collectVariableNames (Variable name) = Set.singleton name
evaluate :: Map String Bool -> Expression -> Bool
evaluate _ (Constant b) = b
evaluate vs (Unary LogicalNot e) = not (evaluate vs e)
evaluate vs (Binary LogicalAnd l r) = evaluate vs l && evaluate vs r
evaluate vs (Binary LogicalOr l r) = evaluate vs l || evaluate vs r
evaluate vs (Binary LogicalEquality l r) = evaluate vs l == evaluate vs r
evaluate vs (Variable name) = maybe False id (Map.lookup name vs)
evaluate _ (Constant b) = b
evaluate vs (Unary LogicalNot e) = not (evaluate vs e)
evaluate vs (Binary LogicalAnd l r) = evaluate vs l && evaluate vs r
evaluate vs (Binary LogicalOr l r) = evaluate vs l || evaluate vs r
evaluate vs (Binary LogicalEquality l r) = evaluate vs l == evaluate vs r
evaluate vs (Binary LogicalImplication l r) = implication (evaluate vs l) (evaluate vs r)
where
implication :: Bool -> Bool -> Bool
implication False True = False
implication _ _ = True
evaluate vs (Variable name) = maybe False id (Map.lookup name vs)