3 ;;; Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc.
5 ;;; This library is free software; you can redistribute it and/or
6 ;;; modify it under the terms of the GNU Lesser General Public
7 ;;; License as published by the Free Software Foundation; either
8 ;;; version 3 of the License, or (at your option) any later version.
10 ;;; This library 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 GNU
13 ;;; Lesser General Public License for more details.
15 ;;; You should have received a copy of the GNU Lesser General Public
16 ;;; License along with this library; if not, write to the Free Software
17 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 (define-module (language elisp lexer)
22 #:use-module (ice-9 regex)
23 #:use-module (language elisp runtime)
24 #:export (get-lexer get-lexer/1))
26 ;;; This is the lexical analyzer for the elisp reader. It is
27 ;;; hand-written instead of using some generator. I think this is the
28 ;;; best solution because of all that fancy escape sequence handling and
31 ;;; Characters are handled internally as integers representing their
32 ;;; code value. This is necessary because elisp allows a lot of fancy
33 ;;; modifiers that set certain high-range bits and the resulting values
34 ;;; would not fit into a real Scheme character range. Additionally,
35 ;;; elisp wants characters as integers, so we just do the right thing...
37 ;;; TODO: #@count comments
39 ;;; Report an error from the lexer (that is, invalid input given).
41 (define (lexer-error port msg . args)
42 (apply error msg args))
44 ;;; In a character, set a given bit. This is just some bit-wise or'ing
45 ;;; on the characters integer code and converting back to character.
47 (define (set-char-bit chr bit)
48 (logior chr (ash 1 bit)))
50 ;;; Check if a character equals some other. This is just like char=?
51 ;;; except that the tested one could be EOF in which case it simply
54 (define (is-char? tested should-be)
55 (and (not (eof-object? tested))
56 (char=? tested should-be)))
58 ;;; For a character (as integer code), find the real character it
59 ;;; represents or #\nul if out of range. This is used to work with
60 ;;; Scheme character functions like char-numeric?.
62 (define (real-character chr)
67 ;;; Return the control modified version of a character. This is not
68 ;;; just setting a modifier bit, because ASCII conrol characters must be
69 ;;; handled as such, and in elisp C-? is the delete character for
70 ;;; historical reasons. Otherwise, we set bit 26.
72 (define (add-control chr)
73 (let ((real (real-character chr)))
74 (if (char-alphabetic? real)
75 (- (char->integer (char-upcase real)) (char->integer #\@))
79 (else (set-char-bit chr 26))))))
81 ;;; Parse a charcode given in some base, basically octal or hexadecimal
82 ;;; are needed. A requested number of digits can be given (#f means it
83 ;;; does not matter and arbitrary many are allowed), and additionally
84 ;;; early return allowed (if fewer valid digits are found). These
85 ;;; options are all we need to handle the \u, \U, \x and \ddd (octal
86 ;;; digits) escape sequences.
88 (define (charcode-escape port base digits early-return)
89 (let iterate ((result 0)
91 (if (and digits (>= procdigs digits))
93 (let* ((cur (read-char port))
96 (- (char->integer cur) (char->integer #\0)))
97 ((char-alphabetic? cur)
98 (let ((code (- (char->integer (char-upcase cur))
99 (char->integer #\A))))
104 (valid (and value (< value base))))
106 (if (or (not digits) early-return)
108 (unread-char cur port)
111 "invalid digit in escape-code"
114 (iterate (+ (* result base) value) (1+ procdigs)))))))
116 ;;; Read a character and process escape-sequences when necessary. The
117 ;;; special in-string argument defines if this character is part of a
118 ;;; string literal or a single character literal, the difference being
119 ;;; that in strings the meta modifier sets bit 7, while it is bit 27 for
122 (define basic-escape-codes
134 (define (get-character port in-string)
135 (let ((meta-bits `((#\A . 22)
139 (#\M . ,(if in-string 7 27))))
140 (cur (read-char port)))
142 ;; Handle an escape-sequence.
143 (let* ((escaped (read-char port))
144 (esc-code (assq-ref basic-escape-codes escaped))
145 (meta (assq-ref meta-bits escaped)))
147 ;; Meta-check must be before esc-code check because \s- must
148 ;; be recognized as the super-meta modifier if a - follows.
149 ;; If not, it will be caught as \s -> space escape code.
150 ((and meta (is-char? (peek-char port) #\-))
151 (if (not (char=? (read-char port) #\-))
152 (error "expected - after control sequence"))
153 (set-char-bit (get-character port in-string) meta))
154 ;; One of the basic control character escape names?
156 ;; Handle \ddd octal code if it is one.
157 ((and (char>=? escaped #\0) (char<? escaped #\8))
159 (unread-char escaped port)
160 (charcode-escape port 8 3 #t)))
161 ;; Check for some escape-codes directly or otherwise use the
162 ;; escaped character literally.
165 ((#\^) (add-control (get-character port in-string)))
167 (if (is-char? (peek-char port) #\-)
169 (if (not (char=? (read-char port) #\-))
170 (error "expected - after control sequence"))
171 (add-control (get-character port in-string)))
173 ((#\x) (charcode-escape port 16 #f #t))
174 ((#\u) (charcode-escape port 16 4 #f))
175 ((#\U) (charcode-escape port 16 8 #f))
176 (else (char->integer escaped))))))
177 ;; No escape-sequence, just the literal character. But remember
178 ;; to get the code instead!
179 (char->integer cur))))
181 ;;; Read a symbol or number from a port until something follows that
182 ;;; marks the start of a new token (like whitespace or parentheses).
183 ;;; The data read is returned as a string for further conversion to the
184 ;;; correct type, but we also return what this is
185 ;;; (integer/float/symbol). If any escaped character is found, it must
186 ;;; be a symbol. Otherwise we at the end check the result-string
187 ;;; against regular expressions to determine if it is possibly an
188 ;;; integer or a float.
190 (define integer-regex (make-regexp "^[+-]?[0-9]+\\.?$"))
194 "^[+-]?([0-9]+\\.?[0-9]*|[0-9]*\\.?[0-9]+)(e[+-]?[0-9]+)?$"))
196 ;;; A dot is also allowed literally, only a single dort alone is parsed
197 ;;; as the 'dot' terminal for dotted lists.
199 (define no-escape-punctuation (string->char-set "-+=*/_~!@$%^&:<>{}?."))
201 (define (get-symbol-or-number port)
202 (let iterate ((result-chars '())
204 (let* ((c (read-char port))
206 (let ((result (list->string
207 (reverse result-chars))))
210 ((and (not had-escape)
211 (regexp-exec integer-regex result))
213 ((and (not had-escape)
214 (regexp-exec float-regex result))
218 (need-no-escape? (lambda (c)
219 (or (char-numeric? c)
222 no-escape-punctuation
225 ((eof-object? c) (finish))
226 ((need-no-escape? c) (iterate (cons c result-chars) had-escape))
227 ((char=? c #\\) (iterate (cons (read-char port) result-chars) #t))
232 ;;; Parse a circular structure marker without the leading # (which was
233 ;;; already read and recognized), that is, a number as identifier and
234 ;;; then either = or #.
236 (define (get-circular-marker port)
239 (let iterate ((result 0))
240 (let ((cur (read-char port)))
241 (if (char-numeric? cur)
242 (let ((val (- (char->integer cur) (char->integer #\0))))
243 (iterate (+ (* result 10) val)))
244 (values result cur)))))
247 ((#\#) `(circular-ref . ,id))
248 ((#\=) `(circular-def . ,id))
249 (else (lexer-error port
250 "invalid circular marker character"
253 ;;; Main lexer routine, which is given a port and does look for the next
256 (define lexical-binding-regexp
258 "-\\*-(|.*;)[ \t]*lexical-binding:[ \t]*([^;]*[^ \t;]).*-\\*-"))
261 (define (lexical-binding-value string)
262 (and=> (regexp-exec lexical-binding-regexp string)
264 (not (member (match:substring match 2) '("nil" "()"))))))
265 (let* ((return (let ((file (if (file-port? port)
268 (line (1+ (port-line port)))
269 (column (1+ (port-column port))))
270 (lambda (token value)
271 (let ((obj (cons token value)))
272 (set-source-property! obj 'filename file)
273 (set-source-property! obj 'line line)
274 (set-source-property! obj 'column column)
276 ;; Read afterwards so the source-properties are correct above
277 ;; and actually point to the very character to be read.
278 (c (read-char port)))
280 ;; End of input must be specially marked to the parser.
281 ((eof-object? c) (return 'eof c))
282 ;; Whitespace, just skip it.
283 ((char-whitespace? c) (lex port))
284 ;; The dot is only the one for dotted lists if followed by
285 ;; whitespace. Otherwise it is considered part of a number of
288 (char-whitespace? (peek-char port)))
290 ;; Continue checking for literal character values.
293 ;; A line comment, skip until end-of-line is found.
295 (if (= (port-line port) 0)
296 (let iterate ((chars '()))
297 (let ((cur (read-char port)))
298 (if (or (eof-object? cur) (char=? cur #\newline))
299 (let ((string (list->string (reverse chars))))
300 (return 'set-lexical-binding-mode!
301 (lexical-binding-value string)))
302 (iterate (cons cur chars)))))
304 (let ((cur (read-char port)))
305 (if (or (eof-object? cur) (char=? cur #\newline))
308 ;; A character literal.
310 (return 'character (get-character port #f)))
311 ;; A literal string. This is mainly a sequence of characters
312 ;; just as in the character literals, the only difference is
313 ;; that escaped newline and space are to be completely ignored
314 ;; and that meta-escapes set bit 7 rather than bit 27.
316 (let iterate ((result-chars '()))
317 (let ((cur (read-char port)))
322 (list->string (reverse result-chars)))))
324 (let ((escaped (read-char port)))
327 (iterate result-chars))
329 (unread-char escaped port)
330 (unread-char cur port)
332 (cons (integer->char (get-character port #t))
334 (else (iterate (cons cur result-chars)))))))
336 (let ((c (read-char port)))
338 ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
340 (let ((mark (get-circular-marker port)))
341 (return (car mark) (cdr mark))))
343 (return 'function #f))
346 (lambda () (get-symbol-or-number port))
348 (return 'symbol (make-symbol str))))))))
349 ;; Parentheses and other special-meaning single characters.
350 ((#\() (return 'paren-open #f))
351 ((#\)) (return 'paren-close #f))
352 ((#\[) (return 'square-open #f))
353 ((#\]) (return 'square-close #f))
354 ((#\') (return 'quote #f))
355 ((#\`) (return 'backquote #f))
356 ;; Unquote and unquote-splicing.
358 (if (is-char? (peek-char port) #\@)
359 (if (not (char=? (read-char port) #\@))
360 (error "expected @ in unquote-splicing")
361 (return 'unquote-splicing #f))
362 (return 'unquote #f)))
363 ;; Remaining are numbers and symbols. Process input until next
364 ;; whitespace is found, and see if it looks like a number
365 ;; (float/integer) or symbol and return accordingly.
369 (lambda () (get-symbol-or-number port))
375 (return 'symbol #nil))
379 ;; str could be empty if the first character is already
380 ;; something not allowed in a symbol (and not escaped)!
381 ;; Take care about that, it is an error because that
382 ;; character should have been handled elsewhere or is
383 ;; invalid in the input.
384 (if (zero? (string-length str))
386 ;; Take it out so the REPL might not get into an
387 ;; infinite loop with further reading attempts.
389 (error "invalid character in input" c))
390 (return 'symbol (string->symbol str))))))
392 ;; In elisp, something like "1." is an integer, while
393 ;; string->number returns an inexact real. Thus we need
394 ;; a conversion here, but it should always result in an
398 (let ((num (inexact->exact (string->number str))))
399 (if (not (integer? num))
400 (error "expected integer" str num))
403 (return 'float (let ((num (string->number str)))
405 (error "expected inexact float"
409 (else (error "wrong number/symbol type" type)))))))))))
411 ;;; Build a lexer thunk for a port. This is the exported routine which
412 ;;; can be used to create a lexer for the parser to use.
414 (define (get-lexer port)
415 (lambda () (lex port)))
417 ;;; Build a special lexer that will only read enough for one expression
418 ;;; and then always return end-of-input. If we find one of the quotation
419 ;;; stuff, one more expression is needed in any case.
421 (define (get-lexer/1 port)
422 (let ((lex (get-lexer port))
427 (cons 'eof ((@ (ice-9 binary-ports) eof-object)))
431 ((paren-open square-open)
432 (set! paren-level (1+ paren-level)))
433 ((paren-close square-close)
434 (set! paren-level (1- paren-level)))
435 ((quote backquote unquote unquote-splicing circular-def)
436 (set! quotation #t)))
437 (if (and (not quotation) (<= paren-level 0))