1 files changed, 39 insertions, 12 deletions

diff --git a/src/Base.hs b/src/Base.hs
index 08131e8..422e534 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -1,10 +1,41 @@
 module Base (Expr (..)
             , Env (..)
-            , Function (..)
+            , LispNumber (..)
             ) where
 
 import           Data.IORef
 
+data LispNumber = I Integer
+                | F Double
+                deriving (Eq, Ord)
+
+instance Num LispNumber where
+    -- addition
+    (I a) + (I b) = I $ a + b
+    (F a) + (F b) = F $ a + b
+    (F a) + (I b) = F $ a + fromIntegral b
+    (I a) + (F b) = F b + I a
+
+    -- subtraction
+    (I a) - (I b) = I $ a - b
+    (F a) - (F b) = F $ a - b
+    (F a) - (I b) = F $ a - fromIntegral b
+    (I a) - (F b) = F b - I a
+
+    -- multiplication
+    (I a) * (I b) = I $ a * b
+    (F a) * (F b) = F $ a * b
+    (F a) * (I b) = F $ a * fromIntegral b
+    (I a) * (F b) = F b * I a
+
+instance Fractional LispNumber where
+    (I a) / (I b) = F $ fromIntegral a / fromIntegral b
+    (F a) / (I b) = F $ a / fromIntegral b
+    (I a) / (F b) = recip $ F b / I a
+    (F a) / (F b) = F $ a / b
+    recip (F x) = F $ 1 / x
+    recip (I x) = F $ 1 / fromIntegral x
+
 -- TODO: use LispNumber (src/Operators.hs) here instead of IntLiteral and FloatLiteral
 -- TODO: add character literals: \#a \#b \#c \#space \#newline
 -- TODO: add support for complex numbers, oct and hex numbers
@@ -12,19 +43,15 @@ data Expr = List [Expr]
           | Vector [Expr]
           | DottedList [Expr] Expr
           | StringLiteral String
-          | IntLiteral Integer
-          | FloatLiteral Double
+          | Number LispNumber
           | BoolLiteral Bool
           | Id String
+          | Function { params      :: [String]
+                     , body        :: Expr
+                     , extendedEnv :: Env
+                     }
           deriving (Eq)
 
-data Function =
-    Function {
-    params        :: [String]
-    , body        :: Expr
-    , environment :: Env
-    }
-
 type Env = IORef [(String, IORef Expr)]
 
 showLispList :: [Expr] -> String
@@ -35,8 +62,8 @@ instance Show Expr where
     show (List xs)           = "(" ++ showLispList xs ++ ")"
     show (Vector xs)         = "#(" ++ showLispList xs ++ ")"
     show (StringLiteral s)   = "\"" ++ s ++ "\""
-    show (IntLiteral n)      = show n
-    show (FloatLiteral n)    = show n
+    show (Number (I n))      = show n
+    show (Number (F n))      = show n
     show (BoolLiteral True)  = "#t"
     show (BoolLiteral False) = "#f"
     show (Id i)              = i