blob: cdd602552dd8b68b1b3f779f11e527c3538ff4f0 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
(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")
|