From 841e23f1f5036748e3d179e3f96eedd5bcfdb555 Mon Sep 17 00:00:00 2001 From: Akshay Date: Thu, 12 Nov 2020 11:24:46 +0530 Subject: refactor LispNumber into Base, improve numerical calculations --- src/Base.hs | 51 +++++++++++++++++++++++++++++++++++++++------------ src/Environment.hs | 3 +-- src/Evaluator.hs | 12 ++++++++---- src/Parser.hs | 8 +++----- 4 files changed, 51 insertions(+), 23 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 diff --git a/src/Environment.hs b/src/Environment.hs index b7b7ee6..e38e36c 100644 --- a/src/Environment.hs +++ b/src/Environment.hs @@ -64,5 +64,4 @@ makeBind (var, val) = do manyBindings :: Env -> [(String, Expr)] -> IO Env manyBindings env binds = do ptr <- readIORef env - extendedEnv <- (++ ptr) <$> mapM makeBind binds - newIORef extendedEnv + newIORef =<< (++ ptr) <$> mapM makeBind binds diff --git a/src/Evaluator.hs b/src/Evaluator.hs index 3bc1e09..db56068 100644 --- a/src/Evaluator.hs +++ b/src/Evaluator.hs @@ -9,12 +9,13 @@ import Error.Base (LispError (..), LispResult (..), unwrap) import Operators import Text.ParserCombinators.Parsec +import qualified Data.Map as M apply :: String -> [Expr] -> LispResult Expr apply fn args = maybe (throwError $ UnknownFunction fn) ($ args) - (lookup fn primitives) + (M.lookup fn primitives) evalUnquoteSplicing :: Env -> Expr -> IOResult Expr evalUnquoteSplicing env (List xs) = List <$> mapM (eval env) xs @@ -39,10 +40,8 @@ evalQuasiQuote env literal = return literal -- just behave like quote other eval :: Env -> Expr -> IOResult Expr eval _ v@(StringLiteral s) = return v -eval _ v@(IntLiteral i) = return v -eval _ v@(BoolLiteral b) = return v +eval _ v@(Number i) = return v eval env (Id l) = getVar env l -eval _ v@(FloatLiteral f) = return v eval env v@(Vector xs) = Vector <$> mapM (eval env) xs eval env (List[Id "quote", val]) = return val eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val @@ -50,6 +49,7 @@ eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use eval env v@(List[Id "unquote-splicing", val]) = throwError $ BadForm "Cannot use `unquote-splicing` outside quasiquote form" v eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . (setVar env var &&& pure) eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . (defineVar env var &&& pure) +-- eval env (List (Id "lambda":List params:body)) = evalLambda params body env eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn -- handle bad forms @@ -58,3 +58,7 @@ eval env invalidForm = throwError $ BadForm "lisk can't recognize this form" inv unwrapList :: Expr -> [Expr] unwrapList (List x) = x unwrapList literal = [literal] + +-- evalLambda :: [Expr] -> Expr -> Env -> IOResult Expr +-- evalLambda params body env = do +-- extendedEnv <- manyBindings env diff --git a/src/Parser.hs b/src/Parser.hs index dfc3225..48dca0e 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -7,7 +7,7 @@ module Parser ( parseLispValue , parseComment ) where -import Base (Expr (..), Function) +import Base (Expr (..), LispNumber(..)) import Control.Applicative ((<$>)) import Control.Monad (void) import Text.Parsec.Char @@ -34,7 +34,7 @@ parseInt :: Parser Expr parseInt = do sign <- parseSign val <- many1 digit - return $ (IntLiteral . read) $ maybe val (:val) sign + return $ (Number . I . read) $ maybe val (:val) sign parseFloat :: Parser Expr parseFloat = do @@ -43,7 +43,7 @@ parseFloat = do char '.' mantissa <- many1 digit let fval = characteristic ++ "." ++ mantissa - return $ (FloatLiteral . read) $ maybe fval (:fval) sign + return $ (Number . F . read) $ maybe fval (:fval) sign parseVector :: Parser Expr parseVector = do @@ -112,6 +112,4 @@ parseLispValue = optionalWhiteSpace >> char ')' return $ maybe (List x) (DottedList x) t "lisp value"; - -- try parseComment; - -- return pepe; -- cgit v1.2.3