summaryrefslogtreecommitdiff
path: root/module/language/elisp/parser.scm
diff options
context:
space:
mode:
authorBrian Templeton <bpt@hcoop.net>2010-06-07 16:38:23 -0400
committerAndy Wingo <wingo@pobox.com>2010-12-07 13:21:01 +0100
commitf4e5e4114dad35276355470aa4096af3ec0b7d1c (patch)
tree23ecabfadb13573315b65c6c935e848d7c86b1fe /module/language/elisp/parser.scm
parentc983a199d8a941d7183e10b7a1d1ecb2e3ede837 (diff)
downloadguile-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.scm118
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