1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
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)
|
