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

Implemented binary equality operator

Browse source
This commit is contained in:
VegOwOtenks 2024-10-18 10:00:39 +02:00
parent cab7424415
commit c38aa04143
1 changed files with 13 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
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 data BinaryOperator = LogicalAnd | LogicalOr | LogicalEquality
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,6 +61,9 @@ 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))
], ],
@ -89,8 +92,9 @@ 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 (Variable name) = maybe False id (Map.lookup name vs) evaluate vs (Binary LogicalEquality l r) = evaluate vs l == evaluate vs r
evaluate vs (Variable name) = maybe False id (Map.lookup name vs)