From a46e29261af516fd72aaa217ef614d650c35f04a Mon Sep 17 00:00:00 2001
From: Zoe Roux <zoe.roux@sdg.moe>
Date: Thu, 4 Nov 2021 17:04:40 +0100
Subject: [PATCH] Handling quotes (without the read syntax)

---
 src/BasicParser.hs |  7 +++++++
 src/Expressions.hs |  7 +++++--
 src/LispParser.hs  | 31 +++++++++++++++++++++++++------
 3 files changed, 37 insertions(+), 8 deletions(-)

diff --git a/src/BasicParser.hs b/src/BasicParser.hs
index a2dfb24..45ce591 100644
--- a/src/BasicParser.hs
+++ b/src/BasicParser.hs
@@ -56,6 +56,13 @@ pCharIf predicate = Parser subParse
 pUntil :: (Char -> Bool) -> Parser String
 pUntil predicate = some $ pCharIf (not . predicate)
 
+pString :: String -> Parser String
+pString (x:xs) = do
+    c <- pCharIf (== x)
+    str <- pString xs
+    return (c:str)
+pString [] = pure ""
+
 pToken :: Parser String
 pToken = pUntil $ \x -> isSpace x || x == ')' || x == '('
 
diff --git a/src/Expressions.hs b/src/Expressions.hs
index fa00c66..0f60060 100644
--- a/src/Expressions.hs
+++ b/src/Expressions.hs
@@ -6,7 +6,8 @@ data Atom =
     AString String |
     AFloat Float |
     ACons Atom Atom |
-    ANil
+    ANil |
+    AQuote Atom
 
 newtype SExpr = SExpr [Statement]
 
@@ -15,7 +16,9 @@ instance Show Atom where
     show (ASymbol symb) = symb
     show (AString str) = "\"" ++ str ++ "\""
     show (AFloat float) = show float
-    show ANil = "nil"
+    show (AQuote atom) = show atom
+    show ANil = "()"
+    show (ACons (ASymbol "quote") (ACons fi ANil)) = "'" ++  show fi
     show (ACons fi se) = "(" ++  showCon fi se ++ ")"
         where
             showCon :: Atom -> Atom -> String
diff --git a/src/LispParser.hs b/src/LispParser.hs
index 3223be6..b6a2378 100644
--- a/src/LispParser.hs
+++ b/src/LispParser.hs
@@ -1,16 +1,35 @@
 module LispParser where
 
 import BasicParser
-    ( Parser, pCharIf, pUntil, pInt, pFloat, tokenify, pToken )
+    ( Parser, pCharIf, pUntil, pInt, pFloat, tokenify, pToken, pString )
 import Expressions ( SExpr(..), Atom(..), Statement(..) )
 import Control.Applicative ( Alternative(some, (<|>)) )
 
+_pAtom :: Parser Atom
+_pAtom = AInt <$> pInt
+     <|> AFloat <$> pFloat
+     <|> pCharIf (== '"') *> (AString <$> pUntil (== '"')) <* pCharIf (== '"')
+     <|> ANil <$ pString "nil"
+     <|> ASymbol <$> pToken
+
 pAtom :: Parser Atom
-pAtom =
-    AInt <$> pInt <|>
-    AFloat <$> pFloat <|>
-    pCharIf (== '"') *> (AString <$> pUntil (== '"')) <* pCharIf (== '"') <|>
-    ASymbol <$> pToken
+pAtom = (pCharIf (== '\'') *> pQuotedAtom)
+    <|> _pAtom
+
+-- handle read syntax for:
+--  - (1 2 3)
+--  - (1 . 2)
+--  - (1 2 3 . 4)
+--  - (1 2 '3 . 4)
+--  - '3
+--  - '()
+-- WARNING, doing (cons 'quote (cons 3 nil)) create a Cons (Quote (Symbol 'quote'), 3, nil)
+--          so the result is printed as (quote 3) and not '3. Chez-Scheme print this as '3
+--          but I believe that this is not really a feature.
+pQuotedAtom :: Parser Atom
+pQuotedAtom = ANil <$ pString "()"
+          <|> pCharIf (== '\'') *> ((\x -> ACons (ASymbol "quote") (ACons x ANil)) <$> pQuotedAtom)
+          <|> AQuote <$> _pAtom
 
 pSExpr :: Parser SExpr
 pSExpr = pCharIf (== '(') *> (SExpr <$> some (tokenify pStatement)) <* pCharIf (== ')')