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

basic error reporting to character and string literals

Browse Source
This commit is contained in:
mRnea
2024-08-24 00:43:43 +03:00
parent 3fc13bcddd
commit 0f953a0a2f
2 changed files with 94 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
cl-forth.lisp
View File

@@ -14,32 +14,51 @@
(car token))
;;; LEXER
(defun read-string (stream)
;; TODO: Handle unmatched " and give proper error message
(with-output-to-string (str)
(iter (for ch = (read-char stream))
(cond ((char= ch #\")
(finish))
((char= ch #\\)
(case (peek-char nil stream)
(#\n (write-char #\Newline str))
(#\0 (write-char (code-char 0) str))
(#\\ (write-char #\\ str))
(#\" (write-char #\" str)))
(read-char stream))
(t (write-char ch str))))))
(defun read-string (stream line-num line col)
"This function is called when a #\" (double quote) is read from the STREAM."
(let ((i 0))
(values
(with-output-to-string (str)
(iter (for ch = (read-char stream nil 'eof))
(cond ((eq 'eof ch)
(error (cond-string-not-closed
line-num line col
(get-output-stream-string str))))
((char= ch #\")
(if (> i 0)
(finish)
(error (cond-empty-string line-num line col))))
((char= ch #\\)
(case (peek-char nil stream)
(#\n (write-char #\Newline str))
(#\0 (write-char (code-char 0) str))
(#\\ (write-char #\\ str))
(#\" (write-char #\" str)))
(read-char stream))
(t (write-char ch str)))
(incf i)))
i)))
(defun read-character (stream line-num line col)
(let ((ch? (read-char stream)))
(if (not (char-equal ch? #\\))
(if (char-equal #\' (peek-char nil stream))
(progn (read-char stream) ch?)
(error (handle-char-not-closed line-num line col)))
(progn (case (read-char stream)
(#\n (setf ch? #\Newline)))
(if (char-equal #\' (peek-char nil stream))
(progn (read-char stream) ch?)
(error (handle-char-not-closed line-num line col)))))))
"This function is called when a #\' (single quote) is read from the STREAM."
(let ((ch? (read-char stream nil 'eof)))
(cond ((eq 'eof ch?)
(error (cond-char-not-closed line-num line col 'yok)))
((char-equal ch? #\\)
(let ((escaped-ch (read-char stream nil 'eof)))
(case escaped-ch
(eof (error (cond-char-not-closed line-num line col 'yok)))
(#\n (setf ch? #\Newline))
(#\0 (setf ch? (code-char 0)))
(otherwise (setf ch? escaped-ch)))))
((char-equal ch? #\')
(error (cond-empty-char line-num line col)))
(t nil))
(let ((closing-ch (read-char stream nil 'eof)))
(if (or (eq 'eof closing-ch)
(not (char-equal #\' closing-ch)))
(error (cond-char-not-closed line-num line col ch?))
ch?))))
(defun lex-line (line &optional (line-num 0))
(let ((*package* (find-package "KEYWORD")))
@@ -61,7 +80,8 @@
(finish))
((char= #\" next-char)
(read-char line-stream)
(collect (make-token (read-string line-stream)
(collect (make-token (read-string
line-stream line-num line col)
line-num col :string)
into tokens))
((char= #\' next-char)

54
errors.lisp
View File

@@ -8,16 +8,60 @@
(write-char #\Space stream))
(format stream "^~%"))
(define-condition char-not-closed ()
(defun char-num-pair (ch?)
(if (characterp ch?)
(list ch? (char-code ch?))
ch?))
(define-condition char-error ()
((line :initarg :line :reader line)
(col :initarg :col :reader col)
(line-num :initarg :line-num :reader line-num))
(line-num :initarg :line-num :reader line-num)
(ch :initarg :ch :reader ch :initform 'yok)))
(define-condition char-not-closed (char-error) ()
(:report (lambda (condition stream)
(format stream "Karakterin kapanış sembolü ' eksik.~%")
(format stream "Karakterin kapanış sembolü ' (tek tırnak) eksik.~%Okunan karakter: ~s~%" (char-num-pair (ch condition)))
(report-line (line-num condition) (line condition) (col condition) stream))))
(defun handle-char-not-closed (line-num line token-or-col)
(make-condition 'char-not-closed :line-num line-num :line line :col token-or-col))
(define-condition empty-char (char-error) ()
(:report (lambda (condition stream)
(format stream "Boş karakter oluşturulamaz.~%")
(report-line (line-num condition) (line condition) (col condition) stream))))
(defun cond-char-not-closed (line-num line token-or-col ch)
(make-condition 'char-not-closed :line-num line-num :line line :col token-or-col :ch ch))
(defun cond-empty-char (line-num line token-or-col)
(make-condition 'empty-char :line-num line-num :line line :col token-or-col))
(define-condition string-error ()
((line :initarg :line :reader line)
(col :initarg :col :reader col)
(line-num :initarg :line-num :reader line-num)
(content :initarg :content :reader content :initform 'yok)))
(define-condition string-not-closed (string-error) ()
(:report (lambda (condition stream)
(format stream "Metnin kapanış sembolü \" (çift tırnak) eksik.~%Okunan metin: ~s~%"
(list (content condition) (length (content condition))))
(report-line (line-num condition) (line condition) (col condition) stream))))
(defun cond-string-not-closed (line-num line token-or-col &optional (content 'yok))
(make-condition 'string-not-closed :line-num line-num :line line
:col token-or-col :content content))
(define-condition empty-string (string-error) ()
(:report (lambda (condition stream)
(format stream "Boş metin oluşturulamaz.~%")
(report-line (line-num condition) (line condition) (col condition) stream))))
(defun cond-empty-string (line-num line token-or-col)
(make-condition 'empty-string :line-num line-num :line line :col token-or-col))
;; (define-condition op-not-implemented (style-warning)
;; ((undef-ops :initarg :ops :reader undef-ops))