Remove a bunch of crud from utilities.scm as well as the dependencies

upon that crud.
This commit is contained in:
sperber 2002-08-14 14:45:33 +00:00
parent 7f1879b497
commit 09db2fed71
7 changed files with 30 additions and 121 deletions

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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.