(defpackage #:lex
  (:use #:openlisp)
  (:export
   #:<lint>
   #:<lsymbol>
   #:<lstring>
   #:<lend>))
(in-package #:lex)

(defclass <lexeme> () () (:abstractp t))
(defclass <lint> (<lexeme>) ((int :reader int)))
(defclass <lident> (<lexeme>) ((ident :reader ident)))
(defclass <lsymbol> (<lexeme>) ((lsymbol :reader lsymbol)))
(defclass <lstring> (<lexeme>) ((lstring :reader lstring)))
(defclass <lend> (<lexeme>) ())

(defclass <string-lexer> () ((string :initarg s :accessor string)
                             (current :initform 0 :accessor current)
                             (size :accessor size)))

(defmethod initialize-object :after ((self <string-lexer>) initargs)
   (setf (size self) (length (str self))))

(defgeneric forward (cl &rest args))
(defmethod forward ((cl <string-lexer>) &rest args)
   (let ((incr (if (null args)
                   1
                   (car args))))
        (setf (curr cl) (+ (curr cl) incr))))

(defgeneric extract (pred cl))
(defmethod extract (pred (cl <string-lexer>))
   (let* ((st (string cl))
          (pos (current cl))
          (ext (lambda (n)
                  (if (and (< n (size cl)) (pred (elt st n)))
                      (ext (+ n 1))
                      n)))
          (res (ext pos)))
         (setf (current cl) res)
         (subseq (string cl) pos (- res pos))))

(defgeneric extract-int (cl))
(defmethod extract-int ((cl <string-lexer>))
   (flet ((is-int (x)
             (and (char>= x #\0) (char<= x #\9))))
      (convert (extract is-int cl) <number>)))

(defgeneric extract-ident (cl))
(defmethod extract-ident ((cl <string-lexer>))
   (flet ((is-alpha-num (x)
             (or (and (char>= x #\a) (char<= x #\z))
                 (and (char>= x #\A) (char<= x #\Z))
                 (and (char>= x #\0) (char<= x #\9))
                 (char= x #\_))))
      (extract is-alpha-num)))
(provide "lex")