mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

More format refactors

Browse source 
* module/ice-9/format.scm (format): Flatten all internal definitions,
  except format-work.
This commit is contained in:
Andy Wingo 2019-08-13 22:46:32 +02:00
parent a2aec7157c
commit 687981feeb
1 changed files with 1452 additions and 1451 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/ice-9/format.scm
View file

@ -37,25 +37,25 @@
(define format:version "3.0")
(define (format destination format-string . format-args)
(define port
(begin
(unless (string? format-string)
(error "format: expected a string for format string" format-string))
(let* ((port
(cond
((not destination) (open-output-string))
((boolean? destination) (current-output-port)) ; boolean but not false
((output-port? destination) destination)
(else
(error "format: bad destination `~a'" destination))))
(error "format: bad destination `~a'" destination)))))
(output-col (or (port-column port) 0))
(define output-col (or (port-column port) 0))
(flush-output? #f))
(define flush-output? #f)
(define format:case-conversion #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
;; format string and char output routines on port
@ -1569,8 +1569,9 @@
(define (format:abort) (error "error in format"))
(let ((arg-pos (format:format-work format-string format-args))
(arg-len (length format-args)))
(define arg-pos (format:format-work format-string format-args))
(define arg-len (length format-args))
(cond
((> arg-pos arg-len)
(set! format:arg-pos (+ arg-len 1))
@ -1583,7 +1584,7 @@
#t
(let ((str (get-output-string port)))
(close-port port)
str)))))))
str)))))
;; Thanks to Shuji Narazaki
(module-set! the-root-module 'format format)