blob: 8694aa1acc12a5e780e5f5f4c96bebcfb6b33764 (
plain)
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
(in-package :monkey)
(defparameter *eof* (code-char 0))
(defun eof? (char)
(char= char *eof*))
(defun digit? (char)
(char<= #\0 char #\9))
(defun letter? (char)
(or (char<= #\a char #\z)
(char<= #\A char #\Z)))
(defun whitespace? (char)
(or (char= char #\Space)
(char= char #\Tab)
(char= char #\Newline)
(char= char #\Linefeed)
(char= char #\_)))
(defparameter *lexer-start-pos* -1)
(defclass lexer ()
((input :reader input :initarg :input)
(len :reader len :initarg :length)
(pos :accessor pos :initform *lexer-start-pos*)
(ch :accessor ch)
(peek-ch :accessor peek-ch)))
(defun make-lexer (input-string &optional len)
(let ((l (make-instance 'lexer :input input-string
:length (if (not (null len))
len
(length input-string)))))
(lexer-peek* l)
(lexer-read l)
l))
(defmethod lexer-reset ((l lexer))
(setf (pos l) *lexer-start-pos*)
(lexer-peek* l)
(lexer-read l))
(defmethod lexer-read ((l lexer))
(prog1 (setf (ch l) (peek-ch l))
(incf (pos l))
(lexer-peek* l)))
(defmethod lexer-peek* ((l lexer))
(setf (peek-ch l)
(if (< (+ 1 (pos l)) (len l))
(char (input l) (+ 1 (pos l)))
*eof*)))
(defmethod lexer-peek ((l lexer))
(peek-ch l))
(defmethod skip-ws ((l lexer))
(loop :while (whitespace? (ch l))
:do (lexer-read l)))
(defmethod next-token ((l lexer))
(skip-ws l)
(block nil
(prog1 (case (ch l)
(#\= (cond ((char= #\= (lexer-peek l))
(lexer-read l)
(make-token :t/== "=="))
(t ;;(whitespace? (lexer-peek l))
(make-token :t/= (ch l)))))
(#\+ (make-token :t/+ (ch l)))
(#\- (make-token :t/- (ch l)))
(#\! (cond ((char= #\= (lexer-peek l))
(lexer-read l)
(make-token :t/!= "!="))
(t ;; (whitespace? (lexer-peek l))
(make-token :t/! (ch l)))))
(#\/ (make-token :t// (ch l)))
(#\* (make-token :t/* (ch l)))
(#\< (make-token :t/< (ch l)))
(#\> (make-token :t/> (ch l)))
(#\; (make-token :t/semicolon (ch l)))
(#\, (make-token :t/comma (ch l)))
(#\( (make-token :t/lparen (ch l)))
(#\) (make-token :t/rparen (ch l)))
(#\{ (make-token :t/lbrace (ch l)))
(#\} (make-token :t/rbrace (ch l)))
(otherwise (cond ((eof? (ch l))
(make-token :t/eof ""))
((letter? (ch l))
(let ((literal (read-identifier l)))
(return (make-token (lookup-identifier literal)
literal))))
((digit? (ch l))
(return (make-token :t/int (read-number l))))
(t (make-token :t/illegal "ILLEGAL")))))
(lexer-read l))))
(defmethod read-number ((l lexer))
(let ((start (pos l)))
(lexer-read l)
(loop :while (digit? (ch l))
:do (lexer-read l))
(make-string-view (input l) start (pos l))))
(defmethod read-identifier ((l lexer))
(let ((start (pos l)))
(lexer-read l)
(loop :while (letter? (ch l))
:do (lexer-read l))
(make-string-view (input l) start (pos l))))
(defmethod lexer-tokens ((l lexer))
(loop :for token := (next-token l)
:collect token
:until (eq :t/eof (_type token))))
|