From 68986fe0410584c6934c835bb0ee784655f5f8c5 Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Tue, 11 Jan 2022 22:01:23 -0800 Subject: Move scheme compiler into a separate directory. --- csc/format.csc | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 csc/format.csc (limited to 'csc/format.csc') 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))))) -- cgit v1.3.1