(defclass token()
  ((typ :initarg :typ
        :accessor typ)
   (val :initarg :val
        :accessor val)
   (pos :initarg :pos
        :accessor pos)))

(defun make-token (typ v p)
  (make-instance 'token :typ typ :val v :pos p))

(defclass scanner()
  ((source :initform "left(99); stop.")
   (ht :initform (make-hash-table :test #'equal)
       :reader ht)))

(defun make-scanner()
  (let ((sc (make-instance 'scanner)))
    (setf (gethash "left" (ht sc)) t)
    (setf (gethash "right" (ht sc)) t)
    (setf (gethash "up" (ht sc)) t)
    (setf (gethash "down" (ht sc)) t)
    (setf (gethash "stop" (ht sc)) t)
    sc))

(defmethod scan ((sc scanner) state pos tsf lexem)
  (with-slots (source ht) sc
    (if (= pos (length source))
        (reverse tsf)
      (let ((c (char source pos)))
        (case state
          (0 (cond ((char= c #\() (scan sc 0 (1+ pos) (cons (make-token '<brin> nil pos) tsf) ""))
                   ((char= c #\)) (scan sc 0 (1+ pos) (cons (make-token '<brout> nil pos) tsf) ""))
                   ((char= c #\;) (scan sc 0 (1+ pos) (cons (make-token '<semi> nil pos) tsf) ""))
                   ((char= c #\.) (scan sc 0 (1+ pos) (cons (make-token '<dot> nil pos) tsf) ""))
                   ((char= c #\space) (scan sc 0 (1+ pos) tsf ""))
                   ((alpha-char-p c) (scan sc 1 (1+ pos) tsf (format nil "~A~A" lexem c)))
                   ((member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
                    (scan sc 2 (1+ pos) tsf (format nil "~A~A" lexem c)))
                   (t (error "Wrong character!"))))
          (1 (if (alpha-char-p c)
                 (scan sc 1 (1+ pos) tsf (format nil "~A~A" lexem c))
               (if (gethash lexem ht)
                   (scan sc 0 pos (cons (make-token '<keyword> lexem (- pos (length lexem))) tsf) "")
                 (error "Wrong keyword!"))))
          (2 (if (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
                 (scan sc 2 (1+ pos) tsf (format nil "~A~A" lexem c))
               (scan sc 0 pos (cons (make-token '<number> lexem (- pos (length lexem))) tsf) ""))))))))

(defmethod parse (tkl state lexem)
  (if (null tkl)
      t
    (let ((c (car tkl)))
    (case state
      (0 (if (eql (typ c) '<KEYWORD>)
             (parse (cdr tkl) 1 (val c))
           (error "Syntax Error")))
      (1 (cond ((AND (not (equal lexem "stop"))
                     (eql (typ c) '<BRIN>))
                (parse (cdr tkl) 2 ""))
               ((AND (equal lexem "STOP")
                     (eql (typ c) '<DOT>))
                (parse nil state lexem))
               (t (error "Syntax Error"))))
      (2 (cond ((eql (typ c) '<NUMBER>) (parse (cdr tkl) 3 ""))
               (t (error "Syntax Error"))))
      (3 (cond ((AND (eql (typ c) '<BROUT>) (eql (Typ (second tkl)) '<SEMI>))
                (parse (cddr tkl) 0 ""))
               (t (error "Syntax Error"))))))))