75 lines
1.6 KiB
Haskell
75 lines
1.6 KiB
Haskell
module BExpr where
|
|
|
|
import Control.Applicative -- for `Alternative' typeclass
|
|
|
|
import qualified AExpr as AE
|
|
import qualified Parser as P
|
|
|
|
data E
|
|
= Cnst Bool
|
|
| Eql AE.E AE.E
|
|
| NEq AE.E AE.E
|
|
| LEq AE.E AE.E
|
|
| Gt AE.E AE.E
|
|
| Not E
|
|
| And E E
|
|
deriving Show
|
|
|
|
parser :: P.Parser E
|
|
parser = andOp -- lesser precedence comes first
|
|
<|> aOp
|
|
<|> notOp
|
|
<|> bconst
|
|
where
|
|
bconst = do {
|
|
P.spaces
|
|
; bval <- P.choice $ map P.string ["true", "false"]
|
|
; return $ (Cnst . strToBool) bval
|
|
}
|
|
notOp = do {
|
|
P.spaces
|
|
; e <- P.string "~" *> P.spaces *> parser
|
|
; return $ Not e
|
|
}
|
|
aOp = do {
|
|
P.spaces
|
|
; x <- AE.parser
|
|
; P.spaces
|
|
; opcode <- P.choice $ map P.string ["==", "!=", "<=", ">"]
|
|
; P.spaces
|
|
; y <- AE.parser
|
|
; return $ case opcode of
|
|
"==" -> Eql x y
|
|
"!=" -> NEq x y
|
|
"<=" -> LEq x y
|
|
">" -> Gt x y
|
|
}
|
|
andOp = do {
|
|
P.spaces
|
|
; x <- parser
|
|
; P.spaces
|
|
; P.string "&&"
|
|
; P.spaces
|
|
; y <- parser
|
|
; return $ And x y
|
|
}
|
|
-- notOpP = P.string "~" *> P.spaces *> parser
|
|
strToBool s = if s == "true" then True else False
|
|
|
|
eval :: E -> Bool
|
|
eval e = case e of
|
|
Cnst b -> b
|
|
Eql e1 e2 -> (AE.eval e1) == (AE.eval e2)
|
|
NEq e1 e2 -> not $ (AE.eval e1) == (AE.eval e2)
|
|
LEq e1 e2 -> (AE.eval e1) <= (AE.eval e2)
|
|
Gt e1 e2 -> (AE.eval e1) > (AE.eval e2)
|
|
Not e -> not $ eval e
|
|
And e1 e2 -> (eval e1) && (eval e2)
|
|
|
|
-- λ> P.parse parser "3 <= 2"
|
|
-- Ok (LEq (Const 3) (Const 2)) ""
|
|
-- λ> P.parse parser "3 <= 2"
|
|
-- Ok (LEq (Const 3) (Const 2)) ""
|
|
-- λ> P.parse parser "3 <= 2 && 2 > 4 && ~false"
|
|
-- Ok (LEq (Const 3) (Const 2)) " && 2 > 4 && ~false"
|