pl/bc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

added logical operators

Browse Source
This commit is contained in:
Veit Heller
2017-05-11 18:50:16 +02:00
parent 5603728a9b
commit 0a07021ef0
3 changed files with 95 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
src/BC/Eval.hs
View File

@@ -3,8 +3,7 @@ module BC.Eval (eval) where
import BC.Types
eval :: [Value] -> Value
eval [x@(BInt _)] = x
eval [x@(BFloat _)] = x
eval [x@(BNum _)] = x
eval [x@(BBool _)] = x
eval [x@(BErr _)] = x
eval [(BOp x)] = BErr ("operation " ++ x ++ " requires arguments")
@@ -14,10 +13,9 @@ eval l = treeEval l [] []
treeEval :: [Value] -> [Value] -> [Value] -> Value
treeEval [] [] (num:_) = num
treeEval [] ops nums = handleOp [] ops nums
treeEval (x@(BInt _):xy) ops nums = treeEval xy ops (x:nums)
treeEval (x@(BFloat _):xy) ops nums = treeEval xy ops (x:nums)
treeEval (x@(BNum _):xy) ops nums = treeEval xy ops (x:nums)
treeEval ((BBool x):xy) ops nums =
treeEval xy ops ((BInt $ if x then 1 else 0):nums)
treeEval xy ops ((BNum $ BInt $ if x then 1 else 0):nums)
treeEval expr@(x@(BOp _):xy) ops@(op:_) nums =
if precedence x > precedence op
then treeEval xy (x:ops) nums
@@ -25,29 +23,33 @@ treeEval expr@(x@(BOp _):xy) ops@(op:_) nums =
treeEval (x@(BOp _):xy) [] nums = treeEval xy [x] nums
handleOp :: [Value] -> [Value] -> [Value] -> Value
handleOp expr (op:ops) (op2:(op1:nums)) =
treeEval expr ops ((evalOp op op1 op2):nums)
handleOp expr (op:ops) ((BNum op2):((BNum op1):nums)) =
treeEval expr ops (((findOp op) op1 op2):nums)
handleOp expr ((BOp op):ops) _ = BErr ("Not enough arguments to operation " ++ op)
evalOp :: Value -> Value -> Value -> Value
evalOp (BOp "*") (BInt x) (BInt y) = BInt $ x * y
evalOp (BOp "/") (BInt x) (BInt y) = BInt $ quot x y
evalOp (BOp "+") (BInt x) (BInt y) = BInt $ x + y
evalOp (BOp "-") (BInt x) (BInt y) = BInt $ x - y
evalOp (BOp "^") (BInt x) (BInt y) = BInt $ x ^ y
evalOp (BOp "*") (BFloat x) (BInt y) = BFloat $ x * fromIntegral y
evalOp (BOp "/") (BFloat x) (BInt y) = BFloat $ x / fromIntegral y
evalOp (BOp "+") (BFloat x) (BInt y) = BFloat $ x + fromIntegral y
evalOp (BOp "-") (BFloat x) (BInt y) = BFloat $ x - fromIntegral y
evalOp (BOp "^") (BFloat x) (BInt y) = BFloat $ x ** fromIntegral y
evalOp (BOp "*") (BInt x) (BFloat y) = BFloat $ fromIntegral x * y
evalOp (BOp "/") (BInt x) (BFloat y) = BFloat $ fromIntegral x / y
evalOp (BOp "+") (BInt x) (BFloat y) = BFloat $ fromIntegral x + y
evalOp (BOp "-") (BInt x) (BFloat y) = BFloat $ fromIntegral x - y
evalOp (BOp "^") (BInt x) (BFloat y) = BFloat $ fromIntegral x ** y
evalOp (BOp "*") (BFloat x) (BFloat y) = BFloat $ x * y
evalOp (BOp "/") (BFloat x) (BFloat y) = BFloat $ x / y
evalOp (BOp "+") (BFloat x) (BFloat y) = BFloat $ x + y
evalOp (BOp "-") (BFloat x) (BFloat y) = BFloat $ x - y
evalOp (BOp "^") (BFloat x) (BFloat y) = BFloat $ x ** y
evalOp _ _ _ = BInt 0
findOp x = case binOp x of
Just op -> \a -> \b -> (BNum $ op a b)
Nothing ->
case logicalOp x of
Just lop -> \a -> \b -> (BBool $ lop a b)
Nothing -> \a -> \b -> (BNum $ BInt 0)
logicalOp :: Value -> Maybe (Number -> Number -> Bool)
logicalOp (BOp ">") = Just (>)
logicalOp (BOp "<") = Just (<)
logicalOp (BOp ">=") = Just (>=)
logicalOp (BOp "<=") = Just (<=)
logicalOp (BOp "==") = Just (==)
logicalOp (BOp "!=") = Just (/=)
logicalOp _ = Nothing
binOp :: Value -> Maybe (Number -> Number -> Number)
binOp (BOp "*") = Just (*)
binOp (BOp "/") = Just (/)
binOp (BOp "+") = Just (+)
binOp (BOp "-") = Just (-)
binOp (BOp "^") = Just (**)
binOp _ = Nothing