From 674178d72004921354159f443ac68a1b7930be9d Mon Sep 17 00:00:00 2001
From: Akshay <nerdy@peppe.rs>
Date: Tue, 27 Oct 2020 08:34:56 +0530
Subject: basic comment support

---
 src/Base.hs   | 26 +++++++++++++-------------
 src/Parser.hs | 10 +++++++---
 2 files changed, 20 insertions(+), 16 deletions(-)

(limited to 'src')

diff --git a/src/Base.hs b/src/Base.hs
index 08131e8..8defd91 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -1,6 +1,5 @@
 module Base (Expr (..)
             , Env (..)
-            , Function (..)
             ) where
 
 import           Data.IORef
@@ -16,10 +15,10 @@ data Expr = List [Expr]
           | FloatLiteral Double
           | BoolLiteral Bool
           | Id String
-          deriving (Eq)
+          | Function Fn
 
-data Function =
-    Function {
+data Fn =
+    Fn {
     params        :: [String]
     , body        :: Expr
     , environment :: Env
@@ -31,12 +30,13 @@ showLispList :: [Expr] -> String
 showLispList = unwords . map show
 
 instance Show Expr where
-    show (DottedList xs x)   = "(" ++ showLispList xs ++ " . " ++ show x ++ ")"
-    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 (BoolLiteral True)  = "#t"
-    show (BoolLiteral False) = "#f"
-    show (Id i)              = i
+    show (DottedList xs x)               = "(" ++ showLispList xs ++ " . " ++ show x ++ ")"
+    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 (BoolLiteral True)              = "#t"
+    show (BoolLiteral False)             = "#f"
+    show (Id i)                          = i
+    show (Function (Fn params body env)) = "<#procedure " ++ unwords params ++ ">"
diff --git a/src/Parser.hs b/src/Parser.hs
index 94de680..6247843 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -2,11 +2,12 @@ module Parser ( parseLispValue
               , parseString
               , parseInt
               , parseFloat
+              , parseComment
               , parseId
               , parseQuote
               ) where
 
-import           Base                          (Expr (..), Function)
+import           Base                          (Expr (..))
 import           Control.Applicative           ((<$>))
 import           Text.ParserCombinators.Parsec
 
@@ -62,11 +63,14 @@ parseId = do
                "#f" -> BoolLiteral False
                _    -> Id atom
 
+parseComment :: Parser ()
+parseComment = char ';' >> manyTill anyChar (char '\n') >> return ()
+
 whiteSpace :: Parser ()
-whiteSpace = skipMany1 $ oneOf [' ', '\n']
+whiteSpace = parseComment <|> (skipMany1 $ oneOf [' ', '\n'])
 
 optionalWhiteSpace :: Parser ()
-optionalWhiteSpace = skipMany $ oneOf [' ', '\n']
+optionalWhiteSpace = parseComment <|> (skipMany $ oneOf [' ', '\n'])
 
 type Alias = String
 parseModifier :: String -> Alias -> Parser Expr
-- 
cgit v1.2.3