Refactor Lib.hs

1 files changed, 46 insertions, 0 deletions

diff --git a/src/Tokenizer.hs b/src/Tokenizer.hs
new file mode 100644
index 0000000..f321502
--- /dev/null
+++ b/src/Tokenizer.hs
@@ -0,0 +1,46 @@
+module Tokenizer (
+    tokenize,
+) where
+
+import qualified Data.Bifunctor as B
+import Control.Monad.Except
+import Utils
+
+_tokenize :: [String] -> String -> String -> LContext [String]
+_tokenize acc current src = case src of
+    "" -> return $ reverse current : acc
+    (x:xs)
+        | x == ';' ->
+            let commentDropped = dropWhile (\c -> c /= '\n') xs
+             in _tokenize (reverse current : acc) "" commentDropped
+        | x == '"' ->
+            -- String length -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)
+                    ('\\':'n':rest) -> B.bimap ('\n' :) (inc 2) (consume rest)
+                    ('\\':'t':rest) -> B.bimap ('\t' :) (inc 2) (consume rest)
+                    ('"':_) -> ("", 1)
+                    (c:rest) -> B.bimap (c :) (inc 1) (consume rest)
+                    [] -> ("", -1)
+                (string, stringLength) = consume xs
+                stringDropped = drop (stringLength) xs
+                withQuotes = "\"" ++ string ++ "\""
+             in do
+                when (stringLength == -1) $ throwL "unbalanced string literal"
+                _tokenize (withQuotes : acc) "" stringDropped
+        | x `elem` [' ', '\n', '\t', '\r'] ->
+            _tokenize (reverse current : acc) "" xs
+        | x `elem` ['(', ')', '[', ']', '{', '}', '\\'] ->
+            _tokenize ([x] : reverse current : acc) "" xs
+        | otherwise ->
+            _tokenize acc (x : current) xs
+
+tokenize :: String -> LContext [String]
+tokenize src = do
+    tokens <- _tokenize [] "" src
+    return $ tokens
+        $> reverse
+        .> filter (\s -> length s > 0)
+