From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 1 Dec 2019 23:19:58 +0000 (-0800)
Subject: Move string-fold{,-right} into runtime.
X-Git-Tag: mit-scheme-pucked-10.1.20~10^2~31
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4dae14cdc21eea97d974106f7ea5a55b679b7f99;p=mit-scheme.git

Move string-fold{,-right} into runtime.
---

diff --git a/src/libraries/srfi-140.scm b/src/libraries/srfi-140.scm
index cbe93de3e..5362b5ba1 100644
--- a/src/libraries/srfi-140.scm
+++ b/src/libraries/srfi-140.scm
@@ -48,6 +48,8 @@ USA.
 			string->utf16le
 			string-append*
 			string-builder
+			string-fold
+			string-fold-right
 			string-joiner*
 			string-null?
 			string-padder
@@ -421,24 +423,6 @@ USA.
       (else
        (error:bad-range-argument grammar 'string-join)))))
 
-(define (string-fold kons knil string #!optional start end)
-  (let* ((end (fix:end-index end (string-length string) 'string-fold))
-	 (start (fix:start-index start end 'string-fold)))
-    (let loop ((index start) (knil knil))
-      (if (fx<? index end)
-	  (loop (fx+ index 1)
-		(kons (string-ref string index) knil))
-	  knil))))
-
-(define (string-fold-right kons knil string #!optional start end)
-  (let* ((end (fix:end-index end (string-length string) 'string-fold-right))
-	 (start (fix:start-index start end 'string-fold-right)))
-    (let loop ((index (fx- end 1)) (knil knil))
-      (if (fx>=? index start)
-	  (loop (fx- index 1)
-		(kons (string-ref string index) knil))
-	  knil))))
-
 (define (string-map-index proc string #!optional start end)
   (let* ((end (fix:end-index end (string-length string) 'string-map-index))
 	 (start (fix:start-index start end 'string-map-index)))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index ad04d333e..a7e09421e 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1169,6 +1169,8 @@ USA.
 	  string-find-previous-char
 	  string-find-previous-char-ci
 	  string-find-previous-char-in-set
+	  string-fold			;SRFI 140
+	  string-fold-right		;SRFI 140
 	  string-foldcase
 	  string-for-each
 	  string-hash			;SRFI-69
diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 962fb21c0..daebebb39 100644
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -1810,6 +1810,24 @@ USA.
 
 ;;;; Mapping
 
+(define (string-fold kons knil string #!optional start end)
+  (let* ((end (fix:end-index end (string-length string) 'string-fold))
+	 (start (fix:start-index start end 'string-fold)))
+    (let loop ((index start) (knil knil))
+      (if (fix:< index end)
+	  (loop (fix:+ index 1)
+		(kons (string-ref string index) knil))
+	  knil))))
+
+(define (string-fold-right kons knil string #!optional start end)
+  (let* ((end (fix:end-index end (string-length string) 'string-fold-right))
+	 (start (fix:start-index start end 'string-fold-right)))
+    (let loop ((index (fx- end 1)) (knil knil))
+      (if (fix:>= index start)
+	  (loop (fix:- index 1)
+		(kons (string-ref string index) knil))
+	  knil))))
+
 (define (mapper-values proc string strings)
   (cond ((null? strings)
 	 (values (string-length string)