From 82bacc1e75214984947f5fd1c48afaa6302815fb Mon Sep 17 00:00:00 2001
From: shivers <shivers>
Date: Mon, 13 Sep 1999 17:37:48 +0000
Subject: [PATCH] Shifting this kind of library over to a new lib/ directory,
 where I'll stash things like SRFI libs.

---
 scsh/stringlib.scm  | 1289 -------------------------------------------
 scsh/stringpack.scm |  380 -------------
 2 files changed, 1669 deletions(-)
 delete mode 100644 scsh/stringlib.scm
 delete mode 100644 scsh/stringpack.scm

diff --git a/scsh/stringlib.scm b/scsh/stringlib.scm
deleted file mode 100644
index 53270dd..0000000
--- a/scsh/stringlib.scm
+++ /dev/null
@@ -1,1289 +0,0 @@
-;;; String-hacking functions					-*- Scheme -*-
-
-;;; Some of this code had (extremely distant) origins in MIT Scheme's string
-;;; lib, and was substantially reworked by Olin Shivers (shivers@ai.mit.edu)
-;;; 9/98. As such, it is
-;;;     Copyright (c) 1988-1994 Massachusetts Institute of Technology.
-;;; The copyright terms are essentially open-software terms;
-;;; the precise terms are at the end of this file.
-;;; 
-;;; The KMP string-search code was massively rehacked from Stephen Bevan's
-;;; code, written for scmlib, and is thus covered by the GPL. If that's a
-;;; problem, write one from scratch (there are citations to standard textbooks
-;;; in the comments), or rip it out and use the ten-line doubly-nested loop
-;;; that's commented out just above this code.
-;;;
-;;; I wish I could mark definitions in this code to be inlined.
-;;; Certain functions could benefit from compiler support.
-;;; 
-;;; My policy on checking start/end substring specs is not uniform.
-;;; I avoided doing arg checks when the function directly calls another
-;;; lower-level function that will check the start/end specs as well.
-;;; This has the advantage of not doing redundant checks, but the disadvantage
-;;; is that errors are not reported early, at the highest possible call.
-;;; There's not much high-level error checking of the other args, anyway.
-;;;     -Olin
-
-;;; Support for START/END substring specs
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; This macro parses optional start/end arguments from arg lists, defaulting
-;;; them to 0/(string-length s), and checks them for correctness.
-
-(define-syntax let-start+end
-  (syntax-rules ()
-    ((let-start+end (start end) proc s-exp args-exp body ...)
-     (receive (start end) (parse-final-start+end proc s-exp args-exp)
-       body ...))))
-
-
-;;; Returns three values: start end rest
-
-(define (parse-start+end proc s args)
-  (let ((slen (string-length s)))
-    (if (pair? args)
-
-	(let ((start (car args))
-	      (args (cdr args)))
-	  (if (or (not (integer? start)) (< start 0))
-	      (error "Illegal substring START spec" proc start s)
-	      (receive (end args)
-		  (if (pair? args)
-		      (let ((end (car args))
-			    (args (cdr args)))
-			(if (or (not (integer? end)) (< slen end))
-			    (error "Illegal substring END spec" proc end s)
-			    (values end args)))
-		      (values slen args))
-		(if (<= start end) (values start end args)
-		    (error "Illegal substring START/END spec"
-			   proc start end s)))))
-
-	(values 0 (string-length s) '()))))
-
-(define (parse-final-start+end proc s args)
-  (receive (start end rest) (parse-start+end proc s args)
-    (if (pair? rest) (error "Extra arguments to procedure" proc rest)
-	(values start end))))
-
-(define (check-substring-spec proc s start end)
-  (if (or (< start 0)
-	  (< (string-length s) end)
-	  (< end start))
-      (error "Illegal substring START/END spec." proc s start end)))
-
-
-
-;;; substring   S START [END] 
-;;; string-copy S [START END]
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Redefine SUBSTRING so that the END parameter is optional.
-;;; SUBSTRINGX is the underlying R5RS SUBSTRING function. All
-;;; the code in this file uses the simple SUBSTRINGX, so you can
-;;; easily port this code.
-
-(define substringx (structure-ref scheme substring))	; Simple R5RS SUBSTRING
-
-(define (substring s start . maybe-end)			; Our SUBSTRING
-  (substringx s start (:optional maybe-end (string-length s))))
-
-(define (string-copy s . maybe-start+end)
-  (let-start+end (start end) string-copy s maybe-start+end
-    (substringx s start end)))
-
-
-
-;;; Basic iterators and other higher-order abstractions
-;;; (string-map proc s [start end])
-;;; (string-map! proc s [start end])
-;;; (string-fold       kons knil s [start end])
-;;; (string-fold-right kons knil s [start end])
-;;; (string-unfold p f g seed)
-;;; (string-for-each proc s [start end])
-;;; (string-iter     proc s [start end])
-;;; (string-every? pred s [start end])
-;;; (string-any    pred s [start end])
-;;; (string-tabulate proc len)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; No guarantees about order in MAP, FOR-EACH, EVERY, ANY procs.
-;;;
-;;; You want compiler support for high-level transforms on fold and unfold ops.
-;;; You'd at least like a lot of inlining for clients of these procedures.
-;;; Hold your breath.
-
-(define (string-map proc s . maybe-start+end)
-  (let-start+end (start end) string-map s maybe-start+end
-    (let* ((len (- end start))
-	   (ans (make-string len)))
-      (do ((i (- end 1) (- i 1))
-	   (j (- len 1) (- j 1)))
-	  ((< j 0))
-	(string-set! ans j (proc (string-ref s i))))
-      ans)))
-
-(define (string-map! proc s . maybe-start+end)
-  (let-start+end (start end) string-map! s maybe-start+end
-    (do ((i (- end 1) (- i 1)))
-	((< i start))
-      (string-set! s i (proc (string-ref s i))))))
-
-(define (string-fold kons knil s . maybe-start+end)
-  (let-start+end (start end) string-fold s maybe-start+end
-    (let lp ((v knil) (i start))
-      (if (< i end) (lp (kons (string-ref s i) v) (+ i 1))
-	  v))))
-
-(define (string-fold-right kons knil s . maybe-start+end)
-  (let-start+end (start end) string-fold-right s maybe-start+end
-    (let lp ((v knil) (i (- end 1)))
-      (if (>= i start) (lp (kons (string-ref s i) v) (- i 1))
-	  v))))
-
-;;; (string-unfold p f g seed)
-;;; This is the fundamental constructor for strings. 
-;;; - G is used to generate a series of "seed" values from the initial seed:
-;;;     SEED, (G SEED), (G^2 SEED), (G^3 SEED), ...
-;;; - P tells us when to stop -- when it returns true when applied to one 
-;;;   of these seed values.
-;;; - F maps each seed value to the corresponding character 
-;;;   in the result string.
-;;;
-;;; In other words, the following (simple, inefficient) definition holds:
-;;; (string-unfold p f g seed) =
-;;;   (if (p seed) "" 
-;;;       (string-append (string (f seed)) 
-;;;                      (string-unfold p f g (g seed))))
-;;; 
-;;; STRING-UNFOLD is a fairly powerful constructor -- you can use it to
-;;; reverse a string, copy a string, convert a list to a string, read
-;;; a port into a string, and so forth. Examples:
-;;; (port->string port) =
-;;;   (string-unfold (compose eof-object? peek-char)
-;;;                  read-char identity port)
-;;;
-;;; (list->string lis) = (string-unfold null? car cdr lis)
-;;; 
-;;; (tabulate-string f size) = (string-unfold (lambda (i) (= i size)) f add1 0)
-
-;;; A problem with the following simple formulation is that it pushes one
-;;; stack frame for every char in the result string -- an issue if you are
-;;; using it to read a 100kchar string. So we don't use it -- but I include
-;;; it to give a clear, straightforward description of what the function
-;;; does.
-
-;(define (string-unfold p f g seed)
-;  (let recur ((seed seed) (i 0))
-;    (if (p seed) (make-string i)
-;        (let* ((c (f seed))
-;               (s (recur (g seed) (+ i 1))))
-;          (string-set! s i c)
-;          s))))
-
-;;; This formulation chunks up the constructed string into 1024-char chunks,
-;;; popping the stack frames. So it'll reduce stack growth by a factor of
-;;; 1024. Marc Feeley alerted me to this issue and its general solution.
-
-(define (string-unfold p f g seed)
-  (apply string-append
-	 (let recur ((seed seed))
-	   (receive (s seed done?)
-	            (let recur2 ((seed seed) (i 0))
-		      (cond ((p seed) (values (make-string i) seed #t))
-			    ((>= i 1024) (values (make-string i) seed #f))
-			    (else (let ((c (f seed)))
-				    (receive (s seed done?)
-					     (recur2 (g seed) (+ i 1))
-				      (string-set! s i c)
-				      (values s seed done?))))))
-
-	     (if done? (list s)
-		 (cons s (recur seed)))))))
-
-
-;;; This is the same as STRING-UNFOLD, but defined for multiple 
-;;; seed parameters. If you pass N seeds, then
-;;; - P maps N parameters to a boolean.
-;;; - F maps N parameters to a character.
-;;; - G maps N parameters to N return values.
-;;; This definition does a lot of consing; it would need a fair amount
-;;; of compiler support to be efficient.
-
-; Not released
-;(define (string-unfoldn p f g . seeds)
-;  (apply string-append
-;	 (let recur ((seeds seeds))
-;	   (receive (s seeds done?)
-;	            (let recur2 ((seeds seeds) (i 0))
-;		      (cond ((apply p seeds) (values (make-string i) seeds #t))
-;			    ((>= i 1024) (values (make-string i) seeds #f))
-;			    (else (let ((c (apply f seeds)))
-;				    (receive seeds (apply g seeds)
-;				      (receive (s seeds done?)
-;					       (recur2 seeds (+ i 1))
-;					(string-set! s i c)
-;					(values s seeds done?)))))))
-;
-;	     (if done? (list s)
-;		 (cons s (recur seeds)))))))
-
-(define (string-for-each proc s . maybe-start+end)
-  (let-start+end (start end) string-for-each s maybe-start+end
-    (do ((i (- end 1) (- i 1)))
-	((< i start))
-      (proc (string-ref s i)))))
-
-(define (string-iter proc s . maybe-start+end)
-  (let-start+end (start end) string-iter s maybe-start+end
-    (do ((i start (+ i 1)))
-	((>= i end))
-      (proc (string-ref s i)))))
-
-(define (string-every? pred s . maybe-start+end)
-  (let-start+end (start end) string-every? s maybe-start+end
-    (let lp ((i (- end 1)))
-      (or (< i start)
-	  (and (pred (string-ref s i))
-	       (lp (- i 1)))))))
-
-(define (string-any pred s . maybe-start+end)
-  (let-start+end (start end) string-any s maybe-start+end
-    (let lp ((i (- end 1)))
-      (and (>= i start)
-	   (or (pred (string-ref s i))
-	       (lp (- i 1)))))))
-
-
-(define (string-tabulate proc len)
-  (let ((s (make-string len)))
-    (do ((i (- len 1) (- i 1)))
-	((< i 0))
-      (string-set! s i (proc i)))
-    s))
-
-
-
-;;; string-prefix-count[-ci] s1 s2
-;;; string-suffix-count[-ci] s1 s2
-;;; substring-prefix-count[-ci] s1 start1 end1  s2 start2 end2
-;;; substring-suffix-count[-ci] s1 start1 end1  s2 start2 end2
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Find the length of the common prefix/suffix.
-;;; It is not required that the two substrings passed be of equal length.
-;;; This was microcode in MIT Scheme -- a very tightly bummed primitive.
-
-(define (substring-prefix-count s1 start1 end1 s2 start2 end2)
-  (check-substring-spec substring-prefix-count s1 start1 end1)
-  (check-substring-spec substring-prefix-count s2 start2 end2)
-  (let* ((delta (min (- end1 start1) (- end2 start2)))
-	 (end1 (+ start1 delta)))
-    (let lp ((i start1) (j start2))
-      (if (or (>= i end1)
-	      (not (char=? (string-ref s1 i)
-			   (string-ref s2 j))))
-	  (- i start1)
-	  (lp (+ i 1) (+ j 1))))))
-
-(define (substring-suffix-count s1 start1 end1 s2 start2 end2)
-  (check-substring-spec substring-suffix-count s1 start1 end1)
-  (check-substring-spec substring-suffix-count s2 start2 end2)
-  (let* ((delta (min (- end1 start1) (- end2 start2)))
-	 (start1 (- end1 delta)))
-    (let lp ((i (- end1 1)) (j (- end2 1)))
-      (if (or (< i start1)
-	      (not (char=? (string-ref s1 i)
-			   (string-ref s2 j))))
-	  (- (- end1 i) 1)
-	  (lp (- i 1) (- j 1))))))
-
-(define (substring-prefix-count-ci s1 start1 end1 s2 start2 end2)
-  (check-substring-spec substring-prefix-count-ci s1 start1 end1)
-  (check-substring-spec substring-prefix-count-ci s2 start2 end2)
-  (let* ((delta (min (- end1 start1) (- end2 start2)))
-	 (end1 (+ start1 delta)))
-    (let lp ((i start1) (j start2))
-      (if (or (>= i end1)
-	      (not (char-ci=? (string-ref s1 i)
-			      (string-ref s2 j))))
-	  (- i start1)
-	  (lp (+ i 1) (+ j 1))))))
-
-(define (substring-suffix-count-ci s1 start1 end1 s2 start2 end2)
-  (check-substring-spec substring-suffix-count-ci s1 start1 end1)
-  (check-substring-spec substring-suffix-count-ci s2 start2 end2)
-  (let* ((delta (min (- end1 start1) (- end2 start2)))
-	 (start1 (- end1 delta)))
-    (let lp ((i (- end1 1)) (j (- end2 1)))
-      (if (or (< i start1)
-	      (not (char-ci=? (string-ref s1 i)
-			      (string-ref s2 j))))
-	  (- (- end1 i) 1)
-	  (lp (- i 1) (- j 1))))))
-
-
-(define (string-prefix-count s1 s2)
-  (substring-prefix-count s1 0 (string-length s1) s2 0 (string-length s2)))
-
-(define (string-suffix-count s1 s2)
-  (substring-suffix-count s1 0 (string-length s1) s2 0 (string-length s2)))
-
-(define (string-prefix-count-ci s1 s2)
-  (substring-prefix-count-ci s1 0 (string-length s1) s2 0 (string-length s2)))
-
-(define (string-suffix-count-ci s1 s2)
-  (substring-suffix-count-ci s1 0 (string-length s1) s2 0 (string-length s2)))
-
-
-
-;;; string-prefix?    s1 s2 
-;;; string-suffix?    s1 s2 
-;;; string-prefix-ci? s1 s2 
-;;; string-suffix-ci? s1 s2 
-;;; 
-;;; substring-prefix?    s1 start1 end1 s2 start2 end2 
-;;; substring-suffix?    s1 start1 end1 s2 start2 end2 
-;;; substring-prefix-ci? s1 start1 end1 s2 start2 end2 
-;;; substring-suffix-ci? s1 start1 end1 s2 start2 end2 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; These are all simple derivatives of the previous counting funs.
-
-(define (string-prefix? s1 s2) 
-  (substring-prefix? s1 0 (string-length s1) s2 0 (string-length s2)))
-
-(define (string-suffix? s1 s2) 
-  (substring-suffix-ci? s1 0 (string-length s1) s2 0 (string-length s2)))
-
-(define (string-prefix-ci? s1 s2)
-  (substring-prefix-ci? s1 0 (string-length s1) s2 0 (string-length s2)))
-
-(define (string-suffix-ci? s1 s2)
-  (substring-suffix-ci? s1 0 (string-length s1) s2 0 (string-length s2)))
-
-(define (substring-prefix? s1 start1 end1 s2 start2 end2)
-  (let ((len1 (- end1 start1)))
-    (and (<= len1 (- end2 start2))	; Quick check
-	 (= (substring-prefix-count s1 start1 end1
-				    s2 start2 end2)
-	    len1))))
-
-(define (substring-suffix? s1 start1 end1 s2 start2 end2)
-  (let ((len1 (- end1 start1)))
-    (and (<= len1 (- end2 start2))	; Quick check
-	 (= len1 (substring-suffix-count s1 start1 end1
-					 s2 start2 end2)))))
-
-(define (substring-prefix-ci? s1 start1 end1 s2 start2 end2)
-  (let ((len1 (- end1 start1)))
-    (and (<= len1 (- end2 start2))	; Quick check
-	 (= len1 (substring-prefix-count-ci s1 start1 end1
-					    s2 start2 end2)))))
-
-(define (substring-suffix-ci? s1 start1 end1 s2 start2 end2)
-  (let ((len1 (- end1 start1)))
-    (and (<= len1 (- end2 start2))	; Quick check
-	 (= len1 (substring-suffix-count-ci s1 start1 end1
-					    s2 start2 end2)))))
-
-
-;;; string-compare    s1 s2 lt-proc eq-proc gt-proc
-;;; string-compare-ci s1 s2 eq-proc lt-proc gt-proc
-;;; substring-compare    s1 start1 end1 s2 start2 end2
-;;;                      lt-proc eq-proc gt-proc
-;;; substring-compare-ci s1 start1 end1 s2 start2 end2
-;;;                      lt-proc eq-proc gt-proc
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Primitive string-comparison functions.
-;;; Continuation order is different from MIT Scheme.
-;;; Continuations are applied to s1's mismatch index;
-;;; in the case of equality, this is END1.
-
-(define (substring-compare s1 start1 end1 s2 start2 end2
-			   proc< proc= proc>)
-  (let ((size1 (- end1 start1))
-	(size2 (- end2 start2)))
-    (let ((match (substring-prefix-count s1 start1 end1 s2 start2 end2)))
-      (if (= match size1)
-	  ((if (= match size2) proc= proc<) end1)
-	  ((if (= match size2)
-	       proc>
-	       (if (char<? (string-ref s1 (+ start1 match))
-			   (string-ref s2 (+ start2 match)))
-		   proc< proc>))
-	   (+ match start1))))))
-
-(define (substring-compare-ci s1 start1 end1 s2 start2 end2
-			      proc< proc= proc>)
-  (let ((size1 (- end1 start1))
-	(size2 (- end2 start2)))
-    (let ((match (substring-prefix-count-ci s1 start1 end1 s2 start2 end2)))
-      (if (= match size1)
-	  ((if (= match size2) proc= proc<) end1)
-	  ((if (= match size2) proc>
-	       (if (char-ci<? (string-ref s1 (+ start1 match))
-			      (string-ref s2 (+ start2 match)))
-		   proc< proc>))
-	   (+ start1 match))))))
-
-(define (string-compare s1 s2 proc< proc= proc>)
-  (substring-compare s1 0 (string-length s1)
-		     s2 0 (string-length s2)
-		     proc< proc= proc>))
-
-(define (string-compare-ci s1 s2 proc< proc= proc>)
-  (substring-compare-ci s1 0 (string-length s1)
-			s2 0 (string-length s2)
-			proc< proc= proc>))
-
-
-;;; string=          string<>		string-ci=          string-ci<>
-;;; string<          string>		string-ci<          string-ci>
-;;; string<=         string>=		string-ci<=         string-ci>=
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Simple definitions in terms of the previous comparison funs.
-;;; Inequality predicates return #f or mismatch index.
-;;; I sure hope these defns get integrated.
-
-(define (string=  s1 s2)
-  (string-compare s1 s2 (lambda (i) #f) (lambda (i) i) (lambda (i) #f)))
-
-(define (string<  s1 s2)
-  (string-compare s1 s2 (lambda (i) i) (lambda (i) #f) (lambda (i) #f)))
-
-(define (string>  s1 s2)
-  (string-compare s1 s2 (lambda (i) #f) (lambda (i) #f) (lambda (i) i)))
-
-(define (string<=  s1 s2)
-  (string-compare s1 s2 (lambda (i) i) (lambda (i) i) (lambda (i) #f)))
-
-(define (string>=  s1 s2)
-  (string-compare s1 s2 (lambda (i) #f) (lambda (i) i) (lambda (i) i)))
-
-(define (string<>  s1 s2) 
-  (string-compare s1 s2 (lambda (i) i) (lambda (i) #f) (lambda (i) i)))
-
-
-(define (string-ci=  s1 s2)
-  (string-compare-ci s1 s2 (lambda (i) #f) (lambda (i) i) (lambda (i) #f)))
-
-(define (string-ci<  s1 s2)
-  (string-compare-ci s1 s2 (lambda (i) i) (lambda (i) #f) (lambda (i) #f)))
-
-(define (string-ci>  s1 s2)
-  (string-compare-ci s1 s2 (lambda (i) #f) (lambda (i) #f) (lambda (i) i)))
-
-(define (string-ci<=  s1 s2)
-  (string-compare-ci s1 s2 (lambda (i) i) (lambda (i) i) (lambda (i) #f)))
-
-(define (string-ci>=  s1 s2)
-  (string-compare-ci s1 s2 (lambda (i) #f) (lambda (i) i) (lambda (i) i)))
-
-(define (string-ci<>  s1 s2)
-  (string-compare-ci s1 s2 (lambda (i) i) (lambda (i) #f) (lambda (i) i)))
-
-
-(define (substring= s1 start1 end1 s2 start2 end2)
-  (substring-compare s1 start1 end1
-		     s2 start2 end2
-		     (lambda (i) #f)
-		     (lambda (i) i)
-		     (lambda (i) #f)))
-
-(define (substring<> s1 start1 end1 s2 start2 end2)
-  (substring-compare s1 start1 end1
-		     s2 start2 end2
-		     (lambda (i) i)
-		     (lambda (i) #f)
-		     (lambda (i) i)))
-
-(define (substring< s1 start1 end1 s2 start2 end2)
-  (substring-compare s1 start1 end1
-		     s2 start2 end2
-		     (lambda (i) i)
-		     (lambda (i) #f)
-		     (lambda (i) #f)))
-
-(define (substring> s1 start1 end1 s2 start2 end2)
-  (substring< s2 start2 end2 s1 start1 end1))
-
-(define (substring<= s1 start1 end1 s2 start2 end2)
-  (substring-compare s1 start1 end1
-		     s2 start2 end2
-		     (lambda (i) i)
-		     (lambda (i) i)
-		     (lambda (i) #f)))
-
-(define (substring>= s1 start1 end1 s2 start2 end2)
-  (substring<= s2 start2 end2 s1 start1 end1))
-
-(define (substring-ci= s1 start1 end1 s2 start2 end2)
-  (substring-compare-ci s1 start1 end1
-			s2 start2 end2
-			(lambda (i) #f)
-			(lambda (i) i)
-			(lambda (i) #f)))
-
-(define (substring-ci<> s1 start1 end1 s2 start2 end2)
-  (substring-compare-ci s1 start1 end1
-			s2 start2 end2
-			(lambda (i) i)
-			(lambda (i) #f)
-			(lambda (i) i)))
-
-(define (substring-ci< s1 start1 end1 s2 start2 end2)
-  (substring-compare-ci s1 start1 end1
-			s2 start2 end2
-			(lambda (i) i)
-			(lambda (i) #f)
-			(lambda (i) #f)))
-
-(define (substring-ci> s1 start1 end1 s2 start2 end2)
-  (substring-ci< s2 start2 end2 s1 start1 end1))
-
-(define (substring-ci<= s1 start1 end1 s2 start2 end2)
-  (substring-compare-ci s1 start1 end1
-			s2 start2 end2
-			(lambda (i) i)
-			(lambda (i) i)
-			(lambda (i) #f)))
-
-(define (substring-ci>= s1 start1 end1 s2 start2 end2)
-  (substring-ci<= s2 start2 end2 s1 start1 end1))
-
-
-
-;;; Case hacking
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; string-upper-case?
-;;; string-lower-case?
-;;;
-;;; string-upcase  s [start end]
-;;; string-upcase! s [start end]
-;;; string-downcase  s [start end]
-;;; string-downcase! s [start end]
-;;;
-;;; capitalize-string  s [start end]
-;;; capitalize-string! s [start end]
-;;;   Uppercase first alphanum char, lowercase rest.
-;;;
-;;; capitalize-words  s [start end]
-;;; capitalize-words! s [start end]
-;;;   Capitalize every contiguous alphanum sequence: uppercase
-;;;   first char, lowercase rest.
-
-;;; These two use a different definition of an "upper-/lower-case string"
-;;; than MIT Scheme uses:
-
-(define (string-upper-case? s . maybe-start+end)
-  (not (apply string-any char-lower-case? s maybe-start+end)))
-
-(define (string-lower-case? s . maybe-start+end)
-  (not (apply string-any char-upper-case? s maybe-start+end)))
-
-
-(define (string-upcase  s . maybe-start+end)
-  (apply string-map char-upcase s maybe-start+end))
-
-(define (string-upcase! s . maybe-start+end)
-  (apply string-map! char-upcase s maybe-start+end))
-
-(define (string-downcase  s . maybe-start+end)
-  (apply string-map char-downcase s maybe-start+end))
-
-(define (string-downcase! s . maybe-start+end)
-  (apply string-map! char-downcase s maybe-start+end))
-
-
-;;; capitalize-string  s [start end]
-;;; capitalize-string! s [start end]
-;;;   Uppercase first alphanum char, lowercase rest.
-
-(define (really-capitalize-string! s start end)
-  (cond ((string-index s char-set:alphanumeric start end) =>
-         (lambda (i)
-	   (string-set! s i (char-upcase (string-ref s i)))
-	   (string-downcase! s i)))))
-
-(define (capitalize-string! s . maybe-start+end)
-  (let-start+end (start end) capitalize-string! s maybe-start+end
-    (really-capitalize-string! s start end)))
-
-(define (capitalize-string s . maybe-start+end)
-  (let-start+end (start end) capitalize-string s maybe-start+end
-    (let ((ans (substringx s start end)))
-      (really-capitalize-string! ans 0 (- end start))
-      ans)))
-
-;;; capitalize-words  s [start end]
-;;; capitalize-words! s [start end]
-;;;   Capitalize every contiguous alphanum sequence: uppercase
-;;;   first char, lowercase rest.
-
-(define (really-capitalize-words! s start end)
-  (let lp ((i start))
-    (cond ((string-index s char-set:alphanumeric i end) =>
-           (lambda (i)
-	     (string-set! s i (char-upcase (string-ref s i)))
-	     (let ((i1 (+ i 1)))
-	       (cond ((string-skip s char-set:alphanumeric i1 end) =>
-		      (lambda (j)
-			(string-downcase! s i1 j)
-			(lp (+ j 1))))
-		     (else (string-downcase! s i1 end)))))))))
-
-(define (capitalize-words! s . maybe-start+end)
-  (let-start+end (start end) capitalize-string! s maybe-start+end
-    (really-capitalize-words! s start end)))
-
-(define (capitalize-words s . maybe-start+end)
-  (let-start+end (start end) capitalize-string! s maybe-start+end
-    (let ((ans (substringx s start end)))
-      (really-capitalize-words! ans 0 (- end start))
-      ans)))
-
-
-
-;;; Cutting & pasting strings
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; string-take string nchars
-;;; string-drop string nchars
-;;;
-;;; string-padl string k [char start end] 
-;;; string-padr string k [char start end] 
-;;; 
-;;; string-trim  string [char/char-set/pred start end] 
-;;; string-triml string [char/char-set/pred start end] 
-;;; string-trimr string [char/char-set/pred start end] 
-;;;
-;;; These trimmers invert the char-set meaning from MIT Scheme -- you
-;;; say what you want to trim.
-
-(define (string-take s n)
-  (if (> n 0)
-      (substringx s 0 n)
-      (let ((len (string-length s)))
-	(substringx s (+ len n) len))))
-
-(define (string-drop s n)
-  (let ((len (string-length s)))
-    (if (> n 0)
-	(substringx s n len)
-	(substringx s 0 (+ len n)))))
-
-(define (string-triml s . args)
-  (let-optionals args ((criteria char-set:whitespace)
-		       (start 0)
-		       (end (string-length s)))
-    (cond ((string-skip s criteria start end) =>
-	   (lambda (i) (substringx s i end)))
-	  (else ""))))
-
-(define (string-trimr s . args)
-  (let-optionals args ((criteria char-set:whitespace)
-		       (start 0)
-		       (end (string-length s)))
-    (cond ((string-skip-right s criteria end start) =>
-	   (lambda (i) (substringx s 0 (+ 1 i))))
-	  (else ""))))
-
-(define (string-trim s . args)
-  (let-optionals args ((criteria char-set:whitespace)
-		       (start 0)
-		       (end (string-length s)))
-    (cond ((string-skip s criteria start end) =>
-	   (lambda (i) (substringx s i (+ 1 (string-skip-right s criteria end)))))
-	  (else ""))))
-
-
-(define (string-padr s n . args)
-  (let-optionals args ((char #\space) (start 0) (end (string-length s)))
-    (check-substring-spec string-padr s start end)
-    (let ((len (- end start)))
-      (cond ((= n len)						; No pad.
-	     (if (zero? start) s (substringx s start end)))
-
-	    ((< n len) (substringx s start (+ start n)))	; Trim.
-
-	    (else (let ((ans (make-string n char)))
-		    (string-copy! ans 0 s start end)
-		    ans))))))
-
-(define (string-padl s n . args)
-  (let-optionals args ((char #\space) (start 0) (end (string-length s)))
-    (check-substring-spec string-padl s start end)
-    (let ((len (- end start)))
-      (cond ((= n len)						; No pad.
-	     (if (zero? start) s (substringx s start end)))
-
-	    ((< n len) (substringx s  (- end n) end))		; Trim.
-
-	    (else (let ((ans (make-string n char)))
-		    (string-copy! ans (- n len) s start end)
-		    ans))))))
-
-
-
-;;; Filtering strings
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; string-delete char/char-set/pred string [start end]
-;;; string-filter char/char-set/pred string [start end]
-;;;
-;;; If the filter criteria is a char or char-set, we scan the string twice
-;;;   with string-fold -- once to determine the length of the result string, 
-;;;   and once to do the filtered copy.
-;;; If the filter criteria is a predicate, we don't do this double-scan
-;;;   strategy, because the predicate might have side-effects or be very
-;;;   expensive to compute. So we preallocate a temp buffer pessimistically,
-;;;   and only do one scan over S. This is likely to be faster and more
-;;;   space-efficient that consing a list.
-
-(define (string-delete criteria s . maybe-start+end)
-  (let-start+end (start end) string-delete s maybe-start+end
-    (if (procedure? criteria)
-	(let* ((slen (- end start))
-	       (temp (make-string slen))
-	       (ans-len (string-fold (lambda (c i)
-				       (if (criteria c) i
-					   (begin (string-set! temp i c)
-						  (+ i 1))))
-				     0 s start end)))
-	  (if (= ans-len slen) temp (substringx temp 0 ans-len)))
-
-	(let* ((cset (cond ((char-set? criteria) criteria)
-			   ((char? criteria) (char-set criteria))
-			   (else (error "string-delete criteria not predicate, char or char-set" criteria))))
-	       (len (string-fold (lambda (c i) (if (char-set-contains? cset c)
-						   i
-						   (+ i 1)))
-				 0 s start end))
-	       (ans (make-string len)))
-	  (string-fold (lambda (c i) (if (char-set-contains? cset c)
-					 i
-					 (begin (string-set! ans i c)
-						(+ i 1))))
-		       0 s start end)
-	  ans))))
-
-(define (string-filter criteria s . maybe-start+end)
-  (let-start+end (start end) string-filter s maybe-start+end
-    (if (procedure? criteria)
-	(let* ((slen (- end start))
-	       (temp (make-string slen))
-	       (ans-len (string-fold (lambda (c i)
-				       (if (criteria c)
-					   (begin (string-set! temp i c)
-						  (+ i 1))
-					   i))
-				     0 s start end)))
-	  (if (= ans-len slen) temp (substringx temp 0 ans-len)))
-
-	(let* ((cset (cond ((char-set? criteria) criteria)
-			   ((char? criteria) (char-set criteria))
-			   (else (error "string-delete criteria not predicate, char or char-set" criteria))))
-
-	       (len (string-fold (lambda (c i) (if (char-set-contains? cset c)
-						   (+ i 1)
-						   i))
-				 0 s start end))
-	       (ans (make-string len)))
-	  (string-fold (lambda (c i) (if (char-set-contains? cset c)
-					 (begin (string-set! ans i c)
-						(+ i 1))
-					 i))
-		       0 s start end)
-	  ans))))
-
-
-
-;;; String search
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; string-index       string char/char-set/pred [start end]
-;;; string-index-right string char/char-set/pred [end start]
-;;; string-skip        string char/char-set/pred [start end]
-;;; string-skip-right  string char/char-set/pred [end start]
-;;;     Note the odd start/end ordering of index-right and skip-right params.
-;;;     There's a lot of replicated code here for efficiency.
-;;;     For example, the char/char-set/pred discrimination has
-;;;     been lifted above the inner loop of each proc.
-
-(define (string-index str criteria . maybe-start+end)
-  (let-start+end (start end) string-index str maybe-start+end
-    (cond ((char? criteria)
-	   (let lp ((i start))
-	     (and (< i end)
-		  (if (char=? criteria (string-ref str i)) i
-		      (lp (+ i 1))))))
-	  ((char-set? criteria)
-	   (let lp ((i start))
-	     (and (< i end)
-		  (if (char-set-contains? criteria (string-ref str i)) i
-		      (lp (+ i 1))))))
-	  ((procedure? criteria)
-	   (let lp ((i start))
-	     (and (< i end)
-		  (if (criteria (string-ref str i)) i
-		      (lp (+ i 1))))))
-	  (else (error "Second param is neither char-set, char, or predicate procedure."
-		       string-index criteria)))))
-
-(define (string-index-right str criteria . maybe-end+start)
-  (let-optionals maybe-end+start ((start 0) (end (string-length str)))
-    (check-substring-spec string-index-right str start end)
-    (cond ((char? criteria)
-	   (let lp ((i (- end 1)))
-	     (and (>= i 0)
-		  (if (char=? criteria (string-ref str i)) i
-		      (lp (- i 1))))))
-	  ((char-set? criteria)
-	   (let lp ((i (- end 1)))
-	     (and (>= i 0)
-		  (if (char-set-contains? criteria (string-ref str i)) i
-		      (lp (- i 1))))))
-	  ((procedure? criteria)
-	   (let lp ((i (- end 1)))
-	     (and (>= i 0)
-		  (if (criteria (string-ref str i)) i
-		      (lp (- i 1))))))
-	  (else (error "Second param is neither char-set, char, or predicate procedure."
-		       string-index-right criteria)))))
-
-(define (string-skip str criteria . maybe-start+end)
-  (let-start+end (start end) string-skip str maybe-start+end
-    (cond ((char? criteria)
-	   (let lp ((i start))
-	     (and (< i end)
-		  (if (char=? criteria (string-ref str i))
-		      (lp (+ i 1))
-		      i))))
-	  ((char-set? criteria)
-	   (let lp ((i start))
-	     (and (< i end)
-		  (if (char-set-contains? criteria (string-ref str i))
-		      (lp (+ i 1))
-		      i))))
-	  ((char-set? criteria)
-	   (let lp ((i start))
-	     (and (< i end)
-		  (if (criteria (string-ref str i)) (lp (+ i 1))
-		      i))))
-	  (else (error "Second param is neither char-set, char, or predicate procedure."
-		       string-skip criteria)))))
-
-(define (string-skip-right str criteria . maybe-end+start)
-  (let-optionals maybe-end+start ((start 0) (end (string-length str)))
-    (check-substring-spec string-index-right str start end)
-    (cond ((char? criteria)
-	   (let lp ((i (- end 1)))
-	     (and (>= i 0)
-		  (if (char=? criteria (string-ref str i))
-		      (lp (- i 1))
-		      i))))
-	  ((char-set? criteria)
-	   (let lp ((i (- end 1)))
-	     (and (>= i 0)
-		  (if (char-set-contains? criteria (string-ref str i))
-		      (lp (- i 1))
-		      i))))
-	  ((procedure? criteria)
-	   (let lp ((i (- end 1)))
-	     (and (>= i 0)
-		  (if (criteria (string-ref str i)) (lp (- i 1))
-		      i))))
-	  (else (error "CRITERIA param is neither char-set or char." string-skip-right criteria)))))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; string-fill! string char [start end]
-;;; 
-;;; string-copy! to tstart from [fstart fend]
-;;; 	Guaranteed to work, even if s1 eq s2.
-
-(define (string-fill! s char . maybe-start+end)
-  (let-start+end (start end) string-fill! s maybe-start+end
-    (do ((i (- end 1) (- i 1)))
-	((< i start))
-      (string-set! s i char))))
-
-(define (string-copy! to tstart from . maybe-fstart+fend)
-  (let-start+end (fstart fend) string-copy! from maybe-fstart+fend
-    (let ((tend (+ tstart (- fend fstart))))
-      (check-substring-spec string-copy! to tstart tend)
-      (if (> fstart tstart)
-	  (do ((i fstart (+ i 1))
-	       (j tstart (+ j 1)))
-	      ((>= i fend))
-	    (string-set! to j (string-ref from i)))
-
-	  (do ((i (- fend 1) (- i 1))
-	       (j (- tend 1) (- j 1)))
-	      ((< i fstart))
-	    (string-set! to j (string-ref from i)))))))
-
-
-
-;;; Returns starting-position or #f if not true.
-;;; This implementation is slow & simple. See below for KMP.
-;;; Boyer-Moore would be nice.
-;(define (substring? substring string . maybe-start+end)
-;  (let-start+end (start end) string substring? maybe-start+end
-;    (if (string-null? substring) start
-;	(let* ((len (string-length substring))
-;	       (i-bound (- end len))
-;	       (char1 (string-ref substring start)))
-;	  (let lp ((i 0))
-;	    (cond ((string-index string char1 i i-bound) =>
-;		   (lambda (i)
-;		     (if (substring= substring 0 len string i (+ i len))
-;			 i
-;			 (lp (+ i 1)))))
-;		  (else #f)))))))
-
-
-;;; Searching for an occurence of a substring
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; This uses the KMP algorithm
-;;;     "Fast Pattern Matching in Strings"
-;;;     SIAM J. Computing 6(2):323-350 1977
-;;;     D. E. Knuth, J. H. Morris and V. R. Pratt
-;;; also described in
-;;;     "Pattern Matching in Strings"
-;;;     Alfred V. Aho
-;;;     Formal Language Theory - Perspectives and Open Problems
-;;;     Ronald V. Brook (editor)
-;;; This algorithm is O(m + n) where m and n are the 
-;;; lengths of the pattern and string respectively
-;;; Original version of this code by bevan; I have substantially rehacked it.
-
-(define (substring? pattern source . maybe-start+end)
-  (let-start+end (start end) substring? source maybe-start+end
-    (really-substring? char=? pattern source start end)))
-
-(define (substring-ci? pattern source . maybe-start+end)
-  (let-start+end (start end) substring-ci? source maybe-start+end
-    (really-substring? char-ci=? pattern source start end)))
-
-;;; Compute the Knuth-Morris-Pratt restart vector RV for string PATTERN.  If
-;;; we have matched chars 0..i-1 of PATTERN against a search string S, and
-;;; PATTERN[i] doesn't match S[k], then reset i := RV[i], and try again to
-;;; match S[k].  If RV[i] = -1, then punt S[k] completely, and move on to
-;;; S[k+1] and PATTERN[0].
-;;;
-;;; In other words, if you have matched the first i chars of PATTERN, but
-;;; the i+1'th char doesn't match, RV[i] tells you what the next-longest
-;;; prefix of PATTERN is that you have matched.
-;;;
-;;; C= is the character comparator -- usefully CHAR= or CHAR-CI=.
-;;;
-;;; I've split this out as a separate function in case other constant-string
-;;; searchers might want to use it.
-
-(define (make-kmp-restart-vector pattern c=)
-  (let* ((plen (string-length pattern))
-	 (rv (make-vector plen)))
-    (if (> plen 0)
-	(let ((plen-1 (- plen 1)))
-	  (vector-set! rv 0 -1)
-	  (let lp ((i 0) (j -1))
-	    (if (< i plen-1)
-		(if (or (= j -1)
-			(c= (string-ref pattern i)
-			    (string-ref pattern j)))
-		    (let ((i (+ 1 i))
-			  (j (+ 1 j)))
-		      (vector-set! rv i j)
-		      (lp i j))
-		    (lp i (vector-ref rv j)))))))
-    rv))
-
-(define (really-substring? c= pattern source start end)
-  (let ((plen (string-length pattern))
-	(rv (make-kmp-restart-vector pattern c=)))
-
-    ;; The search loop. SJ & PJ are redundant state.
-    (let lp ((si start) (pi 0)
-	     (sj (- end start))	; (- end si)  -- how many chars left.
-	     (pj plen))		; (- plen pi) -- how many chars left.
-
-      (if (= pi plen) (- si plen)			; Win.
-
-	  (and (<= pj sj)				; Lose.
-		     
-	       (if (c= (string-ref source si)		; Search.
-		       (string-ref pattern pi))
-		   (lp (+ 1 si) (+ 1 pi) (- sj 1) (- pj 1))	; Advance.
-			 
-		   (let ((pi (vector-ref rv pi)))		; Retreat.
-		     (if (= pi -1)
-			 (lp (+ si 1)  0   (- sj 1)  plen)	; Punt.
-			 (lp si        pi  sj        (- plen pi))))))))))
-
-
-
-;;; Misc
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; (string-reverse  s [start end])
-;;; (string-reverse! s [start end])
-;;; (string-null? s)
-
-(define (string-null? s) (zero? (string-length s)))
-
-(define (string-reverse s . maybe-start+end)
-  (let-start+end (start end) string-reverse s maybe-start+end
-    (let ((ans (make-string (- end start))))
-      (do ((i (- end 1) (- i 1))
-	   (j start (+ j 1)))
-	  ((< i j))
-	(string-set! ans i (string-ref s j))
-	(string-set! ans j (string-ref s i)))
-      ans)))
-
-(define (string-reverse! s . maybe-start+end)
-  (let-start+end (start end) string-reverse! s maybe-start+end
-    (do ((i (- end 1) (- i 1))
-	 (j start (+ j 1)))
-	((<= i j))
-      (let ((ci (string-ref s i)))
-	(string-set! s i (string-ref s j))
-	(string-set! s j ci)))))
-
-
-; This is a perfectly good definition of REVERSE-LIST->STRING,
-; but S48 has it as a machine op.
-;(define (reverse-list->string clist)
-;  (let* ((len (length clist))
-;	 (s (make-string len)))
-;    (do ((i (- len 1) (- i 1))   (clist clist (cdr clist)))
-;	((not (pair? clist)))
-;      (string-set! s i (car clist)))
-;    s))
-
-(define reverse-list->string (structure-ref silly reverse-list->string))
-
-;(define (string->list s . maybe-start+end)
-;  (let-start+end (start end) string->list s maybe-start+end
-;    (do ((i (- end 1) (- i 1))
-;	 (ans '() (cons (string-ref s i) ans)))
-;	((< i start) ans))))
-
-(define (string->list s . maybe-start+end)
-  (apply string-fold-right s cons '() maybe-start+end))
-
-
-
-;;; string-concat        string-list -> string
-;;; string-concat/shared string-list -> string
-;;; string-append/shared s ... -> string
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; STRING-APPEND/SHARED has license to return a string that shares storage
-;;; with any of its arguments. In particular, if there is only one non-empty
-;;; string amongst its parameters, it is permitted to return that string as
-;;; its result. STRING-APPEND, by contrast, always allocates new storage.
-;;;
-;;; STRING-CONCAT & STRING-CONCAT/SHARED are passed a list of strings,
-;;; which they concatenate into a result string. STRING-CONCAT always
-;;; allocates a fresh string; STRING-CONCAT/SHARED may (or may not) return
-;;; a result that shares storage with any of its arguments. In particular,
-;;; if it is applied to a singleton list, it is permitted to return the
-;;; car of that list as its value.
-;;;
-;;; This is portable code, but could be much more efficient w/compiler
-;;; support. Especially the n-ary guys.
-
-;;; We delete the empty strings from the parameter list before handing
-;;; off to string-concat/shared.
-
-(define (string-append/shared . strings)
-  (string-concat/shared (fold-right (lambda (s lis)
-				      (if (string-null? s) lis (cons s lis)))
-				    '()
-				    strings)))
-
-(define (string-concat/shared strings)
-  (cond ((not (pair? strings)) "")			; () => "".
-	((not (pair? (cdr strings))) (car strings))	; (s) => s.
-	(else (apply string-append strings))))	; Allocate & concat.
-
-(define (string-concat strings) (apply string-append strings))
-
-
-
-;;; xsubstring s from [to start end] -> string
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; S is a string; START and END are optional arguments that demarcate
-;;; a substring of S, defaulting to 0 and the length of S (e.g., the whole
-;;; string). Replicate this substring up and down index space, in both the
-;;  positive and negative directions. For example, if S = "abcdefg", START=3, 
-;;; and END=6, then we have the conceptual bidirectionally-infinite string
-;;;     ...  d  e  f  d  e  f  d  e  f  d  e  f  d  e  f  d  e  f  d  e  f ...
-;;;     ... -9 -8 -7 -6 -5 -4 -3 -2 -1  0  1  2  3  4  5  6  7  8  9 ...
-;;; XSUBSTRING returns the substring of this string beginning at index FROM,
-;;; and ending at TO (which defaults to FROM+(END-START)).
-;;; 
-;;; You can use XSUBSTRING in many ways:
-;;; - To rotate a string left:  (xsubstring "abcdef" 2)  => "cdefab"
-;;; - To rotate a string right: (xsubstring "abcdef" -2) => "efabcd"
-;;; - To replicate a string:    (xsubstring "abc" 0 7) => "abcabca"
-;;;
-;;; Note that 
-;;;   - The FROM/TO indices give a half-open range -- the characters from
-;;;     index FROM up to, but not including index TO.
-;;;   - The FROM/TO indices are not in terms of the index space for string S.
-;;;     They are in terms of the replicated index space of the substring
-;;;     defined by S, START, and END.
-;;;
-;;; It is an error if START=END -- although this is allowed by special
-;;; dispensation when FROM=TO.
-
-(define (xsubstring s from . maybe-to+start+end)
-  (receive (to start end)
-           (if (pair? maybe-to+start+end)
-	       (let-start+end (start end) xsubstring s (cdr maybe-to+start+end)
-		 (values (car maybe-to+start+end) start end))
-	       (let ((slen (string-length s)))
-		 (values (+ from slen) 0 slen)))
-    (let ((slen   (- end start))
-	  (anslen (- to  from)))
-      (cond ((< anslen 0)
-	     (error "Illegal FROM/TO spec passed to xsubstring -- FROM > TO."
-		    s from to start end))
-
-	    ((zero? anslen) "")
-	    ((zero? slen) (error "Empty (sub)string passed to xsubstring"
-				  s from to start end))
-
-	    ((= 1 slen)		; Fast path for 1-char replication.
-	     (make-string anslen (string-ref s start)))
-
-	    ;; Selected text falls entirely within one span.
-	    ((= (floor (/ from slen)) (floor (/ to slen)))
-	     (substringx s (+ start (modulo from slen))
-			   (+ start (modulo to   slen))))
-
-	    ;; Selected text requires multiple spans.
-	    (else (let ((ans (make-string anslen)))
-		    (multispan-repcopy! ans 0 s from to start end)
-		    ans))))))
-
-
-;;; string-xcopy! target tstart s sfrom [sto start end] -> unspecific
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Exactly the same as xsubstring, but the extracted text is written
-;;; into the string TARGET starting at index TSTART.
-;;; This operation is not defined if (EQ? TARGET S) -- you cannot copy
-;;; a string on top of itself.
-
-(define (string-xcopy! target tstart s sfrom . maybe-sto+start+end)
-  (receive (sto start end)
-           (if (pair? maybe-sto+start+end)
-	       (let-start+end (start end) string-xcopy! s (cdr maybe-sto+start+end)
-		 (values (car maybe-sto+start+end) start end))
-	       (let ((slen (string-length s)))
-		 (values (+ sfrom slen) 0 slen)))
-
-    (let* ((tocopy (- sto sfrom))
-	   (tend (+ tstart tocopy))
-	   (slen (- end start)))
-      (check-substring-spec string-xcopy! target tstart tend)
-      (cond ((< tocopy 0)
-	     (error "Illegal FROM/TO spec passed to string-xcopy! -- FROM > TO."
-		    target tstart s sfrom sto start end))
-	    ((zero? tocopy))
-	    ((zero? slen) (error "Empty (sub)string passed to string-xcopy!"
-				  target tstart s sfrom sto start end))
-
-	    ((= 1 slen)			; Fast path for 1-char replication.
-	     (string-fill! target (string-ref s start) tstart tend))
-
-	    ;; Selected text falls entirely within one span.
-	    ((= (floor (/ sfrom slen)) (floor (/ sto slen)))
-	     (string-copy! target tstart s 
-			   (+ start (modulo sfrom slen))
-			   (+ start (modulo sto   slen))))
-
-	    ;; Multi-span copy.
-	    (else (multispan-repcopy! target tstart s sfrom sto start end))))))
-
-;;; This is the core copying loop for XSUBSTRING and STRING-XCOPY!
-;;; Internal -- not exported, no careful arg checking.
-(define (multispan-repcopy! target tstart s sfrom sto start end)
-  (let* ((slen (- end start))
-	 (i0 (+ start (modulo sfrom slen)))
-	 (total-chars (- sto sfrom)))
-
-    ;; Copy the partial span @ the beginning
-    (string-copy! target tstart s i0 end)
-		    
-    (let* ((ncopied (- end i0))			; We've copied this many.
-	   (nleft (- total-chars ncopied))	; # chars left to copy.
-	   (nspans (quotient nleft slen)))	; # whole spans to copy
-			   
-      ;; Copy the whole spans in the middle.
-      (do ((i (+ tstart ncopied) (+ i slen))	; Current target index.
-	   (nspans nspans (- nspans 1)))	; # spans to copy
-	  ((zero? nspans)
-	   ;; Copy the partial-span @ the end & we're done.
-	   (string-copy! target i s start (+ start (- total-chars (- i tstart)))))
-
-	(string-copy! target i s start end))))) ; Copy a whole span.
-
-
-
-;;; (join-strings string-list [delimiter grammar]) => string
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Paste strings together using the delimiter string.
-;;;
-;;; (join-strings '("foo" "bar" "baz") ":") => "foo:bar:baz"
-;;;
-;;; DELIMITER defaults to a single space " "
-;;; GRAMMAR is one of the symbols {infix, suffix} and defaults to 'infix.
-
-;;; (join-strings strings [delim grammar])
-
-(define (join-strings strings . args)
-  (if (pair? strings)
-      (let-optionals args ((delim " ") (grammar 'infix))
-	(let ((strings (reverse strings)))
-	  (let lp ((strings (cdr strings))
-		   (ans (case grammar
-			  ((infix)  (list (car strings)))
-			  ((suffix) (list (car strings) delim))
-			  (else (error "Illegal join-strings grammar" grammar)))))
-	    (if (pair? strings)
-		(lp (cdr strings)
-		    (cons (car strings) (cons delim ans)))
-	  
-		; All done
-		(apply string-append ans)))))
-
-      ""))	; Special-cased for infix grammar.
-
-
-
-;;; MIT Scheme copyright terms
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; This material was developed by the Scheme project at the Massachusetts
-;;; Institute of Technology, Department of Electrical Engineering and
-;;; Computer Science.  Permission to copy and modify this software, to
-;;; redistribute either the original software or a modified version, and
-;;; to use this software for any purpose is granted, subject to the
-;;; following restrictions and understandings.
-;;; 
-;;; 1. Any copy made of this software must include this copyright notice
-;;; in full.
-;;; 
-;;; 2. Users of this software agree to make their best efforts (a) to
-;;; return to the MIT Scheme project any improvements or extensions that
-;;; they make, so that these may be included in future releases; and (b)
-;;; to inform MIT of noteworthy uses of this software.
-;;; 
-;;; 3. All materials developed as a consequence of the use of this
-;;; software shall duly acknowledge such use, in accordance with the usual
-;;; standards of acknowledging credit in academic research.
-;;; 
-;;; 4. MIT has made no warrantee or representation that the operation of
-;;; this software will be error-free, and MIT is under no obligation to
-;;; provide any services, by way of maintenance, update, or otherwise.
-;;; 
-;;; 5. In conjunction with products arising from the use of this material,
-;;; there shall be no use of the name of the Massachusetts Institute of
-;;; Technology nor of any adaptation thereof in any advertising,
-;;; promotional, or sales literature without prior written consent from
-;;; MIT in each case.
diff --git a/scsh/stringpack.scm b/scsh/stringpack.scm
deleted file mode 100644
index 1c65845..0000000
--- a/scsh/stringpack.scm
+++ /dev/null
@@ -1,380 +0,0 @@
-(define-interface string-lib-interface
-  (export
-   ;; string-map proc s [start end] -> s
-   (string-map (proc ((proc (:char) :char)
-		      :string
-		      &opt :exact-integer :exact-integer)
-		     :string))
-
-   ;; string-map! proc s [start end] -> unspecific
-   (string-map! (proc ((proc (:char) :values)
-		       :string
-		       &opt :exact-integer :exact-integer)
-		      :unspecific))
-
-   ;; string-fold       kons knil s [start end] -> value
-   ;; string-fold-right kons knil s [start end] -> value
-   ((string-fold string-fold-right)
-    (proc ((proc (:char :value) :value)
-	   :value :string
-	   &opt :exact-integer :exact-integer)
-	  :value))
-
-   ;; string-unfold p f g seed -> string
-   (string-unfold (proc ((proc (:value) :boolean)
-			 (proc (:value) :char)
-			 (proc (:value) :value)
-			 :value)
-			:string))
-
-;   Enough is enough.
-;   ;; string-unfoldn p f g seed ... -> string
-;   (string-unfoldn (proc ((procedure :values :boolean)
-;                          (procedure :values :char)
-;                          (procedure :values :values)
-;                          &rest :value)
-;                         :string))
-
-   ;; string-tabulate proc len -> string
-   (string-tabulate (proc ((proc (:exact-integer) :char) :exact-integer)
-			  :string))
-
-   ;; string-for-each proc s [start end] -> unspecific
-   ;; string-iter     proc s [start end] -> unspecific
-   ((string-for-each string-iter)
-    (proc ((proc (:char) :values) :string &opt :exact-integer :exact-integer)
-	  :unspecific))
-
-   ;; string-every? pred s [start end]
-   ;; string-any    pred s [start end]
-   (string-every?
-    (proc ((proc (:char) :boolean) :string &opt :exact-integer :exact-integer)
-	  :boolean))
-   (string-any
-    (proc ((proc (:char) :boolean) :string &opt :exact-integer :exact-integer)
-	  :value))
-
-   ;; string-compare    string1 string2 lt-proc eq-proc gt-proc
-   ;; string-compare-ci string1 string2 lt-proc eq-proc gt-proc
-   ((string-compare string-compare-ci)
-    (proc (:string :string (proc (:exact-integer) :values)
-		           (proc (:exact-integer) :values)
-			   (proc (:exact-integer) :values))
-	  :values))
-
-   ;; substring-compare    string1 start1 end1 string2 start2 end2 lt eq gt 
-   ;; substring-compare-ci string1 start1 end1 string2 start2 end2 lt eq gt 
-   ((substring-compare substring-compare-ci)
-    (proc (:string :exact-integer :exact-integer
-	   :string :exact-integer :exact-integer
-	   (proc (:exact-integer) :values)
-	   (proc (:exact-integer) :values)
-	   (proc (:exact-integer) :values))
-	  :values))
-
-   ;; string< string1 string2
-   ((string= string< string> string<= string>= string<>
-     string-ci= string-ci< string-ci> string-ci<= string-ci>= string-ci<>)
-    (proc (&rest :string) :value)) 
-
-   ;; substring< string1 start1 end1 string2 start2 end2 
-   ((substring=     substring<>		substring-ci=  substring-ci<>
-     substring<     substring>		substring-ci<  substring-ci>
-     substring<=    substring>=		substring-ci<= substring-ci>=)
-    (proc (:string :exact-integer :exact-integer
-	   :string :exact-integer :exact-integer)
-	  :value))
-
-   ;; string-upper-case? string [start end]
-   ;; string-lower-case? string [start end]
-   ((string-upper-case? string-lower-case?)
-    (proc (:string &opt  :exact-integer :exact-integer) :boolean))
-
-   ;; capitalize-string  string [start end]
-   ;; capitalize-words   string [start end]
-   ;; string-downcase    string [start end]
-   ;; string-upcase      string [start end]
-   ;; capitalize-string! string [start end]
-   ;; capitalize-words!  string [start end]
-   ;; string-downcase!   string [start end]
-   ;; string-upcase!     string [start end]
-   ((capitalize-string capitalize-words string-downcase string-upcase)
-    (proc (:string &opt :exact-integer :exact-integer) :string))
-   ((capitalize-string! capitalize-words! string-downcase! string-upcase!)
-    (proc (:string &opt :exact-integer :exact-integer) :unspecific))
-
-   ;; string-take string nchars
-   ;; string-drop string nchars
-   ((string-take string-drop) (proc (:string :exact-integer) :string))
-
-   ;; string-padl string k [char start end] 
-   ;; string-padr string k [char start end] 
-   ((string-padl string-padr)
-    (proc (:string :exact-integer &opt :char :exact-integer :exact-integer)
-	  :string))
-
-   ;; string-trim  string [char/char-set/pred start end] 
-   ;; string-triml string [char/char-set/pred start end] 
-   ;; string-trimr string [char/char-set/pred start end] 
-   ((string-trim string-triml string-trimr)
-    (proc (:string &opt :value :exact-integer :exact-integer)
-	  :string))
-
-   ;; string-filter char/char-set/pred string [start end]
-   ;; string-delete char/char-set/pred string [start end]
-   ((string-filter string-delete)
-    (proc (:value :string &opt :exact-integer :exact-integer) :string))
-
-   ;; string-index       string char/char-set/pred [start end]
-   ;; string-index-right string char/char-set/pred [end start]
-   ;; string-skip        string char/char-set/pred [start end]
-   ;; string-skip-right  string char/char-set/pred [end start]
-   ((string-index string-index-right string-skip string-skip-right)
-    (proc (:string :value &opt :exact-integer :exact-integer)
-	  :value))
-
-   ;; string-prefix-count    string1 string2
-   ;; string-suffix-count    string1 string2
-   ;; string-prefix-count-ci string1 string2
-   ;; string-suffix-count-ci string1 string2
-   ((string-prefix-count string-prefix-count-ci
-     string-suffix-count string-suffix-count-ci)
-    (proc (:string :string) :exact-integer))
-
-   ;; substring-prefix-count    string1 start1 end1 string2 start2 end2
-   ;; substring-suffix-count    string1 start1 end1 string2 start2 end2
-   ;; substring-prefix-count-ci string1 start1 end1 string2 start2 end2
-   ;; substring-suffix-count-ci string1 start1 end1 string2 start2 end2
-   ((substring-prefix-count substring-prefix-count-ci
-     substring-suffix-count substring-suffix-count-ci)
-    (proc (:string :exact-integer :exact-integer
-	   :string :exact-integer :exact-integer)
-	  :exact-integer))
-
-
-   ;; string-prefix?    string1 string2 
-   ;; string-suffix?    string1 string2 
-   ;; string-prefix-ci? string1 string2 
-   ;; string-suffix-ci? string1 string2 
-   ((string-prefix? string-prefix-ci?
-     string-suffix? string-suffix-ci?)
-    (proc (:string :string) :boolean))
-
-   ;; substring-prefix?    string1 start1 end1 string2 start2 end2 
-   ;; substring-suffix?    string1 start1 end1 string2 start2 end2 
-   ;; substring-prefix-ci? string1 start1 end1 string2 start2 end2 
-   ;; substring-suffix-ci? string1 start1 end1 string2 start2 end2 
-   ((substring-prefix? substring-prefix-ci?
-     substring-suffix? substring-suffix-ci?)
-    (proc (:string :exact-integer :exact-integer
-	   :string :exact-integer :exact-integer)
-	  :boolean))
-
-   ;; substring?    pattern string [start end]
-   ;; substring-ci? pattern string [start end]
-   ((substring? substring-ci?)
-    (proc (:string :string &opt :exact-integer :exact-integer)
-	  :value))
-
-   ;; string-fill! string char [start end]
-   (string-fill! (proc (:string :char &opt :exact-integer :exact-integer)
-		       :unspecific))
-
-   ;; string-copy! to tstart from [fstart fend]
-   (string-copy! (proc (:string :exact-integer :string
-				&opt :exact-integer :exact-integer)
-		       :unspecific))
-
-   ;; string-copy s [start end] -> string
-   ;; substring   s start [end] -> string
-   (string-copy (proc (:string &opt :exact-integer :exact-integer) :string))
-   (substring   (proc (:string :exact-integer &opt :exact-integer) :string))
-
-   ;; string-reverse  s [start end]
-   ;; string-reverse! s [start end]
-   (string-reverse  (proc (:string &opt :exact-integer :exact-integer) :string))
-   (string-reverse! (proc (:string &opt :exact-integer :exact-integer) :unspecific))
-
-   ;; reverse-list->string char-list
-   ;; string->list s [start end]
-   ;; string-concat        string-list
-   ;; string-concat/shared string-list
-   ;; string-append/shared s ...
-   (reverse-list->string (proc (:value) :string))
-   (string->list (proc (:string &opt :exact-integer :exact-integer) :value))
-   ((string-concat string-concat/shared) (proc (:value) :string))
-   (string-append/shared (proc (&rest :string) :string))
-
-   ;; xsubstring s from [to start end]
-   ;; string-xcopy! target tstart s from [to start end]
-   (xsubstring (proc (:string :exact-integer &opt
-			      :exact-integer :exact-integer :exact-integer)
-		     :string))
-   (string-xcopy! (proc (:string :exact-integer :string :exact-integer &opt
-				 :exact-integer :exact-integer :exact-integer)
-			:unspecific))
-
-   ;; string-null? s
-   (string-null? (proc (:string) :boolean))
-
-   (join-strings (proc (:value &opt :string :symbol) :string))
-
-   ;; Here are the R4RS procs
-   (string? (proc (:value) :boolean))
-   (make-string (proc (:exact-integer &opt :char) :string))
-   (string (proc (&rest :char) :string))
-   (string-length (proc (:string) :exact-integer))
-   (string-ref (proc (:string :exact-integer) :char))
-   (string-set! (proc (:string :exact-integer :char) :unspecific))
-
-   ; Not provided by string-lib.
-   ;((string=?  string-ci=?	string<?  string-ci<?
-   ;  string>?  string-ci>?	string<=? string-ci<=?
-   ;  string>=? string-ci>=?) (proc (:string :string) :boolean))
-
-   ;; These are the R4RS types for SUBSTRING, STRING-COPY, STRING-FILL!,
-   ;; and STRING->LIST. The string-lib types are different -- extended.
-   ;(substring (proc (:string :exact-integer :exact-integer) :string))
-   ;(string-copy (proc (:string) :string))
-   ;(string-fill! (proc (:string :char) :unspecific))
-   ;(string->list (proc (:string) :value))
-
-   (string-append (proc (&rest :string) :string))
-   (list->string (proc (:value) :string))
-   ))
-
-
-(define-interface string-lib-internals-interface
-  (export
-   (parse-final-start+end (proc ((procedure :values :values) :string :value)
-				(some-values :exact-integer :exact-integer)))
-   (parse-start+end (proc ((procedure :values :values) :string :value)
-			  (some-values :exact-integer :exact-integer :value)))
-   (check-substring-spec (proc ((procedure :values :values) :string :exact-integer :exact-integer)
-			       :unspecific))
-   (make-kmp-restart-vector (proc (:string (proc (:char :char) :boolean))
-				  :vector))))
-
-
-(define-structures ((string-lib string-lib-interface)
-		    (string-lib-internals string-lib-internals-interface))
-  (open char-set-package
-	receiving
-	error-package
-	let-opt
-	structure-refs
-	scsh-utilities	; FOLD-RIGHT
-	scheme)
-  (access scheme	; Original SUBSTRING
-	  silly)	; Primitive reverse-list->string
-  (files stringlib)
-  (optimize auto-integrate))
-
-
-
-;;; CPP Lib
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Character->Character Partial functions
- 
-;;; Many of these types are pretty weak, but there is no way to
-;;; specify that a parameter must be a particular record type.
-;;; Every little bit helps, though.
-
-(define-interface ccp-lib-interface
-  (export
-   ;; ccp? x -> boolean
-   (ccp? (proc (:value) :boolean))
-
-   ;; ccp-domain ccp -> char-set
-   (ccp-domain (proc (:value) :value)) ; Not very informative.
-
-   ;; ccp-copy ccp -> ccp
-   (ccp-copy (proc (:value) :value))
-
-   ;; ccp=  ccp1 ccp2 ...
-   ;; ccp<= ccp1 ccp2 ...
-   ((ccp= ccp<=) (proc (&rest :value) :boolean)) ; Not very informative.
-
-   ;; ccp-fold kons knil ccp -> value
-   (ccp-fold (proc ((proc (:char :char :value) :value) :value :value) :value))
-   
-   ;; ccp-for-each proc ccp
-   (ccp-for-each (proc ((proc (:char :char) :values)) :unspecific))
-
-   ;; ccp->alist ccp -> alist
-   (ccp->alist (proc (:value) :value))
-
-   ;; ccp-restrict  ccp cset -> ccp
-   ;; ccp-restrict! ccp cset -> ccp
-   ((ccp-restrict ccp-restrict!) (proc (:value :value) :value))
-
-   ;; ccp-adjoin  ccp from-char1 to-char1 ... -> ccp
-   ;; ccp-adjoin! ccp from-char1 to-char1 ... -> ccp
-   ;; ccp-delete  ccp from-char1 ... -> ccp
-   ;; ccp-delete! ccp from-char1 ... -> ccp
-   ((ccp-adjoin ccp-adjoin!) (proc (:value &rest :char) :value))
-   ((ccp-delete ccp-delete!) (proc (:value &rest :char) :value))
-
-   ;; ccp-extend  ccp1 ... -> ccp
-   ;; ccp-extend! ccp1 ... -> ccp
-   ((ccp-extend ccp-extend!) (proc (&rest :value) :value))
-
-   ;; ccp-compose ccp1 ... -> ccp
-   (ccp-compose (proc (&rest :value) :value))
-
-   ;; alist->ccp  char/char-alist [ccp] -> ccp
-   ;; alist->ccp! char/char-alist [ccp] -> ccp
-   ((alist->ccp alist->ccp!) (proc (:value &opt :value) :value))
-
-   ;; proc->ccp  proc [domain ccp] -> ccp
-   ;; proc->ccp! proc [domain ccp] -> ccp
-   ((proc->ccp proc->ccp!) (proc ((proc (:char) :char) &opt :value :value)
-				 :value))
-
-   ;; constant-ccp  char [domain ccp] -> ccp
-   ;; constant-ccp! char  domain ccp  -> ccp
-   ((constant-ccp constant-ccp!) (proc (:char &opt :value :value) :value))
-
-   ;; ccp/mappings from1 to1 ... -> ccp
-   ;; extend-ccp/mappings  ccp from1 to1 ... -> ccp
-   ;; extend-ccp/mappings! ccp from1 to1 ... -> ccp
-   (ccp/mappings (proc (&rest :value) :value))
-   ((extend-ccp/mappings extend-ccp/mappings!)
-    (proc (:value &rest :value) :value))
-
-   ;; construct-ccp  ccp elt ... -> ccp
-   ;; construct-ccp! ccp elt ... -> ccp
-   ((construct-ccp construct-ccp!) (proc (:value &rest :value) :value))
-
-   ;; ccp-unfold p f g seed -> ccp
-   (ccp-unfold (proc ((proc (:value) :boolean)
-		      (procedure :value (some-values :char :char))
-		      (proc (:value) :value)
-		      :value)
-		     :value))
-
-   ;; tr       ccp string [start end] -> string
-   ;; ccp-map  ccp string [start end] -> string
-   ;; ccp-map! ccp string [start end]
-   ;; ccp-app ccp char -> char or false
-   ((tr ccp-map)
-    (proc (:value :string &opt :exact-integer :exact-integer) :string))
-   (ccp-map! (proc (:value :string &opt :exact-integer :exact-integer) :unspecific))
-   (ccp-app (proc (:value :char) :value))
-
-   ;; Primitive CCP's.
-   ccp:0 ccp:1 ccp:upcase ccp:downcase
-   ))
-
-(define-structure ccp-lib ccp-lib-interface
-  (open char-set-package
-	ascii
-	defrec-package
-	string-lib
-	let-opt
-	receiving
-	scsh-utilities	; every
-	error-package
-	scheme)
-  (files ccp)
-  (optimize auto-integrate))