Implement BURST-STRING.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 3941b882d4bd4661245a71c9694d34576ee74e0a..1611e849435c776e727d01aff01ecc12f1ac94fd 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.321 1999/03/04 05:55:08 cph Exp $
+$Id: runtime.pkg,v 14.322 1999/04/07 04:06:07 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -77,6 +77,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (files "string")
   (parent ())
   (export ()
+         burst-string
          char->string
          list->string
          guarantee-string

diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm
index 52d2bf8dc3c96cb5dcc549b10c3627814273188d..9aea30e5194c467eb5e65ceac3b86f369ac9cfef 100644 (file)
--- a/v7/src/runtime/string.scm
+++ b/v7/src/runtime/string.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: string.scm,v 14.17 1999/01/02 06:19:10 cph Exp $
+$Id: string.scm,v 14.18 1999/04/07 04:05:07 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -236,7 +236,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (list->string chars))
 
 (define char->string string)
-
+\f
 (define (string->list string)
   (guarantee-string string 'STRING->LIST)
   (%substring->list string 0 (string-length string)))
@@ -279,6 +279,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (string-append . strings)
   (%string-append strings))
+
+(define (burst-string string delimiter)
+  (let ((end (string-length string)))
+    (let loop ((start 0) (index 0) (result '()))
+      (cond ((fix:= index end)
+            (reverse!
+             (if (fix:< start index)
+                 (cons (substring string start index) result)
+                 result)))
+           ((char=? delimiter (string-ref string index))
+            (loop (fix:+ index 1)
+                  (fix:+ index 1)
+                  (if (fix:< start index)
+                      (cons (substring string start index) result)
+                      result)))
+           (else
+            (loop start (fix:+ index 1) result))))))
 \f
 ;;;; Case
 
@@ -566,6 +583,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                  (substring-fill! result 0 i char))
                (substring-move-right! string 0 length result i)))
          result))))
+\f
+;;;; String Search
+
+;;; This is the obvious dumb implementation.  Boyer-Moore is planned
+;;; for the future.
 
 (define (substring? substring string)
   ;; Returns starting-position or #f if not true.
@@ -636,4 +658,4 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (if (not (fix:<= end (string-length string)))
       (error:bad-range-argument end procedure))
   (if (not (fix:<= start end))
-      (error:bad-range-argument start procedure)))
+      (error:bad-range-argument start procedure)))
\ No newline at end of file

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 437205be369e1fd602a5905d513694506a146b00..5dabfe533c348f2052583d1f1b31faf7e23ac219 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.326 1999/03/04 05:56:18 cph Exp $
+$Id: runtime.pkg,v 14.327 1999/04/07 04:05:33 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -77,6 +77,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (files "string")
   (parent ())
   (export ()
+         burst-string
          char->string
          list->string
          guarantee-string