From 0a07021ef0fe40ae4ec53c9a60558ab3d27ad2fa Mon Sep 17 00:00:00 2001 From: hellerve Date: Thu, 11 May 2017 18:50:16 +0200 Subject: [PATCH] added logical operators --- src/BC/Eval.hs | 60 ++++++++++++++++++++++-------------------- src/BC/Parse.hs | 8 +++--- src/BC/Types.hs | 70 ++++++++++++++++++++++++++++++++++++++++++------- 3 files changed, 95 insertions(+), 43 deletions(-) diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs index 0b309a9..7a7e9d0 100644 --- a/src/BC/Eval.hs +++ b/src/BC/Eval.hs @@ -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 diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs index 22376d5..2a90356 100644 --- a/src/BC/Parse.hs +++ b/src/BC/Parse.hs @@ -21,8 +21,8 @@ float = do _ <- P.string "." y <- P.many1 P.digit case neg of - Just "-" -> (return . BFloat . read) ("-" ++ x ++ "." ++ y) - _ -> (return . BFloat . read) (x ++ "." ++ y) + Just "-" -> (return . BNum . BFloat . read) ("-" ++ x ++ "." ++ y) + _ -> (return . BNum . BFloat . read) (x ++ "." ++ y) integer :: P.Parser Value @@ -30,8 +30,8 @@ integer = do neg <- P.optionMaybe (P.string "-") x <- P.many1 P.digit case neg of - Just "-" -> (return . BInt . read) ("-" ++ x) - _ -> (return . BInt . read) x + Just "-" -> (return . BNum . BInt . read) ("-" ++ x) + _ -> (return . BNum . BInt . read) x bool :: P.Parser Value diff --git a/src/BC/Types.hs b/src/BC/Types.hs index e6a37b5..6fbc219 100644 --- a/src/BC/Types.hs +++ b/src/BC/Types.hs @@ -1,26 +1,76 @@ module BC.Types where -data Value = BInt Integer - | BFloat Double +data Value = BNum Number | BBool Bool | BOp String | BErr String instance Show Value where - show (BInt i) = show i - show (BFloat f) = show f show (BBool b) = if b then "true" else "false" show (BOp o) = o + show (BNum n) = show n show (BErr e) = "error: " ++ e + +-- sorry, this is a little hacky +data Number = BInt Integer + | BFloat Double + deriving (Ord, Eq) +instance Show Number where + show (BInt i) = show i + show (BFloat f) = show f + +instance Fractional Number where + (BInt x) / (BInt y) = BInt $ quot x y + (BFloat x) / (BFloat y) = BFloat $ x / y + (BInt x) / (BFloat y) = BFloat $ fromIntegral x / y + (BFloat x) / (BInt y) = BFloat $ x / fromIntegral y + +instance Floating Number where + (BFloat x) ** (BFloat y) = BFloat $ x ** y + (BFloat x) ** (BInt y) = BFloat $ x ** fromIntegral y + (BInt x) ** (BFloat y) = BFloat $ fromIntegral x ** y + (BInt x) ** (BInt y) = BInt $ x ^ y + logBase x y = log y / log x + sqrt x = x ** (BFloat 0.5) + tan x = sin x / cos x + tanh x = sinh x / cosh x + +instance Num Number where + (BInt x) + (BInt y) = BInt $ x * y + (BFloat x) + (BFloat y) = BFloat $ x * y + (BInt x) + (BFloat y) = BFloat $ fromIntegral x * y + (BFloat x) + (BInt y) = BFloat $ x * fromIntegral y + (BInt x) * (BInt y) = BInt $ x * y + (BFloat x) * (BFloat y) = BFloat $ x * y + (BInt x) * (BFloat y) = BFloat $ fromIntegral x * y + (BFloat x) * (BInt y) = BFloat $ x * fromIntegral y + abs (BInt x) = BInt $ abs x + abs (BFloat x) = BFloat $ abs x + signum (BInt x) = BInt $ signum x + signum (BFloat x) = BFloat $ signum x + fromInteger x = BInt x + negate (BInt x) = BInt $ negate x + negate (BFloat x) = BFloat $ negate x + + isErr :: Value -> Bool isErr (BErr _) = True isErr _ = False + precedence :: Value -> Int -precedence (BOp "^") = 3 -precedence (BOp "*") = 2 -precedence (BOp "/") = 2 -precedence (BOp "-") = 1 -precedence (BOp "+") = 1 -precedence (BOp "%") = 2 +precedence (BOp "^") = 5 +precedence (BOp "*") = 4 +precedence (BOp "/") = 4 +precedence (BOp "-") = 3 +precedence (BOp "+") = 3 +precedence (BOp "%") = 4 +precedence (BOp "||") = 1 +precedence (BOp "&&") = 1 +precedence (BOp "<") = 2 +precedence (BOp ">") = 2 +precedence (BOp "<=") = 2 +precedence (BOp ">=") = 2 +precedence (BOp "==") = 2 +precedence (BOp "!=") = 2 precedence _ = 0