diff options
Diffstat (limited to 'csc/format.csc')
| -rw-r--r-- | csc/format.csc | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/csc/format.csc b/csc/format.csc new file mode 100644 index 0000000..0469812 --- /dev/null +++ b/csc/format.csc @@ -0,0 +1,49 @@ +(define-library (csc format) + (export + fprintf + printf + sprintf) + (import (scheme base) + (only (scheme write) display) + (only (csc strings) + find + not-found-error? + 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 (printf format-string . format-args) + (apply fprintf (current-output-port) format-string format-args)) + + + (define (sprintf format-string . format-args) + (let ((string-builder (open-output-string))) + (apply fprintf string-builder format-string format-args) + (get-output-string string-builder))))) |