diff options
author | Andy Wingo <wingo@pobox.com> | 2010-12-18 12:32:14 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-12-18 12:32:14 +0100 |
commit | 098e6fc63f8b401a3292b92fd56a040ed9af767a (patch) | |
tree | d646746d0ae6082036d2efb37098d67195e644b1 | |
parent | f02f8a617468c7c66c0b5106299a05cc3d027376 (diff) | |
download | guile-098e6fc63f8b401a3292b92fd56a040ed9af767a.tar.gz |
more format cleanups
* module/ice-9/format.scm (format): Remove the need to save a copy of
the incoming arguments, because they are available as local
variables. Do the check early for the format-string actually being a
string.
-rw-r--r-- | module/ice-9/format.scm | 46 |
1 files changed, 21 insertions, 25 deletions
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm index cd784713e..27a7f459f 100644 --- a/module/ice-9/format.scm +++ b/module/ice-9/format.scm @@ -44,13 +44,12 @@ ;;; End of configuration ---------------------------------------------------- -(define (format destination format-string . args) +(define (format destination format-string . format-args) (define format:version "3.0") (define format:port #f) ; curr. format output port (define format:output-col 0) ; curr. format output tty column (define format:flush-output #f) ; flush output at end of formatting (define format:case-conversion #f) - (define format:args #f) (define format:pos 0) ; curr. format string parsing position (define format:arg-pos 0) ; curr. format argument position ; this is global for error presentation @@ -96,26 +95,19 @@ ;; format's user error handler (define (format:error . args) ; never returns! - (let ((format-args format:args) - (port (current-error-port))) + (let ((port (current-error-port))) (set! format:error format:intern-error) - (if (and (>= (length format:args) 2) - (string? (cadr format:args))) - (let ((format-string (cadr format-args))) - (if (not (zero? format:arg-pos)) - (set! format:arg-pos (- format:arg-pos 1))) - (format port - "~%FORMAT: error with call: (format ~a \"~a<===~a\" ~ + (if (not (zero? format:arg-pos)) + (set! format:arg-pos (- format:arg-pos 1))) + (format port + "~%FORMAT: error with call: (format ~a \"~a<===~a\" ~ ~{~a ~}===>~{~a ~})~% " - (car format:args) - (substring format-string 0 format:pos) - (substring format-string format:pos - (string-length format-string)) - (list-head (cddr format:args) format:arg-pos) - (list-tail (cddr format:args) format:arg-pos))) - (format port - "~%FORMAT: error with call: (format~{ ~a~})~% " - format:args)) + destination + (substring format-string 0 format:pos) + (substring format-string format:pos + (string-length format-string)) + (list-head format-args format:arg-pos) + (list-tail format-args format:arg-pos)) (apply format port args) (newline port) (set! format:error format:error-save) @@ -124,7 +116,9 @@ (define (format:intern-error . args) ;;if something goes wrong in format:error (display "FORMAT: INTERNAL ERROR IN FORMAT:ERROR!") (newline) - (display " format args: ") (write format:args) (newline) + (display " destination: ") (write destination) (newline) + (display " format string: ") (write format-string) (newline) + (display " format args: ") (write format-args) (newline) (display " error args: ") (write args) (newline) (set! format:error format:error-save) (format:abort)) @@ -1606,10 +1600,12 @@ (set! format:fn-str (make-string format:fn-max)) ; number buffer (set! format:en-str (make-string format:en-max)) ; exponent buffer - (set! format:args (cons* destination format-string args)) (set! format:arg-pos 0) (set! format:pos 0) + (if (not (string? format-string)) + (error "format: expected a string for format string" format-string)) + (cond ((or (and (boolean? destination) ; port output destination) @@ -1618,16 +1614,16 @@ ((boolean? destination) (current-output-port)) ((output-port? destination) destination) ((number? destination) (current-error-port))) - format-string args)) + format-string format-args)) ((number? destination) (issue-deprecation-warning "Passing a number to format as the port is deprecated." "Pass (current-error-port) instead.") - (format:out (current-error-port) format-string args)) + (format:out (current-error-port) format-string format-args)) ((and (boolean? destination) ; string output (not destination)) (call-with-output-string - (lambda (port) (format:out port format-string args)))) + (lambda (port) (format:out port format-string format-args)))) (else (format:error "bad destination `~a'" destination)))) |