From 3ef6ec4bd3314efcac2504bd3a25e380d5e9514f Mon Sep 17 00:00:00 2001
From: Akshay <nerdy@peppe.rs>
Date: Fri, 9 Oct 2020 12:28:15 +0530
Subject: add experimental floating point handling

---
 bin/Main.hs      |  2 +-
 src/Evaluator.hs |  1 +
 src/Operators.hs | 31 +++++++++++++++++++++++++------
 src/Parser.hs    | 12 ++++++------
 4 files changed, 33 insertions(+), 13 deletions(-)

diff --git a/bin/Main.hs b/bin/Main.hs
index 591fc1e..6207e02 100644
--- a/bin/Main.hs
+++ b/bin/Main.hs
@@ -34,6 +34,6 @@ main = do
     args <- getArgs
     if null args
        then do
-           print ";;; Entering lisk repl ..."
+           putStrLn ";;; Entering lisk repl ..."
            repl
        else print $ eval =<< readExpr (head args)
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index 28ee79b..c8d8d34 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -19,6 +19,7 @@ eval :: Expr -> LispResult Expr
 eval v@(StringLiteral s)     = return v
 eval v@(IntLiteral i)        = return v
 eval v@(BoolLiteral b)       = return v
+eval v@(FloatLiteral f)      = return v
 -- handle quotes as literals
 eval (List[Id "quote", val]) = return val
 eval (List (Id fn : args))   = mapM eval args >>= apply fn
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
diff --git a/src/Parser.hs b/src/Parser.hs
index dcbfdb1..9813f5c 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -3,7 +3,7 @@ module Parser ( parseLispValue
               , parseString
               , parseInt
               , parseFloat
-              , parseAtom
+              , parseId
               , parseList
               , parseQuote
               , parseDottedList
@@ -37,7 +37,7 @@ parseInt = IntLiteral . read <$> many1 digit
 
 parseFloat :: Parser Expr
 parseFloat = do
-    characteristic <- many digit
+    characteristic <- many1 digit
     char '.'
     mantissa <- many1 digit
     return $ (FloatLiteral . read) $ characteristic ++ "." ++ mantissa
@@ -45,8 +45,8 @@ parseFloat = do
 symbol :: Parser Char
 symbol = oneOf "!#$%&|*+:/-=<?>@^_~"
 
-parseAtom :: Parser Expr
-parseAtom = do
+parseId :: Parser Expr
+parseId = do
     first <- letter <|> symbol
     rest <- many (letter <|> symbol <|> digit)
     let atom = first:rest
@@ -77,12 +77,12 @@ parseQuote = do
 
 parseLispValue :: Parser Expr
 parseLispValue =
-    try parseAtom
+    try parseId
     <|> parseString
+    <|> try parseFloat
     <|> parseInt
     <|> parseQuote
     -- TODO: figure out a way to have floats and dotted lists
-    -- <|> parseFloat
     <|> do
         char '('
         x <- try parseList <|> parseDottedList
-- 
cgit v1.2.3