From 09db2fed716b254dd90415037dead41e15b0efcd Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Wed, 14 Aug 2002 14:45:33 +0000
Subject: [PATCH] Remove a bunch of crud from utilities.scm as well as the
 dependencies upon that crud.

---
 scsh/newports.scm        |   4 ++
 scsh/procobj.scm         |   2 +-
 scsh/rx/packages.scm     |   9 ++--
 scsh/scsh-interfaces.scm |  12 ++---
 scsh/scsh-package.scm    |   4 +-
 scsh/scsh.scm            |  20 +++++---
 scsh/utilities.scm       | 100 ---------------------------------------
 7 files changed, 30 insertions(+), 121 deletions(-)

diff --git a/scsh/newports.scm b/scsh/newports.scm
index ae8ff18..986275a 100644
--- a/scsh/newports.scm
+++ b/scsh/newports.scm
@@ -346,6 +346,10 @@
   (let ((flags (:optional maybe-flags 0)))
     (open-file fname (deposit-bit-field flags open/access-mask open/read))))
 
+(define (deposit-bit-field bits mask field)
+  (bitwise-ior (bitwise-and field mask)
+	       (bitwise-and bits  (bitwise-not mask))))
+
 (define (open-output-file fname . rest)
   (let* ((flags (if (pair? rest) (car rest)
 		    (bitwise-ior open/create open/truncate))) ; default
diff --git a/scsh/procobj.scm b/scsh/procobj.scm
index 3f3b9e0..f2c7723 100644
--- a/scsh/procobj.scm
+++ b/scsh/procobj.scm
@@ -197,7 +197,7 @@
 
 (define (need-reaping-remove! pid)
   (obtain-lock need-reaping-lock)
-  (set! need-reaping (del pid need-reaping))
+  (set! need-reaping (delete pid need-reaping))
   (release-lock need-reaping-lock))
 
 (define (reap-need-reaping)
diff --git a/scsh/rx/packages.scm b/scsh/rx/packages.scm
index 5e65c43..73434ce 100644
--- a/scsh/rx/packages.scm
+++ b/scsh/rx/packages.scm
@@ -225,8 +225,7 @@
 					      static-regexp?))
 		    (standard-char-sets (export nonl-chars word-chars))
 		    (sre-internal-syntax-tools (export expand-rx)))
-  (open scsh-utilities
-	defrec-package
+  (open defrec-package
 	weak		
 	;; re-posix-parsers	; regexp->posix-string
 	let-opt
@@ -235,6 +234,8 @@
 	define-record-types
 	defrec-package
 	receiving
+	scsh-utilities
+	(subset srfi-1 (fold every fold-right))
 	srfi-14
 	error-package
 	ascii
@@ -275,8 +276,8 @@
   (open re-internals
 	conditionals
 	re-level-0
+	(subset srfi-1 (fold))
 	srfi-14
-	scsh-utilities	; fold
 	error-package
 	ascii
 	scheme)
@@ -330,7 +331,7 @@
   (open re-level-0
 	re-match-internals
 	posix-regexps
-	scsh-utilities	; fold & some string utilities that need to be moved.
+	(subset srfi-1 (fold))
 	scsh-level-0	; write-string
 	srfi-13		; string-copy!
 	scheme)
diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm
index 3a40d21..fdf4ce7 100644
--- a/scsh/scsh-interfaces.scm
+++ b/scsh/scsh-interfaces.scm
@@ -591,14 +591,11 @@
 
 
 (define-interface scsh-utilities-interface
-  (export del first? filter fold-right
-	  fold
-	  any every nth
-	  mapv mapv! vector-every? copy-vector initialize-vector vector-append
+  (export mapv mapv! vector-every? copy-vector initialize-vector vector-append
 	  vfold vfold-right
-	  check-arg conjoin disjoin negate compose reverse! call/cc
+	  check-arg conjoin disjoin negate compose
 	  deprecated-proc
-	  deposit-bit-field
+	  ;; deposit-bit-field
 	  real->exact-integer
 	  make-reinitializer
 	  run-as-long-as
@@ -716,8 +713,7 @@
   (export join-strings
 	  field-splitter infix-splitter suffix-splitter sloppy-suffix-splitter
 	  record-reader
-	  field-reader
-	  nth))		; Kinda handy.
+	  field-reader))
 
 (define-interface scsh-delimited-readers-interface
   (export read-line
diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm
index 7f94e49..eeb554a 100644
--- a/scsh/scsh-package.scm
+++ b/scsh/scsh-package.scm
@@ -168,6 +168,7 @@
 	bitwise
 	signals
 	conditions
+	(subset srfi-1 (filter reverse! fold delete))
 	scsh-utilities
 	handle
 	fluids thread-fluids
@@ -371,7 +372,8 @@
    (awk-support-package (export next-range next-:range
 				next-range: next-:range:)))
   (open receiving		; receive
-	scsh-utilities	
+	;; scsh-utilities	
+	(subset srfi-1 (any filter))
 	error-package		; error
 ;	scsh-regexp-package
 ;	re-exports
diff --git a/scsh/scsh.scm b/scsh/scsh.scm
index c62b61a..f4f3bae 100644
--- a/scsh/scsh.scm
+++ b/scsh/scsh.scm
@@ -932,13 +932,19 @@
 		     thing))))
 
 (define (exec-path-search prog path-list)
-  (if (file-name-absolute? prog)
-      (and (file-executable? prog) prog)
-      (first? (lambda (dir)
-		(let ((fname (string-append dir "/" prog)))
-		  (and (file-executable? fname) fname)))
-	     path-list)))
-		    
+  (cond
+   ((not (file-name-absolute? prog))
+    (let loop ((path-list path-list))
+      (if (not (null? path-list))
+	  (let* ((dir (car path-list))
+		 (fname (string-append dir "/" prog)))
+	    (if (file-executable? fname)
+		fname
+		(loop (cdr path-list)))))))
+   ((file-executable? prog)
+    prog)
+   (else #f)))
+
 (define (exec/env prog env . arglist)
   (flush-all-ports)
   (with-resources-aligned (list environ-resource cwd-resource umask-resource)
diff --git a/scsh/utilities.scm b/scsh/utilities.scm
index 3d6a839..699aec2 100644
--- a/scsh/utilities.scm
+++ b/scsh/utilities.scm
@@ -1,54 +1,6 @@
 ;;; Random useful utilities.
 ;;; Copyright (c) 1993 by Olin Shivers.
 
-(define (del elt lis)
-  (letrec ((del (lambda (lis)
-		  (if (pair? lis)
-		      (let* ((head (car lis))
-			     (tail (cdr lis))
-			     (new-tail (del tail)))
-			(if (equal? head elt) new-tail
-			    (if (eq? tail new-tail) lis
-				(cons head new-tail))))
-		      '()))))
-    (del lis)))
-
-(define (index str c . maybe-start)
-  (let ((start (max 0 (:optional maybe-start 0)))
-	(len (string-length str)))
-    (do ((i start (+ 1 i)))
-	((or (>= i len)
-	     (char=? c (string-ref str i)))
-	 (and (< i len) i)))))
-
-(define (rindex str c . maybe-start)
-  (let* ((len (string-length str))
-	 (start (min (:optional maybe-start len)
-		     len)))
-    (do ((i (- start 1) (- i 1)))
-	((or (< i 0)
-	     (char=? c (string-ref str i)))
-	 (and (>= i 0) i)))))
-
-;;; Returns the first true value produced by PRED, not the list element
-;;; that satisfied PRED.
-
-(define (first? pred list)
-  (letrec ((lp (lambda (list)
-		 (and (pair? list)
-		      (or (pred (car list))
-			  (lp (cdr list)))))))
-    (lp list)))
-
-(define any? first?)
-
-(define (every? pred list)
-  (letrec ((lp (lambda (list)
-		 (or (not (pair? list))
-		     (and (pred (car list))
-			  (lp (cdr list)))))))
-    (lp list)))
-
 (define (mapv f v)
   (let* ((len (vector-length v))
 	 (ans (make-vector len)))
@@ -127,30 +79,6 @@
 (define (compose f g)
   (lambda args (call-with-values (lambda () (apply g args)) f)))
 
-
-(define (reverse! lis)
-  (let lp ((lis lis) (prev '()))
-    (if (not (pair? lis)) prev
-	(let ((tail (cdr lis)))
-	  (set-cdr! lis prev)
-	  (lp tail lis)))))
-
-(define call/cc call-with-current-continuation)
-
-(define (deposit-bit-field bits mask field)
-  (bitwise-ior (bitwise-and field mask)
-	       (bitwise-and bits  (bitwise-not mask))))
-
-
-(define (nth lis i)
-  (if (< i 0) (error "nth: illegal list index" i)
-      (let lp ((l lis) (i i))
-	(if (pair? l)
-	    (if (zero? i) (car l)
-		(lp (cdr l) (- i 1)))
-	    (error "nth: index too large" lis i)))))
-
-
 (define (deprecated-proc proc name . maybe-preferred-msg)
   (let ((warned? #f))
     (lambda args
@@ -167,34 +95,6 @@
   (let ((f (round x)))
     (if (inexact? f) (inexact->exact f) f)))
 
-
-;;; Copy string SOURCE into TARGET[start,...]
-
-(define (string-replace! target start source)
-  (let ((len (string-length source)))
-    (do ((i (+ start len -1) (- i 1))
-	 (j (- len 1) (- j 1)))
-      ((< j 0) target)
-      (string-set! target i (string-ref source j)))))
-
-
-;;; Copy SOURCE[source-start, source-end) into TARGET[start,)
-
-(define (substring-replace! target start source source-start source-end)
-  (do ((i (+ start (- source-end source-start) -1) (- i 1))
-       (j (- source-end 1) (- j 1)))
-      ((< j source-start) target)
-    (string-set! target i (string-ref source j))))
-
-
-;;; Compute (... (f (f (f zero c0) c1) c2) ...)
-
-(define (string-reduce f zero s)
-  (let ((len (string-length s)))
-    (let lp ((v zero) (i 0))
-      (if (= i len)
-	  v
-	  (lp (f v (string-ref s i)) (+ i 1))))))
 ;----------------
 ; A record type whose only purpose is to run some code when we start up an
 ; image.