Added normal error support to src/lexer.lisp

Author: TheStalkerDen

DiffBackend/src/lexer.lisp

@@ -8,26 +8,37 @@
 
 (in-package :diff-backend/lexer)
 
-(declaim (optimize safety (debug 3)))
+(declaim (optimize (debug 3)))
 
 (defclass* lexem ()
-  ((line
-    :accessor lexem-line
-    :initarg :line
-    :type integer)
-   (column
-    :accessor lexem-column
-    :initarg :column
-    :type integer)
-   (type
-    :accessor lexem-type
-    :initarg :type
-    :type symbol)
-   (string
-    :accessor lexem-string
-    :initarg :string
-    :type string))
-  (:documentation "Lexem info"))
+    ((id
+      :accessor id
+      :initarg :id)
+     (line
+      :accessor lexem-line
+      :initarg :line
+      :type integer)
+     (column
+      :accessor lexem-column
+      :initarg :column
+      :type integer)
+     (type
+      :accessor lexem-type
+      :initarg :type
+      :type symbol)
+     (string
+      :accessor lexem-string
+      :initarg :string
+      :type string))
+    (:documentation "Lexem info"))
+
+(defclass* lexem-error ()
+  ((error-text
+    :accessor error-text
+    :initarg :error-text)
+   (error-lex-id
+    :accessor error-lex-id
+    :initarg :error-lex-id)))
 
 (defmethod print-object ((lex lexem) stream)
   (with-slots (line column string) lex
@@ -38,24 +49,30 @@
   (with-slots ((line1 line)
                (column1 column)
                (type1 type)
-               (string1 string))
+               (string1 string)
+               (id1 id))
       lex1
     (with-slots ((line2 line)
                  (column2 column)
                  (type2 type)
-                 (string2 string))
+                 (string2 string)
+                 (id2 id))
         lex2
       (and (= line1 line2)
            (= column1 column2)
            (eq type1 type2)
-           (string= string1 string2)))))
+           (string= string1 string2)
+           (or (= id1 -1)
+               (= id2 -1)
+               (= id1 id2))))))
 
-(defun make-lexem (string line column type)
+(defun make-lexem (string line column type &key (id -1))
   (make-instance 'lexem
                  :string string
                  :line line
                  :column column
-                 :type type))
+                 :type type
+                 :id id))
 
 (defun is-lexem-symbol?= (lexem symbol-string)
   (when (eq (lexem-type lexem) :symbol)
@@ -92,8 +109,11 @@
   (when char1
     (char= char1 char2)))
 
+(defparameter *cur-id* 0)
+
 (defun lexer (file-str)
-  (let ((stream (make-string-input-stream file-str))
+  (let ((*cur-id* 0)
+        (stream (make-string-input-stream file-str))
         (lexems)
         (comments-table (make-hash-table))
         (lex-errors)
@@ -122,7 +142,7 @@
          ((ch= cur-char #\;) (go COMMENT))
          ((is-whitespace? cur-char) (go WHITESPACE))
          ((null cur-char) (go END))
-         (t (error "Incorrect char ~s~%" cur-char)))
+         (t (go ERROR_LEXEM)))
      INTEGER
        (incf column)
        (push cur-char lexem-l)
@@ -138,7 +158,8 @@
        (push (make-lexem (coerce (reverse lexem-l) 'string)
                          cur-lexem-line
                          cur-lexem-column
-                         :integer)
+                         :integer
+                         :id (incf *cur-id*))
              lexems)
        (setf lexem-l nil)
        (go COMMON)
@@ -154,15 +175,17 @@
        (push (make-lexem (coerce (reverse lexem-l) 'string)
                          line
                          cur-lexem-column
-                         :symbol)
+                         :symbol
+                         :id (incf *cur-id*))
              lexems)
        (setf lexem-l nil)
        (go COMMON)
      OUT_LEFT_PARENT
        (push (make-lexem "("
                          line
                          cur-lexem-column
-                         :left-parent)
+                         :left-parent
+                         :id (incf *cur-id*))
              lexems)
        (setf cur-char (read-char stream nil))
        (incf column)
@@ -171,7 +194,8 @@
        (push (make-lexem ")"
                          line
                          cur-lexem-column
-                         :right-parent)
+                         :right-parent
+                         :id (incf *cur-id*))
              lexems)
        (setf cur-char (read-char stream nil))
        (incf column)
@@ -188,7 +212,8 @@
        (push (make-lexem "'"
                          line
                          cur-lexem-column
-                         :quote)
+                         :quote
+                         :id (incf *cur-id*))
              lexems)
        (incf column)
        (setf cur-char (read-char stream nil))
@@ -205,6 +230,8 @@
              ((ch= cur-char #\")
               (push cur-char lexem-l)
               (go OUT_STRING))
+             ((null cur-char)
+              (go ERROR_LEXEM_OUT))
              (t (go STRING)))
      STRING_ESCAPE_SYMBOL
        (incf column)
@@ -215,7 +242,8 @@
        (push (make-lexem (coerce (reverse lexem-l) 'string)
                          cur-lexem-line
                          cur-lexem-column
-                         :string)
+                         :string
+                         :id (incf *cur-id*))
              lexems)
        (setf lexem-l nil)
        (setf cur-char (read-char stream nil))
@@ -236,6 +264,33 @@
                :column ,cur-lexem-column))
        (setf lexem-l nil)
        (go COMMON)
+     ERROR_LEXEM
+       (incf column)
+       (push cur-char lexem-l)
+       (setf cur-char (read-char stream nil))
+       (cond ((or (ch= cur-char #\()
+                  (ch= cur-char #\))
+                  (ch= cur-char #\')
+                  (ch= cur-char #\")
+                  (ch= cur-char #\;)
+                  (is-whitespace? cur-char)
+                  (null cur-char))
+              (go ERROR_LEXEM_OUT))
+             (t (go ERROR_LEXEM)))
+     ERROR_LEXEM_OUT
+       (push (make-lexem (coerce (reverse lexem-l) 'string)
+                         cur-lexem-line
+                         cur-lexem-column
+                         :error-lexem
+                         :id (incf *cur-id*))
+             lexems)
+       (setf lexem-l nil)
+       (push (make-instance
+              'lexem-error
+              :error-text (format nil "At (~S:~S) error lexem" cur-lexem-line cur-lexem-column)
+              :error-lex-id *cur-id*)
+             lex-errors)
+       (go COMMON)
      END
        (return))
     (values (reverse lexems)