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