blob: 9f10a03cd80a32fe30c2b51b9e3587949546fec5 (
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
|
(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")
|