Remove a bunch of crud from utilities.scm as well as the dependencies
upon that crud.
This commit is contained in:
parent
7f1879b497
commit
09db2fed71
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue