add quasiquote, unquote modifiers, basic boolean operations

add more info to readme

4 files changed, 50 insertions, 24 deletions

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