From f6cccfb501175ba15a1bd529c7228c22c57152a9 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Thu, 28 Jul 2022 19:55:37 -0700
Subject: Improve the strings API.

I'm just copying the go strings library API.
---
 csc/format.csc | 59 +++++++++++++++++++++++++++++-----------------------------
 1 file changed, 30 insertions(+), 29 deletions(-)

(limited to 'csc/format.csc')

diff --git a/csc/format.csc b/csc/format.csc
index 0469812..6ffd736 100644
--- a/csc/format.csc
+++ b/csc/format.csc
@@ -4,39 +4,40 @@
     printf
     sprintf)
   (import (scheme base)
-          (only (scheme write) display)
+          (only (scheme write)
+            display)
+          (only (csc loop)
+            loop)
           (only (csc strings)
-                find
-                not-found-error?
-                prefix?))
+            index
+            has-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 (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)
-- 
cgit v1.3.1