From 37e251578181213e49ba08d3de39f0b8b4f77427 Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Sat, 10 Dec 2022 21:08:30 +0200
Subject: Add char datatype

---
 src/Parser.hs    |  2 ++
 src/Tokenizer.hs | 29 +++++++++++++++++++++++++----
 src/Utils.hs     |  4 ++++
 3 files changed, 31 insertions(+), 4 deletions(-)

(limited to 'src')

diff --git a/src/Parser.hs b/src/Parser.hs
index be75ab3..5e94148 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -29,6 +29,7 @@ parseToken (Token token tr tc tf)
     | isTag token = let tok = tail token
                      in ast $ ASTTag (computeTagN tok) tok
     | isString token = ast $ ASTString $ removeQuotes token
+    | isChar token = ast $ ASTChar $ head $ removeQuotes token
     | isInteger token = ast $ ASTInteger (read token)
     | isDouble token = ast $ ASTDouble (read token)
     | isBoolean token = ast $ ASTBoolean $ asBoolean token
@@ -41,6 +42,7 @@ parseToken (Token token tr tc tf)
         isDouble :: String -> Bool
         isDouble t = t =~ doubleRegex
         isString t = "\"" `L.isPrefixOf` t
+        isChar t = "'" `L.isPrefixOf` t
         isTag t = ":" `L.isPrefixOf` t && length t > 1
         removeQuotes s = drop 1 s $> take (length s - 2)
         isBoolean t = t `elem` ["true", "false"]
diff --git a/src/Tokenizer.hs b/src/Tokenizer.hs
index e36a68e..c95ddf8 100644
--- a/src/Tokenizer.hs
+++ b/src/Tokenizer.hs
@@ -35,8 +35,29 @@ _tokenize fileName acc current (x:xs)
                 tokenColumn = tColumn $ head cur,
                 tokenFileName = fileName }
          in _tokenize fileName (token : acc) [] commentDropped
+    | tChar x == '\'' =
+        -- consumedN == -1 signals an unbalanced error
+        let inc k n = if n == -1 then -1 else n + k
+            consume :: String -> (String, Int)
+            consume str = case str of
+                ('\\':'\'':rest) -> B.bimap ('\'' :) (inc 2) (consume rest)
+                ('\'':_) -> ("", 1)
+                (c:rest) -> B.bimap (c :) (inc 1) (consume rest)
+                [] -> ("", -1)
+            (char, consumedN) = consume (map tChar xs)
+            charDropped = drop (consumedN) xs
+            withQuotes = "\'" ++ char ++ "\'"
+            token = Token {
+                tokenContent = withQuotes,
+                tokenRow = tRow $ x,
+                tokenColumn = tColumn $ x,
+                tokenFileName = fileName }
+        in do
+            when (consumedN == -1) $ throwL (posTChar fileName x, "unbalanced char literal")
+            when (length char > 1) $ throwL (posTChar fileName x, "char literal length > 1")
+            _tokenize fileName (token : acc) [] charDropped
     | tChar x == '"' =
-        -- String length -1 signals an unbalanced error
+        -- consumedN == -1 signals an unbalanced error
         let inc k n = if n == -1 then -1 else n + k
             consume :: String -> (String, Int)
             consume str = case str of
@@ -46,8 +67,8 @@ _tokenize fileName acc current (x:xs)
                 ('"':_) -> ("", 1)
                 (c:rest) -> B.bimap (c :) (inc 1) (consume rest)
                 [] -> ("", -1)
-            (string, stringLength) = consume (map tChar xs)
-            stringDropped = drop (stringLength) xs
+            (string, consumedN) = consume (map tChar xs)
+            stringDropped = drop (consumedN) xs
             withQuotes = "\"" ++ string ++ "\""
             token = Token {
                 tokenContent = withQuotes,
@@ -55,7 +76,7 @@ _tokenize fileName acc current (x:xs)
                 tokenColumn = tColumn $ x,
                 tokenFileName = fileName }
         in do
-            when (stringLength == -1) $ throwL (posTChar fileName x, "unbalanced string literal")
+            when (consumedN == -1) $ throwL (posTChar fileName x, "unbalanced string literal")
             _tokenize fileName (token : acc) [] stringDropped
     | tChar x `elem` [' ', '\n', '\t', '\r'] =
         let cur = reverse current
diff --git a/src/Utils.hs b/src/Utils.hs
index f3e2b8c..01ecb17 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -163,6 +163,7 @@ data ASTNode
     | ASTDouble Double
     | ASTSymbol String
     | ASTBoolean Bool
+    | ASTChar Char
     | ASTString String
     | ASTTag TagHash String
     | ASTVector [AST]
@@ -189,6 +190,7 @@ instance (Show ASTNode) where
     show (ASTDouble n) = show n
     show (ASTSymbol s) = s
     show (ASTBoolean b) = show b $> map C.toLower
+    show (ASTChar c) = show c
     show (ASTString s) = show s
     show (ASTTag _ s) = ":" ++ s
     show (ASTVector v) = "[" ++ L.intercalate " " (map show v) ++ "]"
@@ -214,6 +216,7 @@ instance (Eq ASTNode) where
     ASTDouble a == ASTDouble b = a == b
     ASTSymbol a == ASTSymbol b = a == b
     ASTBoolean a == ASTBoolean b = a == b
+    ASTChar a == ASTChar b = a == b
     ASTString a == ASTString b = a == b
     ASTTag n _ == ASTTag m _ = n == m
     ASTVector a == ASTVector b = a == b
@@ -235,6 +238,7 @@ instance (Ord ASTNode) where
     ASTDouble a <= ASTDouble b = a <= b
     ASTSymbol a <= ASTSymbol b = a <= b
     ASTBoolean a <= ASTBoolean b = a <= b
+    ASTChar a <= ASTChar b = a <= b
     ASTString a <= ASTString b = a <= b
     ASTTag n _ <= ASTTag m _ = n <= m
     ASTVector a <= ASTVector b = a <= b
-- 
cgit v1.3