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)))
|
(let ((flags (:optional maybe-flags 0)))
|
||||||
(open-file fname (deposit-bit-field flags open/access-mask open/read))))
|
(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)
|
(define (open-output-file fname . rest)
|
||||||
(let* ((flags (if (pair? rest) (car rest)
|
(let* ((flags (if (pair? rest) (car rest)
|
||||||
(bitwise-ior open/create open/truncate))) ; default
|
(bitwise-ior open/create open/truncate))) ; default
|
||||||
|
|
|
@ -197,7 +197,7 @@
|
||||||
|
|
||||||
(define (need-reaping-remove! pid)
|
(define (need-reaping-remove! pid)
|
||||||
(obtain-lock need-reaping-lock)
|
(obtain-lock need-reaping-lock)
|
||||||
(set! need-reaping (del pid need-reaping))
|
(set! need-reaping (delete pid need-reaping))
|
||||||
(release-lock need-reaping-lock))
|
(release-lock need-reaping-lock))
|
||||||
|
|
||||||
(define (reap-need-reaping)
|
(define (reap-need-reaping)
|
||||||
|
|
|
@ -225,8 +225,7 @@
|
||||||
static-regexp?))
|
static-regexp?))
|
||||||
(standard-char-sets (export nonl-chars word-chars))
|
(standard-char-sets (export nonl-chars word-chars))
|
||||||
(sre-internal-syntax-tools (export expand-rx)))
|
(sre-internal-syntax-tools (export expand-rx)))
|
||||||
(open scsh-utilities
|
(open defrec-package
|
||||||
defrec-package
|
|
||||||
weak
|
weak
|
||||||
;; re-posix-parsers ; regexp->posix-string
|
;; re-posix-parsers ; regexp->posix-string
|
||||||
let-opt
|
let-opt
|
||||||
|
@ -235,6 +234,8 @@
|
||||||
define-record-types
|
define-record-types
|
||||||
defrec-package
|
defrec-package
|
||||||
receiving
|
receiving
|
||||||
|
scsh-utilities
|
||||||
|
(subset srfi-1 (fold every fold-right))
|
||||||
srfi-14
|
srfi-14
|
||||||
error-package
|
error-package
|
||||||
ascii
|
ascii
|
||||||
|
@ -275,8 +276,8 @@
|
||||||
(open re-internals
|
(open re-internals
|
||||||
conditionals
|
conditionals
|
||||||
re-level-0
|
re-level-0
|
||||||
|
(subset srfi-1 (fold))
|
||||||
srfi-14
|
srfi-14
|
||||||
scsh-utilities ; fold
|
|
||||||
error-package
|
error-package
|
||||||
ascii
|
ascii
|
||||||
scheme)
|
scheme)
|
||||||
|
@ -330,7 +331,7 @@
|
||||||
(open re-level-0
|
(open re-level-0
|
||||||
re-match-internals
|
re-match-internals
|
||||||
posix-regexps
|
posix-regexps
|
||||||
scsh-utilities ; fold & some string utilities that need to be moved.
|
(subset srfi-1 (fold))
|
||||||
scsh-level-0 ; write-string
|
scsh-level-0 ; write-string
|
||||||
srfi-13 ; string-copy!
|
srfi-13 ; string-copy!
|
||||||
scheme)
|
scheme)
|
||||||
|
|
|
@ -591,14 +591,11 @@
|
||||||
|
|
||||||
|
|
||||||
(define-interface scsh-utilities-interface
|
(define-interface scsh-utilities-interface
|
||||||
(export del first? filter fold-right
|
(export mapv mapv! vector-every? copy-vector initialize-vector vector-append
|
||||||
fold
|
|
||||||
any every nth
|
|
||||||
mapv mapv! vector-every? copy-vector initialize-vector vector-append
|
|
||||||
vfold vfold-right
|
vfold vfold-right
|
||||||
check-arg conjoin disjoin negate compose reverse! call/cc
|
check-arg conjoin disjoin negate compose
|
||||||
deprecated-proc
|
deprecated-proc
|
||||||
deposit-bit-field
|
;; deposit-bit-field
|
||||||
real->exact-integer
|
real->exact-integer
|
||||||
make-reinitializer
|
make-reinitializer
|
||||||
run-as-long-as
|
run-as-long-as
|
||||||
|
@ -716,8 +713,7 @@
|
||||||
(export join-strings
|
(export join-strings
|
||||||
field-splitter infix-splitter suffix-splitter sloppy-suffix-splitter
|
field-splitter infix-splitter suffix-splitter sloppy-suffix-splitter
|
||||||
record-reader
|
record-reader
|
||||||
field-reader
|
field-reader))
|
||||||
nth)) ; Kinda handy.
|
|
||||||
|
|
||||||
(define-interface scsh-delimited-readers-interface
|
(define-interface scsh-delimited-readers-interface
|
||||||
(export read-line
|
(export read-line
|
||||||
|
|
|
@ -168,6 +168,7 @@
|
||||||
bitwise
|
bitwise
|
||||||
signals
|
signals
|
||||||
conditions
|
conditions
|
||||||
|
(subset srfi-1 (filter reverse! fold delete))
|
||||||
scsh-utilities
|
scsh-utilities
|
||||||
handle
|
handle
|
||||||
fluids thread-fluids
|
fluids thread-fluids
|
||||||
|
@ -371,7 +372,8 @@
|
||||||
(awk-support-package (export next-range next-:range
|
(awk-support-package (export next-range next-:range
|
||||||
next-range: next-:range:)))
|
next-range: next-:range:)))
|
||||||
(open receiving ; receive
|
(open receiving ; receive
|
||||||
scsh-utilities
|
;; scsh-utilities
|
||||||
|
(subset srfi-1 (any filter))
|
||||||
error-package ; error
|
error-package ; error
|
||||||
; scsh-regexp-package
|
; scsh-regexp-package
|
||||||
; re-exports
|
; re-exports
|
||||||
|
|
|
@ -932,12 +932,18 @@
|
||||||
thing))))
|
thing))))
|
||||||
|
|
||||||
(define (exec-path-search prog path-list)
|
(define (exec-path-search prog path-list)
|
||||||
(if (file-name-absolute? prog)
|
(cond
|
||||||
(and (file-executable? prog) prog)
|
((not (file-name-absolute? prog))
|
||||||
(first? (lambda (dir)
|
(let loop ((path-list path-list))
|
||||||
(let ((fname (string-append dir "/" prog)))
|
(if (not (null? path-list))
|
||||||
(and (file-executable? fname) fname)))
|
(let* ((dir (car path-list))
|
||||||
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)
|
(define (exec/env prog env . arglist)
|
||||||
(flush-all-ports)
|
(flush-all-ports)
|
||||||
|
|
|
@ -1,54 +1,6 @@
|
||||||
;;; Random useful utilities.
|
;;; Random useful utilities.
|
||||||
;;; Copyright (c) 1993 by Olin Shivers.
|
;;; 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)
|
(define (mapv f v)
|
||||||
(let* ((len (vector-length v))
|
(let* ((len (vector-length v))
|
||||||
(ans (make-vector len)))
|
(ans (make-vector len)))
|
||||||
|
@ -127,30 +79,6 @@
|
||||||
(define (compose f g)
|
(define (compose f g)
|
||||||
(lambda args (call-with-values (lambda () (apply g args)) f)))
|
(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)
|
(define (deprecated-proc proc name . maybe-preferred-msg)
|
||||||
(let ((warned? #f))
|
(let ((warned? #f))
|
||||||
(lambda args
|
(lambda args
|
||||||
|
@ -167,34 +95,6 @@
|
||||||
(let ((f (round x)))
|
(let ((f (round x)))
|
||||||
(if (inexact? f) (inexact->exact f) f)))
|
(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
|
; A record type whose only purpose is to run some code when we start up an
|
||||||
; image.
|
; image.
|
||||||
|
|
Loading…
Reference in New Issue