diff options
author | Brian Templeton <bpt@hcoop.net> | 2010-06-07 16:38:23 -0400 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-12-07 13:21:01 +0100 |
commit | f4e5e4114dad35276355470aa4096af3ec0b7d1c (patch) | |
tree | 23ecabfadb13573315b65c6c935e848d7c86b1fe /module/language/elisp/parser.scm | |
parent | c983a199d8a941d7183e10b7a1d1ecb2e3ede837 (diff) | |
download | guile-f4e5e4114dad35276355470aa4096af3ec0b7d1c.tar.gz |
reindent
* 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/spec.scm: Reindent.
Signed-off-by: Andy Wingo <wingo@pobox.com>
Diffstat (limited to 'module/language/elisp/parser.scm')
-rw-r--r-- | module/language/elisp/parser.scm | 118 |
1 files changed, 61 insertions, 57 deletions
diff --git a/module/language/elisp/parser.scm b/module/language/elisp/parser.scm index b434465d7..3436abf22 100644 --- a/module/language/elisp/parser.scm +++ b/module/language/elisp/parser.scm @@ -54,12 +54,12 @@ (define (circular-ref token) (if (not (eq? (car token) 'circular-ref)) - (error "invalid token for circular-ref" token)) + (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)))) + 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 @@ -67,7 +67,7 @@ (define (circular-define! token) (if (not (eq? (car token) 'circular-def)) - (error "invalid token for circular-define!" token)) + (error "invalid token for circular-define!" token)) (let ((value #f) (table (fluid-ref circular-definitions)) (id (cdr token))) @@ -85,25 +85,25 @@ (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. - )) + ((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 @@ -116,19 +116,19 @@ (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)))))))) + (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, @@ -141,24 +141,25 @@ (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)))))) + ((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. @@ -173,13 +174,16 @@ (type (car token)) (return (lambda (result) (if (pair? result) - (set-source-properties! result (source-properties token))) + (set-source-properties! + result + (source-properties token))) result))) (case type ((integer float symbol character string) (return (cdr token))) ((quote backquote unquote unquote-splicing) - (return (list (assq-ref quotation-symbols type) (get-expression lex)))) + (return (list (assq-ref quotation-symbols type) + (get-expression lex)))) ((paren-open) (return (get-list lex #t #f))) ((square-open) @@ -194,7 +198,7 @@ (force-promises! expr) expr)) (else - (parse-error token "expected expression, got" token))))) + (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 |