2016-10-02 16:55:19 +03:00
|
|
|
(class +Reader)
|
|
|
|
# tokens
|
|
|
|
(dm T (Tokens)
|
|
|
|
(=: tokens Tokens) )
|
|
|
|
|
|
|
|
(dm next> ()
|
|
|
|
(pop (:: tokens)) )
|
|
|
|
|
|
|
|
(dm peek> ()
|
|
|
|
(car (: tokens)) )
|
|
|
|
|
|
|
|
(de read-str (String)
|
|
|
|
(let (Tokens (tokenizer String)
|
|
|
|
Reader (new '(+Reader) Tokens) )
|
|
|
|
(read-form Reader) ) )
|
|
|
|
|
|
|
|
(de tokenizer (String)
|
|
|
|
# [\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)
|
|
|
|
(let (Special " []{}()'\"`,;" )
|
|
|
|
(make
|
|
|
|
(for (Chars (chop String) Chars)
|
|
|
|
(let Char (pop 'Chars)
|
|
|
|
(cond
|
2016-10-16 23:58:01 +03:00
|
|
|
((or (sp? Char) (= Char ","))
|
2016-10-02 16:55:19 +03:00
|
|
|
# do nothing, whitespace
|
|
|
|
)
|
|
|
|
((and (= Char "~") (= (car Chars) "@"))
|
|
|
|
(link "~@")
|
|
|
|
(pop 'Chars) ) # remove @ token
|
|
|
|
((index Char (chop "[]{}()'`~^\@"))
|
|
|
|
(link Char) )
|
|
|
|
((= Char "\"")
|
|
|
|
(link
|
|
|
|
(pack
|
|
|
|
(make
|
2019-05-17 00:45:23 +03:00
|
|
|
(link Char) # HACK
|
|
|
|
(use Done
|
|
|
|
(while (and Chars (not Done))
|
|
|
|
(let Char (pop 'Chars)
|
|
|
|
(cond
|
|
|
|
((= Char "\\")
|
|
|
|
(if Chars
|
|
|
|
(let Char (pop 'Chars)
|
|
|
|
(if (= Char "n")
|
|
|
|
(link "\n")
|
|
|
|
(link Char) ) )
|
|
|
|
(throw 'err (MAL-error (MAL-string "expected '\"', got EOF"))) ) )
|
|
|
|
((<> Char "\"")
|
|
|
|
(link Char) )
|
|
|
|
((= Char "\"")
|
|
|
|
(setq Done T) ) ) ) )
|
|
|
|
(unless Done
|
|
|
|
(throw 'err (MAL-error (MAL-string "expected '\"', got EOF"))) ) ) ) ) ) )
|
2016-10-02 16:55:19 +03:00
|
|
|
((= Char ";")
|
|
|
|
(while (and Chars (<> Char "\n"))
|
|
|
|
(setq Char (pop 'Chars)) ) )
|
2016-10-16 23:58:01 +03:00
|
|
|
((and (not (index Char (chop Special))) (not (sp? Char)))
|
2016-10-02 16:55:19 +03:00
|
|
|
(link
|
|
|
|
(pack
|
|
|
|
(make
|
|
|
|
(link Char)
|
|
|
|
(let Char (car Chars)
|
2016-10-16 23:58:01 +03:00
|
|
|
(while (and Chars (not (index Char (chop Special))) (not (sp? Char)))
|
2016-10-02 16:55:19 +03:00
|
|
|
(link (pop 'Chars))
|
|
|
|
(setq Char (car Chars)) ) ) ) ) ) ) ) ) ) ) ) )
|
|
|
|
|
|
|
|
(de read-form (Reader)
|
|
|
|
(case (peek> Reader)
|
|
|
|
("'" (read-macro Reader 'quote))
|
|
|
|
("`" (read-macro Reader 'quasiquote))
|
|
|
|
("~" (read-macro Reader 'unquote))
|
|
|
|
("~@" (read-macro Reader 'splice-unquote))
|
|
|
|
("@" (read-macro Reader 'deref))
|
|
|
|
("\^" (read-meta Reader))
|
|
|
|
("(" (read-list Reader 'list ")"))
|
|
|
|
("[" (read-list Reader 'vector "]"))
|
|
|
|
("{" (read-list Reader 'map "}"))
|
|
|
|
(T (read-atom Reader)) ) )
|
|
|
|
|
|
|
|
(de read-macro (Reader symbol)
|
|
|
|
(next> Reader) # pop reader macro token
|
2016-10-02 20:41:49 +03:00
|
|
|
(MAL-list (list (MAL-symbol symbol) (read-form Reader))) )
|
2016-10-02 16:55:19 +03:00
|
|
|
|
|
|
|
(de read-meta (Reader)
|
|
|
|
(next> Reader) # pop reader macro token
|
|
|
|
(let Form (read-form Reader)
|
2016-10-02 20:41:49 +03:00
|
|
|
(MAL-list (list (MAL-symbol 'with-meta) (read-form Reader) Form) ) ) )
|
2016-10-02 16:55:19 +03:00
|
|
|
|
|
|
|
(de read-list (Reader Type Ender)
|
|
|
|
(next> Reader) # pop list start
|
|
|
|
(new (list (case Type
|
|
|
|
(list '+MALList)
|
|
|
|
(vector '+MALVector)
|
|
|
|
(map '+MALMap) ) )
|
|
|
|
(make
|
|
|
|
(use Done
|
|
|
|
(while (not Done)
|
|
|
|
(let Token (peek> Reader)
|
|
|
|
(cond
|
|
|
|
((= Token Ender)
|
|
|
|
(next> Reader) # pop list end
|
|
|
|
(setq Done T) )
|
|
|
|
((not Token)
|
2016-10-02 20:41:49 +03:00
|
|
|
(let Msg (pack "expected '" Ender "', got EOF")
|
2016-10-22 13:37:24 +03:00
|
|
|
(throw 'err (MAL-error (MAL-string Msg))) ) )
|
2016-10-02 16:55:19 +03:00
|
|
|
(T (link (read-form Reader))) ) ) ) ) ) ) )
|
|
|
|
|
|
|
|
(de read-atom (Reader)
|
|
|
|
(let (Token (next> Reader)
|
|
|
|
Chars (chop Token))
|
|
|
|
(cond
|
|
|
|
((= Token "true")
|
|
|
|
*MAL-true)
|
|
|
|
((= Token "false")
|
|
|
|
*MAL-false)
|
|
|
|
((= Token "nil")
|
|
|
|
*MAL-nil)
|
|
|
|
((format Token)
|
2016-10-02 20:41:49 +03:00
|
|
|
(MAL-number @) )
|
2016-10-02 16:55:19 +03:00
|
|
|
((= (car Chars) "\"")
|
2019-05-17 00:45:23 +03:00
|
|
|
(MAL-string (pack (cdr Chars))) )
|
2016-10-02 16:55:19 +03:00
|
|
|
((= (car Chars) ":")
|
2016-10-03 01:31:43 +03:00
|
|
|
(MAL-keyword (intern (pack (cdr Chars)))) )
|
2016-10-02 16:55:19 +03:00
|
|
|
((not Token)
|
2016-10-22 13:37:24 +03:00
|
|
|
(throw 'err (MAL-error (MAL-string "end of token stream"))) )
|
2016-10-03 01:31:43 +03:00
|
|
|
(T (MAL-symbol (intern Token))) ) ) )
|