3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program; see the file COPYING. If not, write to
17 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18 ;; Boston, MA 02111-1307, USA.
22 (define-module (language elisp lexer)
23 #:use-module (ice-9 regex)
24 #:export (get-lexer get-lexer/1))
26 ; This is the lexical analyzer for the elisp reader. It is hand-written
27 ; instead of using some generator. I think this is the best solution
28 ; because of all that fancy escape sequence handling and the like.
30 ; Characters are handled internally as integers representing their
31 ; code value. This is necessary because elisp allows a lot of fancy modifiers
32 ; that set certain high-range bits and the resulting values would not fit
33 ; into a real Scheme character range. Additionally, elisp wants characters
34 ; as integers, so we just do the right thing...
36 ; TODO: Circular syntax markers like #1= or #1#
37 ; TODO: #@count comments
40 ; Report an error from the lexer (that is, invalid input given).
42 (define (lexer-error port msg . args)
43 (apply error msg args))
46 ; In a character, set a given bit. This is just some bit-wise or'ing on the
47 ; characters integer code and converting back to character.
49 (define (set-char-bit chr bit)
50 (logior chr (ash 1 bit)))
53 ; Check if a character equals some other. This is just like char=? except that
54 ; the tested one could be EOF in which case it simply isn't equal.
56 (define (is-char? tested should-be)
57 (and (not (eof-object? tested))
58 (char=? tested should-be)))
61 ; For a character (as integer code), find the real character it represents or
62 ; #\nul if out of range. This is used to work with Scheme character functions
65 (define (real-character chr)
71 ; Return the control modified version of a character. This is not just setting
72 ; a modifier bit, because ASCII conrol characters must be handled as such, and
73 ; in elisp C-? is the delete character for historical reasons.
74 ; Otherwise, we set bit 26.
76 (define (add-control chr)
77 (let ((real (real-character chr)))
78 (if (char-alphabetic? real)
79 (- (char->integer (char-upcase real)) (char->integer #\@))
83 (else (set-char-bit chr 26))))))
86 ; Parse a charcode given in some base, basically octal or hexadecimal are
87 ; needed. A requested number of digits can be given (#f means it does
88 ; not matter and arbitrary many are allowed), and additionally early
89 ; return allowed (if fewer valid digits are found).
90 ; These options are all we need to handle the \u, \U, \x and \ddd (octal digits)
93 (define (charcode-escape port base digits early-return)
94 (let iterate ((result 0)
96 (if (and digits (>= procdigs digits))
98 (let* ((cur (read-char port))
101 (- (char->integer cur) (char->integer #\0)))
102 ((char-alphabetic? cur)
103 (let ((code (- (char->integer (char-upcase cur))
104 (char->integer #\A))))
109 (valid (and value (< value base))))
111 (if (or (not digits) early-return)
113 (unread-char cur port)
115 (lexer-error port "invalid digit in escape-code" base cur))
116 (iterate (+ (* result base) value) (1+ procdigs)))))))
119 ; Read a character and process escape-sequences when necessary. The special
120 ; in-string argument defines if this character is part of a string literal or
121 ; a single character literal, the difference being that in strings the
122 ; meta modifier sets bit 7, while it is bit 27 for characters.
124 (define basic-escape-codes
125 '((#\a . 7) (#\b . 8) (#\t . 9)
126 (#\n . 10) (#\v . 11) (#\f . 12) (#\r . 13)
127 (#\e . 27) (#\s . 32) (#\d . 127)))
129 (define (get-character port in-string)
130 (let ((meta-bits `((#\A . 22) (#\s . 23) (#\H . 24)
131 (#\S . 25) (#\M . ,(if in-string 7 27))))
132 (cur (read-char port)))
135 ; Handle an escape-sequence.
136 (let* ((escaped (read-char port))
137 (esc-code (assq-ref basic-escape-codes escaped))
138 (meta (assq-ref meta-bits escaped)))
141 ; Meta-check must be before esc-code check because \s- must be
142 ; recognized as the super-meta modifier if a - follows.
143 ; If not, it will be caught as \s -> space escape code.
144 ((and meta (is-char? (peek-char port) #\-))
145 (if (not (char=? (read-char port) #\-))
146 (error "expected - after control sequence"))
147 (set-char-bit (get-character port in-string) meta))
149 ; One of the basic control character escape names?
152 ; Handle \ddd octal code if it is one.
153 ((and (char>=? escaped #\0) (char<? escaped #\8))
155 (unread-char escaped port)
156 (charcode-escape port 8 3 #t)))
158 ; Check for some escape-codes directly or otherwise
159 ; use the escaped character literally.
162 ((#\^) (add-control (get-character port in-string)))
164 (if (is-char? (peek-char port) #\-)
166 (if (not (char=? (read-char port) #\-))
167 (error "expected - after control sequence"))
168 (add-control (get-character port in-string)))
170 ((#\x) (charcode-escape port 16 #f #t))
171 ((#\u) (charcode-escape port 16 4 #f))
172 ((#\U) (charcode-escape port 16 8 #f))
173 (else (char->integer escaped))))))
175 ; No escape-sequence, just the literal character.
176 ; But remember to get the code instead!
177 (char->integer cur))))
180 ; Read a symbol or number from a port until something follows that marks the
181 ; start of a new token (like whitespace or parentheses). The data read is
182 ; returned as a string for further conversion to the correct type, but we also
183 ; return what this is (integer/float/symbol).
184 ; If any escaped character is found, it must be a symbol. Otherwise we
185 ; at the end check the result-string against regular expressions to determine
186 ; if it is possibly an integer or a float.
188 (define integer-regex (make-regexp "^[+-]?[0-9]+\\.?$"))
190 (make-regexp "^[+-]?([0-9]+\\.?[0-9]*|[0-9]*\\.?[0-9]+)(e[+-]?[0-9]+)?$"))
192 ; A dot is also allowed literally, only a single dort alone is parsed as the
193 ; 'dot' terminal for dotted lists.
194 (define no-escape-punctuation (string->char-set "-+=*/_~!@$%^&:<>{}?."))
196 (define (get-symbol-or-number port)
197 (let iterate ((result-chars '())
199 (let* ((c (read-char port))
201 (let ((result (list->string (reverse result-chars))))
204 ((and (not had-escape)
205 (regexp-exec integer-regex result))
207 ((and (not had-escape)
208 (regexp-exec float-regex result))
212 (need-no-escape? (lambda (c)
213 (or (char-numeric? c)
215 (char-set-contains? no-escape-punctuation
218 ((eof-object? c) (finish))
219 ((need-no-escape? c) (iterate (cons c result-chars) had-escape))
220 ((char=? c #\\) (iterate (cons (read-char port) result-chars) #t))
226 ; Main lexer routine, which is given a port and does look for the next token.
229 (let ((return (let ((file (if (file-port? port) (port-filename port) #f))
230 (line (1+ (port-line port)))
231 (column (1+ (port-column port))))
232 (lambda (token value)
233 (let ((obj (cons token value)))
234 (set-source-property! obj 'filename file)
235 (set-source-property! obj 'line line)
236 (set-source-property! obj 'column column)
238 ; Read afterwards so the source-properties are correct above
239 ; and actually point to the very character to be read.
240 (c (read-char port)))
243 ; End of input must be specially marked to the parser.
244 ((eof-object? c) '*eoi*)
246 ; Whitespace, just skip it.
247 ((char-whitespace? c) (lex port))
249 ; The dot is only the one for dotted lists if followed by
250 ; whitespace. Otherwise it is considered part of a number of symbol.
252 (char-whitespace? (peek-char port)))
255 ; Continue checking for literal character values.
259 ; A line comment, skip until end-of-line is found.
262 (let ((cur (read-char port)))
263 (if (or (eof-object? cur) (char=? cur #\newline))
267 ; A character literal.
269 (return 'character (get-character port #f)))
271 ; A literal string. This is mainly a sequence of characters just
272 ; as in the character literals, the only difference is that escaped
273 ; newline and space are to be completely ignored and that meta-escapes
274 ; set bit 7 rather than bit 27.
276 (let iterate ((result-chars '()))
277 (let ((cur (read-char port)))
280 (return 'string (list->string (reverse result-chars))))
282 (let ((escaped (read-char port)))
285 (iterate result-chars))
287 (unread-char escaped port)
288 (unread-char cur port)
289 (iterate (cons (integer->char (get-character port #t))
291 (else (iterate (cons cur result-chars)))))))
293 ; Parentheses and other special-meaning single characters.
294 ((#\() (return 'paren-open #f))
295 ((#\)) (return 'paren-close #f))
296 ((#\[) (return 'square-open #f))
297 ((#\]) (return 'square-close #f))
298 ((#\') (return 'quote #f))
299 ((#\`) (return 'backquote #f))
301 ; Unquote and unquote-splicing.
303 (if (is-char? (peek-char port) #\@)
304 (if (not (char=? (read-char port) #\@))
305 (error "expected @ in unquote-splicing")
306 (return 'unquote-splicing #f))
307 (return 'unquote #f)))
309 ; Remaining are numbers and symbols. Process input until next
310 ; whitespace is found, and see if it looks like a number
311 ; (float/integer) or symbol and return accordingly.
316 (get-symbol-or-number port))
320 ; str could be empty if the first character is already
321 ; something not allowed in a symbol (and not escaped)!
322 ; Take care about that, it is an error because that character
323 ; should have been handled elsewhere or is invalid in the
325 (if (zero? (string-length str))
327 ; Take it out so the REPL might not get into an
328 ; infinite loop with further reading attempts.
330 (error "invalid character in input" c))
331 (return 'symbol (string->symbol str))))
333 ; In elisp, something like "1." is an integer, while
334 ; string->number returns an inexact real. Thus we
335 ; need a conversion here, but it should always result in
338 (let ((num (inexact->exact (string->number str))))
339 (if (not (integer? num))
340 (error "expected integer" str num))
343 (return 'float (let ((num (string->number str)))
345 (error "expected inexact float" str num))
347 (else (error "wrong number/symbol type" type)))))))))))
350 ; Build a lexer thunk for a port. This is the exported routine which can be
351 ; used to create a lexer for the parser to use.
353 (define (get-lexer port)
358 ; Build a special lexer that will only read enough for one expression and then
359 ; always return end-of-input.
360 ; If we find one of the quotation stuff, one more expression is needed in any
363 (define (get-lexer/1 port)
364 (let ((lex (get-lexer port))
373 ((paren-open square-open)
374 (set! paren-level (1+ paren-level)))
375 ((paren-close square-close)
376 (set! paren-level (1- paren-level)))
377 ((quote backquote unquote unquote-splicing)
378 (set! quotation #t)))
379 (if (and (not quotation) (<= paren-level 0))