simyager/kurt
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added character literals

Browse Source
This commit is contained in:
mRnea
2024-08-15 21:37:03 +03:00
parent b52e5b548a
commit 6eb5ad5b42
1 changed files with 24 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
cl-forth.lisp
View File

@@ -24,11 +24,22 @@
(write-char #\Newline str)) (write-char #\Newline str))
(t (write-char ch str)))))) (t (write-char ch str))))))
(defun read-character (stream)
(let ((ch? (read-char stream)))
(if (not (char-equal ch? #\\))
(if (char-equal #\' (peek-char nil stream))
(progn (read-char stream) ch?)
(error "Unterminated char."))
(progn (case (read-char stream)
(#\n (setf ch? #\Newline)))
(if (char-equal #\' (peek-char nil stream))
(progn (read-char stream) ch?)
(error "Unterminated char."))))))
(defun lex-line (line &optional (line-num 0)) (defun lex-line (line &optional (line-num 0))
(let ((*package* (find-package "KEYWORD"))) (let ((*package* (find-package "KEYWORD")))
(iter (with line-stream = (make-string-input-stream line)) (iter (with line-stream = (make-string-input-stream line))
(with col = 0) (with col = 0)
(with has-err = nil)
(for next-char = (peek-char nil line-stream nil nil)) (for next-char = (peek-char nil line-stream nil nil))
(until (null next-char)) (until (null next-char))
(let ((flag t)) (let ((flag t))
@@ -42,11 +53,16 @@
((char= #\" next-char) ((char= #\" next-char)
(read-char line-stream) (read-char line-stream)
(collect (make-token (read-string line-stream) (collect (make-token (read-string line-stream)
line-num col) line-num col :string)
into tokens))
((char= #\' next-char)
(read-char line-stream)
(collect (make-token (read-character line-stream)
line-num col :char)
into tokens)) into tokens))
(t (setf flag nil))) (t (setf flag nil)))
(when flag (when flag
(incf col) (incf col) ;; TODO: currently this is wrong for char and strings
(next-iteration))) (next-iteration)))
(for next-sym in-stream line-stream (for next-sym in-stream line-stream
using #'read-preserving-whitespace) using #'read-preserving-whitespace)
@@ -100,6 +116,9 @@
(defmethod parse-token ((parser parser) (type (eql :number))) (defmethod parse-token ((parser parser) (type (eql :number)))
(add-op `(:push-int ,(car (read-token parser))) parser)) (add-op `(:push-int ,(car (read-token parser))) parser))
(defmethod parse-token ((parser parser) (type (eql :char)))
(add-op `(:push-int ,(char-code (car (read-token parser)))) parser))
(defmethod parse-token ((parser parser) (type (eql :string))) (defmethod parse-token ((parser parser) (type (eql :string)))
(let ((token (read-token parser))) (let ((token (read-token parser)))
(add-op `(:push-str ,(length (car token)) (add-op `(:push-str ,(length (car token))