1 files changed, 70 insertions, 0 deletions
diff --git a/format.csc b/format.csc
new file mode 100644
index 0000000..2c2da84
--- /dev/null
+++ b/format.csc
@@ -0,0 +1,70 @@
+(define-library (csc format)
+  (export
+    vfprintf
+    fprintf
+    vprintf
+    printf
+    vsprintf
+    sprintf)
+  (import (scheme base)
+          (only (scheme write) display)
+          (only (csc strings)
+                str-find
+                str-not-found-error?
+                str-prefix?))
+  (begin
+
+
+    (define (vfprintf port format-string format-args)
+      (let loop ((start 0)
+                 (args format-args))
+        (cond ((>= start (string-length format-string)))
+              ((str-prefix? "{{" format-string start)
+               (write-string "{" port)
+               (loop (+ 2 start) args))
+              ((str-prefix? "}}" format-string start)
+               (write-string "}" port)
+               (loop (+ 2 start) args))
+              ((str-prefix? "{}" format-string start)
+               (display (car args) port)
+               (loop (+ 2 start) (cdr args)))
+              ((str-prefix? "{" format-string start)
+               (raise (error "invalid format string" format-string)))
+              (else
+                (let* ((open-brace-pos (guard (e
+                                                ((str-not-found-error? e) (string-length format-string)))
+                                              (str-find "{" format-string start)))
+                       (close-brace-pos (guard (e
+                                                 ((str-not-found-error? e) (string-length format-string)))
+                                               (str-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-syntax fprintf
+      (syntax-rules ()
+                    ((_ port format-string format-args ...)
+                     (vfprintf port format-string (list format-args ...)))))
+
+
+    (define (vprintf format-string format-args)
+      (vfprintf (current-output-port) format-string format-args))
+
+
+    (define-syntax printf
+      (syntax-rules ()
+                    ((_ format-string format-args ...)
+                     (vprintf format-string (list format-args ...)))))
+
+
+    (define (vsprintf format-string format-args)
+      (let ((string-builder (open-output-string)))
+        (vfprintf string-builder format-string format-args)
+        (get-output-string string-builder)))
+
+
+    (define-syntax sprintf
+      (syntax-rules ()
+                    ((_ format-string format-args ...)
+                     (vsprintf format-string (list format-args ...)))))))