mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

reformat comments

Browse source 
* module/language/elisp/bindings.scm:
* module/language/elisp/compile-tree-il.scm:
* module/language/elisp/lexer.scm:
* module/language/elisp/parser.scm:
* module/language/elisp/runtime.scm:
* module/language/elisp/runtime/function-slot.scm:
* module/language/elisp/runtime/macro-slot.scm:
* module/language/elisp/runtime/value-slot.scm: Reformat comments.
This commit is contained in:
Brian Templeton 2010-06-07 16:38:00 -04:00
parent 372b11fc73
commit 27b9476a8d
8 changed files with 478 additions and 450 deletions
Download patch file Download diff file Expand all files Collapse all files

206
module/language/elisp/lexer.scm
View file

@ -2,19 +2,20 @@
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
@ -22,49 +23,51 @@
#:use-module (ice-9 regex)
#:export (get-lexer get-lexer/1))
; This is the lexical analyzer for the elisp reader. It is hand-written
; instead of using some generator. I think this is the best solution
; because of all that fancy escape sequence handling and the like.
;;; This is the lexical analyzer for the elisp reader. It is
;;; hand-written instead of using some generator. I think this is the
;;; best solution because of all that fancy escape sequence handling and
;;; the like.
;;;
;;; Characters are handled internally as integers representing their
;;; code value. This is necessary because elisp allows a lot of fancy
;;; modifiers that set certain high-range bits and the resulting values
;;; would not fit into a real Scheme character range. Additionally,
;;; elisp wants characters as integers, so we just do the right thing...
;;;
;;; TODO: #@count comments
; Characters are handled internally as integers representing their
; code value. This is necessary because elisp allows a lot of fancy modifiers
; that set certain high-range bits and the resulting values would not fit
; into a real Scheme character range. Additionally, elisp wants characters
; as integers, so we just do the right thing...
; TODO: #@count comments
; Report an error from the lexer (that is, invalid input given).
;;; Report an error from the lexer (that is, invalid input given).
(define (lexer-error port msg . args)
(apply error msg args))
; In a character, set a given bit. This is just some bit-wise or'ing on the
; characters integer code and converting back to character.
;;; In a character, set a given bit. This is just some bit-wise or'ing
;;; on the characters integer code and converting back to character.
(define (set-char-bit chr bit)
(logior chr (ash 1 bit)))
; Check if a character equals some other. This is just like char=? except that
; the tested one could be EOF in which case it simply isn't equal.
;;; Check if a character equals some other. This is just like char=?
;;; except that the tested one could be EOF in which case it simply
;;; isn't equal.
(define (is-char? tested should-be)
(and (not (eof-object? tested))
(char=? tested should-be)))
; For a character (as integer code), find the real character it represents or
; #\nul if out of range. This is used to work with Scheme character functions
; like char-numeric?.
;;; For a character (as integer code), find the real character it
;;; represents or #\nul if out of range. This is used to work with
;;; Scheme character functions like char-numeric?.
(define (real-character chr)
(if (< chr 256)
(integer->char chr)
#\nul))
; Return the control modified version of a character. This is not just setting
; a modifier bit, because ASCII conrol characters must be handled as such, and
; in elisp C-? is the delete character for historical reasons.
; Otherwise, we set bit 26.
;;; Return the control modified version of a character. This is not just
;;; setting a modifier bit, because ASCII conrol characters must be
;;; handled as such, and in elisp C-? is the delete character for
;;; historical reasons. Otherwise, we set bit 26.
(define (add-control chr)
(let ((real (real-character chr)))
@ -75,12 +78,12 @@
((#\@) 0)
(else (set-char-bit chr 26))))))
; Parse a charcode given in some base, basically octal or hexadecimal are
; needed. A requested number of digits can be given (#f means it does
; not matter and arbitrary many are allowed), and additionally early
; return allowed (if fewer valid digits are found).
; These options are all we need to handle the \u, \U, \x and \ddd (octal digits)
; escape sequences.
;;; Parse a charcode given in some base, basically octal or hexadecimal
;;; are needed. A requested number of digits can be given (#f means it
;;; does not matter and arbitrary many are allowed), and additionally
;;; early return allowed (if fewer valid digits are found). These
;;; options are all we need to handle the \u, \U, \x and \ddd (octal
;;; digits) escape sequences.
(define (charcode-escape port base digits early-return)
(let iterate ((result 0)
@ -107,10 +110,11 @@
(lexer-error port "invalid digit in escape-code" base cur))
(iterate (+ (* result base) value) (1+ procdigs)))))))
; Read a character and process escape-sequences when necessary. The special
; in-string argument defines if this character is part of a string literal or
; a single character literal, the difference being that in strings the
; meta modifier sets bit 7, while it is bit 27 for characters.
;;; Read a character and process escape-sequences when necessary. The
;;; special in-string argument defines if this character is part of a
;;; string literal or a single character literal, the difference being
;;; that in strings the meta modifier sets bit 7, while it is bit 27 for
;;; characters.
(define basic-escape-codes
'((#\a . 7) (#\b . 8) (#\t . 9)
@ -122,27 +126,27 @@
(#\S . 25) (#\M . ,(if in-string 7 27))))
(cur (read-char port)))
(if (char=? cur #\\)
; Handle an escape-sequence.
;; Handle an escape-sequence.
(let* ((escaped (read-char port))
(esc-code (assq-ref basic-escape-codes escaped))
(meta (assq-ref meta-bits escaped)))
(cond
; Meta-check must be before esc-code check because \s- must be
; recognized as the super-meta modifier if a - follows.
; If not, it will be caught as \s -> space escape code.
;; Meta-check must be before esc-code check because \s- must
;; be recognized as the super-meta modifier if a - follows. If
;; not, it will be caught as \s -> space escape code.
((and meta (is-char? (peek-char port) #\-))
(if (not (char=? (read-char port) #\-))
(error "expected - after control sequence"))
(set-char-bit (get-character port in-string) meta))
; One of the basic control character escape names?
;; One of the basic control character escape names?
(esc-code esc-code)
; Handle \ddd octal code if it is one.
;; Handle \ddd octal code if it is one.
((and (char>=? escaped #\0) (char<? escaped #\8))
(begin
(unread-char escaped port)
(charcode-escape port 8 3 #t)))
; Check for some escape-codes directly or otherwise
; use the escaped character literally.
;; Check for some escape-codes directly or otherwise use the
;; escaped character literally.
(else
(case escaped
((#\^) (add-control (get-character port in-string)))
@ -157,25 +161,26 @@
((#\u) (charcode-escape port 16 4 #f))
((#\U) (charcode-escape port 16 8 #f))
(else (char->integer escaped))))))
; No escape-sequence, just the literal character.
; But remember to get the code instead!
;; No escape-sequence, just the literal character. But remember to
;; get the code instead!
(char->integer cur))))
; Read a symbol or number from a port until something follows that marks the
; start of a new token (like whitespace or parentheses). The data read is
; returned as a string for further conversion to the correct type, but we also
; return what this is (integer/float/symbol).
; If any escaped character is found, it must be a symbol. Otherwise we
; at the end check the result-string against regular expressions to determine
; if it is possibly an integer or a float.
;;; Read a symbol or number from a port until something follows that
;;; marks the start of a new token (like whitespace or parentheses). The
;;; data read is returned as a string for further conversion to the
;;; correct type, but we also return what this is
;;; (integer/float/symbol). If any escaped character is found, it must
;;; be a symbol. Otherwise we at the end check the result-string against
;;; regular expressions to determine if it is possibly an integer or a
;;; float.
(define integer-regex (make-regexp "^[+-]?[0-9]+\\.?$"))
(define float-regex
(make-regexp "^[+-]?([0-9]+\\.?[0-9]*|[0-9]*\\.?[0-9]+)(e[+-]?[0-9]+)?$"))
; A dot is also allowed literally, only a single dort alone is parsed as the
; 'dot' terminal for dotted lists.
;;; A dot is also allowed literally, only a single dort alone is parsed
;;; as the 'dot' terminal for dotted lists.
(define no-escape-punctuation (string->char-set "-+=*/_~!@$%^&:<>{}?."))
@ -208,9 +213,9 @@
(unread-char c port)
(finish))))))
; Parse a circular structure marker without the leading # (which was already
; read and recognized), that is, a number as identifier and then either
; = or #.
;;; Parse a circular structure marker without the leading # (which was
;;; already read and recognized), that is, a number as identifier and
;;; then either = or #.
(define (get-circular-marker port)
(call-with-values
@ -227,7 +232,8 @@
((#\=) `(circular-def . ,id))
(else (lexer-error port "invalid circular marker character" type))))))
; Main lexer routine, which is given a port and does look for the next token.
;;; Main lexer routine, which is given a port and does look for the next
;;; token.
(define (lex port)
(let ((return (let ((file (if (file-port? port) (port-filename port) #f))
@ -239,36 +245,37 @@
(set-source-property! obj 'line line)
(set-source-property! obj 'column column)
obj))))
; Read afterwards so the source-properties are correct above
; and actually point to the very character to be read.
;; Read afterwards so the source-properties are correct above
;; and actually point to the very character to be read.
(c (read-char port)))
(cond
; End of input must be specially marked to the parser.
;; End of input must be specially marked to the parser.
((eof-object? c) '*eoi*)
; Whitespace, just skip it.
;; Whitespace, just skip it.
((char-whitespace? c) (lex port))
; The dot is only the one for dotted lists if followed by
; whitespace. Otherwise it is considered part of a number of symbol.
;; The dot is only the one for dotted lists if followed by
;; whitespace. Otherwise it is considered part of a number of
;; symbol.
((and (char=? c #\.)
(char-whitespace? (peek-char port)))
(return 'dot #f))
; Continue checking for literal character values.
;; Continue checking for literal character values.
(else
(case c
; A line comment, skip until end-of-line is found.
;; A line comment, skip until end-of-line is found.
((#\;)
(let iterate ()
(let ((cur (read-char port)))
(if (or (eof-object? cur) (char=? cur #\newline))
(lex port)
(iterate)))))
; A character literal.
;; A character literal.
((#\?)
(return 'character (get-character port #f)))
; A literal string. This is mainly a sequence of characters just
; as in the character literals, the only difference is that escaped
; newline and space are to be completely ignored and that meta-escapes
; set bit 7 rather than bit 27.
;; A literal string. This is mainly a sequence of characters
;; just as in the character literals, the only difference is
;; that escaped newline and space are to be completely ignored
;; and that meta-escapes set bit 7 rather than bit 27.
((#\")
(let iterate ((result-chars '()))
(let ((cur (read-char port)))
@ -286,27 +293,27 @@
(iterate (cons (integer->char (get-character port #t))
result-chars))))))
(else (iterate (cons cur result-chars)))))))
; Circular markers (either reference or definition).
;; Circular markers (either reference or definition).
((#\#)
(let ((mark (get-circular-marker port)))
(return (car mark) (cdr mark))))
; Parentheses and other special-meaning single characters.
;; Parentheses and other special-meaning single characters.
((#\() (return 'paren-open #f))
((#\)) (return 'paren-close #f))
((#\[) (return 'square-open #f))
((#\]) (return 'square-close #f))
((#\') (return 'quote #f))
((#\`) (return 'backquote #f))
; Unquote and unquote-splicing.
;; Unquote and unquote-splicing.
((#\,)
(if (is-char? (peek-char port) #\@)
(if (not (char=? (read-char port) #\@))
(error "expected @ in unquote-splicing")
(return 'unquote-splicing #f))
(return 'unquote #f)))
; Remaining are numbers and symbols. Process input until next
; whitespace is found, and see if it looks like a number
; (float/integer) or symbol and return accordingly.
;; Remaining are numbers and symbols. Process input until next
;; whitespace is found, and see if it looks like a number
;; (float/integer) or symbol and return accordingly.
(else
(unread-char c port)
(call-with-values
@ -315,23 +322,23 @@
(lambda (type str)
(case type
((symbol)
; str could be empty if the first character is already
; something not allowed in a symbol (and not escaped)!
; Take care about that, it is an error because that character
; should have been handled elsewhere or is invalid in the
; input.
;; str could be empty if the first character is
;; already something not allowed in a symbol (and not
;; escaped)! Take care about that, it is an error
;; because that character should have been handled
;; elsewhere or is invalid in the input.
(if (zero? (string-length str))
(begin
; Take it out so the REPL might not get into an
; infinite loop with further reading attempts.
;; Take it out so the REPL might not get into an
;; infinite loop with further reading attempts.
(read-char port)
(error "invalid character in input" c))
(return 'symbol (string->symbol str))))
((integer)
; In elisp, something like "1." is an integer, while
; string->number returns an inexact real. Thus we
; need a conversion here, but it should always result in
; an integer!
;; In elisp, something like "1." is an integer, while
;; string->number returns an inexact real. Thus we
;; need a conversion here, but it should always
;; result in an integer!
(return 'integer
(let ((num (inexact->exact (string->number str))))
(if (not (integer? num))
@ -344,17 +351,16 @@
num)))
(else (error "wrong number/symbol type" type)))))))))))
; Build a lexer thunk for a port. This is the exported routine which can be
; used to create a lexer for the parser to use.
;;; Build a lexer thunk for a port. This is the exported routine which
;;; can be used to create a lexer for the parser to use.
(define (get-lexer port)
(lambda ()
(lex port)))
; Build a special lexer that will only read enough for one expression and then
; always return end-of-input.
; If we find one of the quotation stuff, one more expression is needed in any
; case.
;;; Build a special lexer that will only read enough for one expression
;;; and then always return end-of-input. If we find one of the quotation
;;; stuff, one more expression is needed in any case.
(define (get-lexer/1 port)
(let ((lex (get-lexer port))