From f74d9c9bb3722fd20cea000b4f0c2a74be289a9c Mon Sep 17 00:00:00 2001 From: Akshay Date: Sat, 10 Oct 2020 11:15:42 +0530 Subject: add quasiquote, unquote modifiers, basic boolean operations add more info to readme --- readme.txt | 21 +++++++++++++++++++-- src/Error.hs | 8 ++++---- src/Evaluator.hs | 16 +++++++++------- src/Operators.hs | 19 ++++++++++++++++++- src/Parser.hs | 31 +++++++++++++++++++------------ 5 files changed, 69 insertions(+), 26 deletions(-) diff --git a/readme.txt b/readme.txt index 6a4be58..f187488 100644 --- a/readme.txt +++ b/readme.txt @@ -19,10 +19,27 @@ cabal: cabal run +usage +----- + +$ lisk +;;; Entering lisk repl ... +(lisk)> (+ 1 2 3) +Right 6 +(lisk)> (not (= 2 3)) +Right #t +(lisk)> '(a b c) +Right (a b c) + + + todo ---- +apart from lines/blocks marked with TODO in the source +files: + * implement correct double/int interaction (src/Operators.hs) -* implement boolean operations: and, not, or -* write Ord instance for LispNumber (src/Operators.hs) +* implement boolean operations: and, or +* rectify Ord implementation for LispNumber (src/Operators.hs) * implement property based testing with quickcheck (tests/Properties.hs) diff --git a/src/Error.hs b/src/Error.hs index 5ba48bf..bfc8d14 100644 --- a/src/Error.hs +++ b/src/Error.hs @@ -18,10 +18,10 @@ unwordsList :: [Expr] -> String unwordsList = unwords . map show instance Show LispError where - show (Parse e) = "Parser Error: " ++ show e - show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr - show (ArgCount n es) = "Invalid arity, expected " ++ show n ++ ", got value(s): " ++ unwordsList es - show (UnknownFunction fn) = "Cannot apply function: " ++ fn + show (Parse e) = "Parser Error: " ++ show e + show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr + show (ArgCount n es) = "Invalid arity, expected " ++ show n ++ ", got value(s): " ++ unwordsList es + show (UnknownFunction fn) = "Cannot apply function: " ++ fn show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got type LispResult = Either LispError diff --git a/src/Evaluator.hs b/src/Evaluator.hs index c8d8d34..10e5e58 100644 --- a/src/Evaluator.hs +++ b/src/Evaluator.hs @@ -10,10 +10,10 @@ import Parser import Text.ParserCombinators.Parsec apply :: String -> [Expr] -> LispResult Expr -apply fn args = - case lookup fn primitives of - Just f -> f args - _ -> throwError $ UnknownFunction fn +apply fn args = maybe + (throwError $ UnknownFunction fn) + ($ args) + (lookup fn primitives) eval :: Expr -> LispResult Expr eval v@(StringLiteral s) = return v @@ -21,9 +21,11 @@ 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 +eval (List[Id "quote", val]) = return val +eval (List[Id "quasiquote", val]) = undefined +eval (List[Id "unquote", val]) = undefined +eval (List (Id fn : args)) = mapM eval args >>= apply fn -- handle bad forms -eval idk = throwError $ BadForm "lisk can't recognize this form" idk +eval invalidForm = throwError $ BadForm "lisk can't recognize this form" invalidForm diff --git a/src/Operators.hs b/src/Operators.hs index beb6364..e607250 100644 --- a/src/Operators.hs +++ b/src/Operators.hs @@ -19,6 +19,7 @@ primitives = , ("<=", comparator (<=)) , ("=", comparator (==)) , ("!=", comparator (/=)) + , ("not", unaryBool not) ] data LispNumber = I Integer @@ -38,7 +39,9 @@ instance Num LispNumber where (F a) * (F b) = F $ a * b instance Fractional LispNumber where - (I a) / (I b) = I $ a `div` b + (I a) / (I b) = F $ fromIntegral a / fromIntegral b + (F a) / (I b) = F $ a / fromIntegral b + (I a) / (F b) = F $ fromIntegral a / b (F a) / (F b) = F $ a / b arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr @@ -55,6 +58,16 @@ comparator op args as <- mapM unwrapNum args return . BoolLiteral . all (== True) $ zipWith op as (tail as) +unaryBool :: (Bool -> Bool) -> [Expr] -> LispResult Expr +unaryBool op args + | length args /= 1 = throwError $ ArgCount 1 args + | otherwise = BoolLiteral . op <$> unwrapBool (head args) + +naryBool :: (Bool -> Bool -> Bool) -> [Expr] -> LispResult Expr +naryBool op args + | length args < 2 = throwError $ ArgCount 2 args + + unwrapNum :: Expr -> LispResult LispNumber unwrapNum (IntLiteral n) = return $ I n unwrapNum (FloatLiteral n) = return $ F n @@ -63,3 +76,7 @@ unwrapNum x = throwError $ TypeMismatch "number" x wrapNum :: LispNumber -> Expr wrapNum (I n) = IntLiteral n wrapNum (F n) = FloatLiteral n + +unwrapBool :: Expr -> LispResult Bool +unwrapBool (BoolLiteral s) = return s +unwrapBool x = throwError $ TypeMismatch "boolean" x diff --git a/src/Parser.hs b/src/Parser.hs index 9813f5c..5053d0a 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -13,16 +13,14 @@ import Control.Applicative ((<$>)) import Control.Monad (liftM) import Text.ParserCombinators.Parsec - -type Ident = String - +-- TODO: use LispNumber (src/Operators.hs) here instead of IntLiteral and FloatLiteral data Expr = List [Expr] | DottedList [Expr] Expr | StringLiteral String | IntLiteral Integer | FloatLiteral Double | BoolLiteral Bool - | Id Ident + | Id String deriving (Eq) parseString :: Parser Expr @@ -68,12 +66,17 @@ parseDottedList = do whiteSpace DottedList head <$> parseLispValue -parseQuote :: Parser Expr -parseQuote = do - char '\'' +type Alias = String +parseModifier :: Char -> Alias -> Parser Expr +parseModifier c alias = do + char c x <- parseLispValue - return $ List [Id "quote", x] + return $ List [Id alias, x] +parseQuote = parseModifier '\'' "quote" +parseQuasiquote = parseModifier '`' "quasiquote" +parseUnquote = parseModifier ',' "unquote" +-- TODO: add modifier for unquote splicing parseLispValue :: Parser Expr parseLispValue = @@ -82,7 +85,8 @@ parseLispValue = <|> try parseFloat <|> parseInt <|> parseQuote - -- TODO: figure out a way to have floats and dotted lists + <|> parseQuasiquote + <|> parseUnquote <|> do char '(' x <- try parseList <|> parseDottedList @@ -90,12 +94,15 @@ parseLispValue = return x "expected lisp value!" +showLispList :: [Expr] -> String +showLispList = unwords . map show + instance Show Expr where - show (DottedList xs x) = "(" ++ unwords (map show xs) ++ " . " ++ show x ++ ")" - show (List xs) = "(" ++ unwords (map show xs) ++ ")" + show (DottedList xs x) = "(" ++ showLispList xs ++ " . " ++ show x ++ ")" + show (List xs) = "(" ++ showLispList xs ++ ")" show (StringLiteral s) = "\"" ++ s ++ "\"" show (IntLiteral n) = show n show (FloatLiteral n) = show n show (BoolLiteral True) = "#t" show (BoolLiteral False) = "#f" - show (Id i) = i + show (Id i) = i -- cgit v1.2.3