(defpackage #:clex
  (:use #:common-lisp #:cutil)
  (:export
   #:<lint>
   #:<lsymbol>
   #:<lstring>
   #:<lend>))
(in-package #:clex)

(defclass <lexeme> () () (:metaclass <abstract-class>))
(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> () ((lstring :initarg :s :accessor lstring)
                             (current :initform 0 :accessor current)
                             (size :accessor size)))

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

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

(defgeneric extract (pred cl))
(defmethod extract (pred (cl <string-lexer>))
   (let* ((st (lstring cl))
          (pos (current cl))
          (res nil))
     (labels ((ext (n)
		(if (and (< n (size cl)) (funcall pred (elt st n)))
                    (ext (+ n 1))
                    n)))
       (setq res (ext pos))
       (setf (current cl) res)
       (subseq (lstring 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))))
    (parse-integer (extract #'is-int cl))))

(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 cl)))
(provide "clex")