LilyPond-Ruby 0.0.2.1 → 0.1.2

data/share/guile/2.2/language/elisp/falias.scm

@@ -0,0 +1,47 @@
+;;; Guile Emacs Lisp
+
+;; Copyright (C) 2011, 2017 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 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
+
+;;; Code:
+
+(define-module (language elisp falias)
+  #:export (falias?
+            make-falias
+            falias-function
+            falias-object))
+
+(define <falias-vtable>
+  (make-struct/no-tail
+   <applicable-struct-vtable>
+   (make-struct-layout "pwpw")
+   (lambda (object port)
+     (format port "#<falias ~S>" (falias-object object)))))
+
+(set-struct-vtable-name! <falias-vtable> 'falias)
+
+(define (falias? object)
+  (and (struct? object)
+       (eq? (struct-vtable object) <falias-vtable>)))
+
+(define (make-falias f object)
+  (make-struct/no-tail <falias-vtable> f object))
+
+(define (falias-function object)
+  (struct-ref object 0))
+
+(define (falias-object object)
+  (struct-ref object 1))

data/share/guile/2.2/language/elisp/lexer.scm

@@ -0,0 +1,430 @@
+;;; Guile Emacs Lisp
+
+;;; Copyright (C) 2009, 2010, 2013 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 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
+
+;;; Code:
+
+(define-module (language elisp lexer)
+  #: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.
+;;;
+;;; 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).
+
+(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.
+
+(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.
+
+(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?.
+
+(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.
+
+(define (add-control chr)
+  (let ((real (real-character chr)))
+    (if (char-alphabetic? real)
+        (- (char->integer (char-upcase real)) (char->integer #\@))
+        (case real
+          ((#\?) 127)
+          ((#\@) 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.
+
+(define (charcode-escape port base digits early-return)
+  (let iterate ((result 0)
+                (procdigs 0))
+    (if (and digits (>= procdigs digits))
+        result
+        (let* ((cur (read-char port))
+               (value (cond
+                       ((char-numeric? cur)
+                        (- (char->integer cur) (char->integer #\0)))
+                       ((char-alphabetic? cur)
+                        (let ((code (- (char->integer (char-upcase cur))
+                                       (char->integer #\A))))
+                          (if (< code 0)
+                              #f
+                              (+ code 10))))
+                       (else #f)))
+               (valid (and value (< value base))))
+          (if (not valid)
+              (if (or (not digits) early-return)
+                  (begin
+                    (unread-char cur port)
+                    result)
+                  (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.
+
+(define basic-escape-codes
+  '((#\a . 7)
+    (#\b . 8)
+    (#\t . 9)
+    (#\n . 10)
+    (#\v . 11)
+    (#\f . 12)
+    (#\r . 13)
+    (#\e . 27)
+    (#\s . 32)
+    (#\d . 127)))
+
+(define (get-character port in-string)
+  (let ((meta-bits `((#\A . 22)
+                     (#\s . 23)
+                     (#\H . 24)
+                     (#\S . 25)
+                     (#\M . ,(if in-string 7 27))))
+        (cur (read-char port)))
+    (if (char=? cur #\\)
+        ;; 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.
+           ((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?
+           (esc-code esc-code)
+           ;; 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.
+           (else
+            (case escaped
+              ((#\^) (add-control (get-character port in-string)))
+              ((#\C)
+               (if (is-char? (peek-char port) #\-)
+                   (begin
+                     (if (not (char=? (read-char port) #\-))
+                         (error "expected - after control sequence"))
+                     (add-control (get-character port in-string)))
+                   escaped))
+              ((#\x) (charcode-escape port 16 #f #t))
+              ((#\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!
+        (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.
+
+(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.
+
+(define no-escape-punctuation (string->char-set "-+=*/_~!@$%^&:<>{}?."))
+
+(define (get-symbol-or-number port)
+  (let iterate ((result-chars '())
+                (had-escape #f))
+    (let* ((c (read-char port))
+           (finish (lambda ()
+                     (let ((result (list->string
+                                    (reverse result-chars))))
+                       (values
+                        (cond
+                         ((and (not had-escape)
+                               (regexp-exec integer-regex result))
+                          'integer)
+                         ((and (not had-escape)
+                               (regexp-exec float-regex result))
+                          'float)
+                         (else 'symbol))
+                        result))))
+           (need-no-escape? (lambda (c)
+                              (or (char-numeric? c)
+                                  (char-alphabetic? c)
+                                  (char-set-contains?
+                                   no-escape-punctuation
+                                   c)))))
+      (cond
+       ((eof-object? c) (finish))
+       ((need-no-escape? c) (iterate (cons c result-chars) had-escape))
+       ((char=? c #\\) (iterate (cons (read-char port) result-chars) #t))
+       (else
+        (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 #.
+
+(define (get-circular-marker port)
+  (call-with-values
+      (lambda ()
+        (let iterate ((result 0))
+          (let ((cur (read-char port)))
+            (if (char-numeric? cur)
+                (let ((val (- (char->integer cur) (char->integer #\0))))
+                  (iterate (+ (* result 10) val)))
+                (values result cur)))))
+    (lambda (id type)
+      (case type
+        ((#\#) `(circular-ref . ,id))
+        ((#\=) `(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.
+
+(define lexical-binding-regexp
+  (make-regexp
+   "-\\*-(|.*;)[ \t]*lexical-binding:[ \t]*([^;]*[^ \t;]).*-\\*-"))
+
+(define (lex port)
+  (define (lexical-binding-value string)
+    (and=> (regexp-exec lexical-binding-regexp string)
+           (lambda (match)
+             (not (member (match:substring match 2) '("nil" "()"))))))
+  (let* ((return (let ((file (if (file-port? port)
+                                 (port-filename port)
+                                 #f))
+                       (line (1+ (port-line port)))
+                       (column (1+ (port-column port))))
+                   (lambda (token value)
+                     (let ((obj (cons token value)))
+                       (set-source-property! obj 'filename file)
+                       (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.
+         (c (read-char port)))
+    (cond
+     ;; End of input must be specially marked to the parser.
+     ((eof-object? c) (return 'eof c))
+     ;; 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.
+     ((and (char=? c #\.)
+           (char-whitespace? (peek-char port)))
+      (return 'dot #f))
+     ;; Continue checking for literal character values.
+     (else
+      (case c
+        ;; A line comment, skip until end-of-line is found.
+        ((#\;)
+         (if (= (port-line port) 0)
+             (let iterate ((chars '()))
+               (let ((cur (read-char port)))
+                 (if (or (eof-object? cur) (char=? cur #\newline))
+                     (let ((string (list->string (reverse chars))))
+                       (return 'set-lexical-binding-mode!
+                               (lexical-binding-value string)))
+                     (iterate (cons cur chars)))))
+             (let iterate ()
+               (let ((cur (read-char port)))
+                 (if (or (eof-object? cur) (char=? cur #\newline))
+                     (lex port)
+                     (iterate))))))
+        ;; 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.
+        ((#\")
+         (let iterate ((result-chars '()))
+           (let ((cur (read-char port)))
+             (case cur
+               ((#\")
+                (return 'string (list->string (reverse result-chars))))
+               ((#\\)
+                (let ((escaped (read-char port)))
+                  (case escaped
+                    ((#\newline #\space)
+                     (iterate result-chars))
+                    (else
+                     (unread-char escaped port)
+                     (unread-char cur port)
+                     (iterate
+                      (cons (integer->char (get-character port #t))
+                            result-chars))))))
+               (else (iterate (cons cur result-chars)))))))
+        ((#\#)
+         (let ((c (read-char port)))
+          (case c
+            ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+             (unread-char c port)
+             (let ((mark (get-circular-marker port)))
+               (return (car mark) (cdr mark))))
+            ((#\')
+             (return 'function #f))
+            ((#\:)
+             (call-with-values
+                 (lambda () (get-symbol-or-number port))
+               (lambda (type str)
+                 (return 'symbol (make-symbol str))))))))
+        ;; 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.
+        ((#\,)
+         (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.
+        (else
+         (unread-char c port)
+         (call-with-values
+             (lambda () (get-symbol-or-number port))
+           (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.
+                (if (zero? (string-length str))
+                    (begin
+                      ;; 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!
+                (return
+                 'integer
+                 (let ((num (inexact->exact (string->number str))))
+                   (if (not (integer? num))
+                       (error "expected integer" str num))
+                   num)))
+               ((float)
+                (return 'float (let ((num (string->number str)))
+                                 (if (exact? num)
+                                     (error "expected inexact float"
+                                            str
+                                            num))
+                                 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.
+
+(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.
+
+(define (get-lexer/1 port)
+  (let ((lex (get-lexer port))
+        (finished #f)
+        (paren-level 0))
+    (lambda ()
+      (if finished
+          (cons 'eof ((@ (ice-9 binary-ports) eof-object)))
+          (let ((next (lex))
+                (quotation #f))
+            (case (car next)
+              ((paren-open square-open)
+               (set! paren-level (1+ paren-level)))
+              ((paren-close square-close)
+               (set! paren-level (1- paren-level)))
+              ((quote backquote unquote unquote-splicing circular-def)
+               (set! quotation #t)))
+            (if (and (not quotation) (<= paren-level 0))
+                (set! finished #t))
+            next)))))

data/share/guile/2.2/language/elisp/parser.scm

@@ -0,0 +1,222 @@
+;;; Guile Emacs Lisp
+
+;;; Copyright (C) 2009, 2010 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 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
+
+;;; Code:
+
+(define-module (language elisp parser)
+  #:use-module (language elisp lexer)
+  #:export (read-elisp))
+
+;;; The parser (reader) for elisp expressions.
+;;;
+;;; It is hand-written (just as the lexer is) instead of using some
+;;; parser generator because this allows easier transfer of source
+;;; properties from the lexer ((text parse-lalr) seems not to allow
+;;; access to the original lexer token-pair) and is easy enough anyways.
+
+;;; Report a parse error.  The first argument is some current lexer
+;;; token where source information is available should it be useful.
+
+(define (parse-error token msg . args)
+  (apply error msg args))
+
+;;; For parsing circular structures, we keep track of definitions in a
+;;; hash-map that maps the id's to their values.  When defining a new
+;;; id, though, we immediatly fill the slot with a promise before
+;;; parsing and setting the real value, because it must already be
+;;; available at that time in case of a circular reference.  The promise
+;;; refers to a local variable that will be set when the real value is
+;;; available through a closure.  After parsing the expression is
+;;; completed, we work through it again and force all promises we find.
+;;; The definitions themselves are stored in a fluid and their scope is
+;;; one call to read-elisp (but not only the currently parsed
+;;; expression!).
+
+(define circular-definitions (make-fluid))
+
+(define (make-circular-definitions)
+  (make-hash-table))
+
+(define (circular-ref token)
+  (if (not (eq? (car token) 'circular-ref))
+      (error "invalid token for circular-ref" token))
+  (let* ((id (cdr token))
+         (value (hashq-ref (fluid-ref circular-definitions) id)))
+    (if value
+        value
+        (parse-error token "undefined circular reference" id))))
+
+;;; Returned is a closure that, when invoked, will set the final value.
+;;; This means both the variable the promise will return and the
+;;; hash-table slot so we don't generate promises any longer.
+
+(define (circular-define! token)
+  (if (not (eq? (car token) 'circular-def))
+      (error "invalid token for circular-define!" token))
+  (let ((value #f)
+        (table (fluid-ref circular-definitions))
+        (id (cdr token)))
+    (hashq-set! table id (delay value))
+    (lambda (real-value)
+      (set! value real-value)
+      (hashq-set! table id real-value))))
+
+;;; Work through a parsed data structure and force the promises there.
+;;; After a promise is forced, the resulting value must not be recursed
+;;; on; this may lead to infinite recursion with a circular structure,
+;;; and additionally this value was already processed when it was
+;;; defined.  All deep data structures that can be parsed must be
+;;; handled here!
+
+(define (force-promises! data)
+  (cond
+   ((pair? data)
+    (begin
+      (if (promise? (car data))
+          (set-car! data (force (car data)))
+          (force-promises! (car data)))
+      (if (promise? (cdr data))
+          (set-cdr! data (force (cdr data)))
+          (force-promises! (cdr data)))))
+   ((vector? data)
+    (let ((len (vector-length data)))
+      (let iterate ((i 0))
+        (if (< i len)
+            (let ((el (vector-ref data i)))
+              (if (promise? el)
+                  (vector-set! data i (force el))
+                  (force-promises! el))
+              (iterate (1+ i)))))))
+   ;; Else nothing needs to be done.
+   ))
+
+;;; We need peek-functionality for the next lexer token, this is done
+;;; with some single token look-ahead storage.  This is handled by a
+;;; closure which allows getting or peeking the next token.  When one
+;;; expression is fully parsed, we don't want a look-ahead stored here
+;;; because it would miss from future parsing.  This is verified by the
+;;; finish action.
+
+(define (make-lexer-buffer lex)
+  (let ((look-ahead #f))
+    (lambda (action)
+      (if (eq? action 'finish)
+          (if look-ahead
+              (error "lexer-buffer is not empty when finished")
+              #f)
+          (begin
+            (if (not look-ahead)
+                (set! look-ahead (lex)))
+            (case action
+              ((peek) look-ahead)
+              ((get)
+               (let ((result look-ahead))
+                 (set! look-ahead #f)
+                 result))
+              (else (error "invalid lexer-buffer action" action))))))))
+
+;;; Get the contents of a list, where the opening parentheses has
+;;; already been found.  The same code is used for vectors and lists,
+;;; where lists allow the dotted tail syntax and vectors not;
+;;; additionally, the closing parenthesis must of course match.  The
+;;; implementation here is not tail-recursive, but I think it is clearer
+;;; and simpler this way.
+
+(define (get-list lex allow-dot close-square)
+  (let* ((next (lex 'peek))
+         (type (car next)))
+    (cond
+     ((eq? type (if close-square 'square-close 'paren-close))
+      (begin
+        (if (not (eq? (car (lex 'get)) type))
+            (error "got different token than peeked"))
+        '()))
+     ((and allow-dot (eq? type 'dot))
+      (begin
+        (if (not (eq? (car (lex 'get)) type))
+            (error "got different token than peeked"))
+        (let ((tail (get-list lex #f close-square)))
+          (if (not (= (length tail) 1))
+              (parse-error next
+                           "expected exactly one element after dot"))
+          (car tail))))
+     (else
+      ;; Do both parses in exactly this sequence!
+      (let* ((head (get-expression lex))
+             (tail (get-list lex allow-dot close-square)))
+        (cons head tail))))))
+
+;;; Parse a single expression from a lexer-buffer.  This is the main
+;;; routine in our recursive-descent parser.
+
+(define quotation-symbols '((quote . quote)
+                            (backquote . #{`}#)
+                            (unquote . #{,}#)
+                            (unquote-splicing . #{,@}#)))
+
+(define (get-expression lex)
+  (let* ((token (lex 'get))
+         (type (car token))
+         (return (lambda (result)
+                   (if (pair? result)
+                       (set-source-properties!
+                        result
+                        (source-properties token)))
+                   result)))
+    (case type
+      ((eof)
+       (parse-error token "end of file during parsing"))
+      ((integer float symbol character string)
+       (return (cdr token)))
+      ((function)
+       (return `(function ,(get-expression lex))))
+      ((quote backquote unquote unquote-splicing)
+       (return (list (assq-ref quotation-symbols type)
+                     (get-expression lex))))
+      ((paren-open)
+       (return (get-list lex #t #f)))
+      ((square-open)
+       (return (list->vector (get-list lex #f #t))))
+      ((circular-ref)
+       (circular-ref token))
+      ((circular-def)
+       ;; The order of definitions is important!
+       (let* ((setter (circular-define! token))
+              (expr (get-expression lex)))
+         (setter expr)
+         (force-promises! expr)
+         expr))
+      ((set-lexical-binding-mode!)
+       (return `(%set-lexical-binding-mode ,(cdr token))))
+      (else
+       (parse-error token "expected expression, got" token)))))
+
+;;; Define the reader function based on this; build a lexer, a
+;;; lexer-buffer, and then parse a single expression to return.  We also
+;;; define a circular-definitions data structure to use.
+
+(define (read-elisp port)
+  (with-fluids ((circular-definitions (make-circular-definitions)))
+    (let* ((lexer (get-lexer port))
+           (lexbuf (make-lexer-buffer lexer))
+           (next (lexbuf 'peek)))
+      (if (eq? (car next) 'eof)
+          (cdr next)
+          (let ((result (get-expression lexbuf)))
+            (lexbuf 'finish)
+            result)))))