From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 19 Feb 2017 22:08:43 +0000 (-0800)
Subject: Implement 'empty? message for string builder.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~58
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3a400dd30161968ed3f0058bb4877243173360ec;p=mit-scheme.git

Implement 'empty? message for string builder.
---

diff --git a/src/runtime/input.scm b/src/runtime/input.scm
index ef38d2eff..d78359b2e 100644
--- a/src/runtime/input.scm
+++ b/src/runtime/input.scm
@@ -59,10 +59,9 @@ USA.
 	(let loop ()
 	  (let ((char (read-char port)))
 	    (cond ((eof-object? char)
-		   (let ((string (builder)))
-		     (if (fix:= 0 (string-length string))
-			 char
-			 string)))
+		   (if (builder 'empty?)
+		       char
+		       (builder)))
 		  ((char=? char #\newline)
 		   (builder))
 		  (else
@@ -77,10 +76,9 @@ USA.
 	(let loop ()
 	  (let ((char (read-char port)))
 	    (cond ((eof-object? char)
-		   (let ((string (builder)))
-		     (if (fix:= 0 (string-length string))
-			 char
-			 string)))
+		   (if (builder 'empty?)
+		       char
+		       (builder)))
 		  ((char-set-member? delimiters char)
 		   (input-port/unread-char port char)
 		   (builder))
diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 2e038ef97..9b36cef8e 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -224,6 +224,10 @@ USA.
 	(set! index 0)
 	unspecific)
 
+      (define (empty?)
+	(and (fix:= 0 index)
+	     (null? buffers)))
+
       (define (append-char! char)
 	(if (not (fix:< index buffer-size))
 	    (new-buffer!))
@@ -259,6 +263,7 @@ USA.
 	(cond ((default-object? object) (build))
 	      ((bitless-char? object) (append-char! object))
 	      ((string? object) (append-string! object))
+	      ((eq? 'empty? object) (empty?))
 	      (else (error "Not a char or string:" object)))))))
 
 (define (string-copy! to at from #!optional start end)