diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2022-01-11 22:01:23 -0800 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2022-01-11 22:01:23 -0800 |
| commit | 68986fe0410584c6934c835bb0ee784655f5f8c5 (patch) | |
| tree | d51bc2f3e09df35ef81b7a0c462ff555b4344701 /format.csc | |
| parent | Add a first implementation of a macro expander. (diff) | |
| download | chromatopelma-68986fe0410584c6934c835bb0ee784655f5f8c5.tar.zst | |
Move scheme compiler into a separate directory.
Diffstat (limited to 'format.csc')
| -rw-r--r-- | format.csc | 49 |
1 files changed, 0 insertions, 49 deletions
diff --git a/format.csc b/format.csc deleted file mode 100644 index 0469812..0000000 --- a/format.csc +++ /dev/null @@ -1,49 +0,0 @@ -(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))))) |