blob: 3ce6aaa03b6808e3c56ef97a3f038c978b1e7b1c (
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 #:util)
(: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>) ((symbol :reader symbol)))
(defclass <lstring> (<lexeme>) ((string :reader string)))
(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>))
;; TODO: flet?
(let ((is-int (lambda (x)
(and (char>= x #\0) (char<= x #\9)))))
(convert (extract is-int cl) <number>)))
(defgeneric extract-ident (cl))
(defmethod extract-ident ((cl <string-lexer>))
(let ((is-alpha-num (lambda (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 "clex")
|