From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 7 Apr 1999 04:06:07 +0000 (+0000)
Subject: Implement BURST-STRING.
X-Git-Tag: 20090517-FFI~4569
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cb21c4cb4ca57c8a02c38228f908bfb3cb7b7e49;p=mit-scheme.git

Implement BURST-STRING.
---

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 3941b882d..1611e8494 100644
--- 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 52d2bf8dc..9aea30e51 100644
--- 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)
-
+
 (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))))))
 
 ;;;; 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))))
+
+;;;; 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 437205be3..5dabfe533 100644
--- 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