aboutsummaryrefslogtreecommitdiffstats
path: root/lib/csc/format.csc
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2022-08-01 19:35:19 -0700
committerRose Hogenson <rhogenson@posteo.net>2022-08-01 19:35:19 -0700
commitacc561366f3fe6ec0377103f52ef0f7e923711c9 (patch)
treed7a19cfbad78a69ebea71b27302e708c0655863d /lib/csc/format.csc
parentRename the compiler in bytecode.rs. (diff)
downloadchromatopelma-acc561366f3fe6ec0377103f52ef0f7e923711c9.tar.zst
Modify the project structure.
Now the lib directory contains what will eventually end up on the user's /usr/lib/csc. When I write make install, it will copy all of the .csc files from lib into the destination lib directory. This means I can start working on the standard library in lib/scheme.
Diffstat (limited to 'lib/csc/format.csc')
-rw-r--r--lib/csc/format.csc50
1 files changed, 50 insertions, 0 deletions
diff --git a/lib/csc/format.csc b/lib/csc/format.csc
new file mode 100644
index 0000000..6ffd736
--- /dev/null
+++ b/lib/csc/format.csc
@@ -0,0 +1,50 @@
+(define-library (csc format)
+ (export
+ fprintf
+ printf
+ sprintf)
+ (import (scheme base)
+ (only (scheme write)
+ display)
+ (only (csc loop)
+ loop)
+ (only (csc strings)
+ index
+ has-prefix?))
+ (begin
+
+
+ (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)
+ (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)))))