From 3ef6ec4bd3314efcac2504bd3a25e380d5e9514f Mon Sep 17 00:00:00 2001 From: Akshay Date: Fri, 9 Oct 2020 12:28:15 +0530 Subject: add experimental floating point handling --- src/Operators.hs | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) (limited to 'src/Operators.hs') diff --git a/src/Operators.hs b/src/Operators.hs index 3b96281..9eaec38 100644 --- a/src/Operators.hs +++ b/src/Operators.hs @@ -12,17 +12,36 @@ primitives = ("+", arithmetic (+)) , ("-", arithmetic (-)) , ("*", arithmetic (*)) - , ("/", arithmetic div) + , ("/", arithmetic (/)) ] -arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> LispResult Expr +data LispNumber = I Integer + | F Double + +instance Num LispNumber where + (I a) + (I b) = I $ a + b + (F a) + (F b) = F $ a + b + (I a) - (I b) = I $ a - b + (F a) - (F b) = F $ a - b + (I a) * (I b) = I $ a * b + (F a) * (F b) = F $ a * b + +instance Fractional LispNumber where + (I a) / (I b) = I $ a `div` b + (F a) / (F b) = F $ a / b + +arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr arithmetic op args | length args < 2 = throwError $ ArgCount 2 args | otherwise = do as <- mapM unwrapNum args - return . IntLiteral $ foldl1 op as + return . wrapNum $ foldl1 op as -unwrapNum :: Expr -> LispResult Integer -unwrapNum (IntLiteral n) = return n -unwrapNum x = throwError $ TypeMismatch "number" x +unwrapNum :: Expr -> LispResult LispNumber +unwrapNum (IntLiteral n) = return $ I n +unwrapNum (FloatLiteral n) = return $ F n +unwrapNum x = throwError $ TypeMismatch "number" x +wrapNum :: LispNumber -> Expr +wrapNum (I n) = IntLiteral n +wrapNum (F n) = FloatLiteral n -- cgit v1.2.3