diff options
Diffstat (limited to 'csc/format.csc')
| -rw-r--r-- | csc/format.csc | 59 |
1 files changed, 30 insertions, 29 deletions
diff --git a/csc/format.csc b/csc/format.csc index 0469812..6ffd736 100644 --- a/csc/format.csc +++ b/csc/format.csc @@ -4,39 +4,40 @@ printf sprintf) (import (scheme base) - (only (scheme write) display) + (only (scheme write) + display) + (only (csc loop) + loop) (only (csc strings) - find - not-found-error? - prefix?)) + index + has-prefix?)) (begin - (define (fprintf port format-string . format-args) - (let loop ((start 0) - (args format-args)) - (cond ((>= start (string-length format-string))) - ((prefix? "{{" format-string start) - (write-string "{" port) - (loop (+ 2 start) args)) - ((prefix? "}}" format-string start) - (write-string "}" port) - (loop (+ 2 start) args)) - ((prefix? "{}" format-string start) - (display (car args) port) - (loop (+ 2 start) (cdr args))) - ((prefix? "{" format-string start) - (raise (error "invalid format string" format-string))) - (else - (let* ((open-brace-pos (guard (e - ((not-found-error? e) (string-length format-string))) - (find "{" format-string start))) - (close-brace-pos (guard (e - ((not-found-error? e) (string-length format-string))) - (find "}" format-string start))) - (format-pos (min open-brace-pos close-brace-pos))) - (write-string format-string port start format-pos) - (loop format-pos args)))))) + (define (fprintf port format-string . args) + (loop with s = format-string + until (string=? "" s) + if (has-prefix? s "{{") + do (write-string "{" port) + (set! s (string-copy s 2)) + else if (has-prefix? s "}}") + do (write-string "}" port) + (set! s (string-copy s 2)) + else if (has-prefix? s "{}") + do (display (car args) port) + (set! args (cdr args)) + (set! s (string-copy s 2)) + else if (or (has-prefix? s "{") + (has-prefix? s "}")) + do (error "invalid format string" format-string) + else + do (let* ((open-brace-pos (index s "{")) + (close-brace-pos (index s "}")) + (format-pos (min open-brace-pos close-brace-pos))) + (when (negative? format-pos) + (set! format-pos (string-length s))) + (write-string s port 0 format-pos) + (set! s (string-copy s format-pos))))) (define (printf format-string . format-args) |