Show values (except Lists)

[my-scheme.git] / app / Main.hs

diff --git a/app/Main.hs b/app/Main.hs
index 03dbb41ad56467919b06e5c72b886c640e697253..1495605d09602a2ed23717d3b5956402874a6ef4 100644 (file)
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -65,16 +65,44 @@ parseNumber = do toNum <- radix
                                            'o' -> readOct
                                            'b' -> readInt 2 (\x -> elem x "01") (read . (:[]))
 
                                            'o' -> readOct
                                            'b' -> readInt 2 (\x -> elem x "01") (read . (:[]))
 

+parseList :: Parser LispVal
+parseList = liftM List $ sepBy parseExpr spaces
+
+parseDottedList :: Parser LispVal
+parseDottedList = do
+    head <- endBy parseExpr spaces
+    tail <- char '.' >> spaces >> parseExpr
+    return $ DottedList head tail
+
+parseQuoted :: Parser LispVal
+parseQuoted = do
+    char '\''
+    x <- parseExpr
+    return $ List [Atom "quote", x]
+

 parseExpr :: Parser LispVal
 parseExpr = parseString
 parseExpr :: Parser LispVal
 parseExpr = parseString

-        <|> parseCharacter

         <|> parseNumber
         <|> parseAtom
         <|> parseNumber
         <|> parseAtom

+        <|> try parseCharacter
+        <|> parseQuoted
+        <|> do char '('
+               x <- try parseList <|> parseDottedList
+               char ')'
+               return x

 
 readExpr :: String -> String
 readExpr input = case parse parseExpr "lisp" input of
     Left err -> "No match: " ++ show err
 
 readExpr :: String -> String
 readExpr input = case parse parseExpr "lisp" input of
     Left err -> "No match: " ++ show err

-    Right val -> "Found value: " ++ show val
+    Right val -> "Found value: " ++ showVal val
+
+showVal :: LispVal -> String
+showVal (Atom atom)   = atom
+showVal (Number n)    = show n
+showVal (String str)  = "\"" ++ str ++ "\""
+showVal (Character c) = "'" ++ [c] ++ "'"
+showVal (Bool True)   = "#t"
+showVal (Bool False)  = "#f"

 
 main :: IO ()
 main = do
 
 main :: IO ()
 main = do