dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* Don't use make-shared-substring any more.

Browse source
This commit is contained in:
Dirk Herrmann 2000-11-28 13:40:40 +00:00
commit 4e15fee80f
6 changed files with 54 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

16
ice-9/ChangeLog
View file

@ -1,3 +1,19 @@
2000-11-28 Dirk Herrmann <D.Herrmann@tu-bs.de>
* boot-9.scm (read-delimited), lineio.scm
(make-line-buffering-input-port), regex.scm (match:prefix,
match:suffix, match:substring, regexp-substitute/global), slib.scm
(slib-parent-dir), string-fun.scm (split-after-char,
split-before-char, split-discarding-char, split-after-char-last,
split-before-char-last, split-discarding-char-last,
split-before-predicate, split-after-predicate,
split-discarding-predicate, separate-fields-discarding-char,
separate-fields-after-char, separate-fields-before-char,
string-prefix-predicate, sans-surrounding-whitespace,
sans-trailing-whitespace, sans-leading-whitespace,
sans-final-newline): Use substring instead of
make-shared-substring.
2000-11-26 Gary Houston <ghouston@arglist.com>
* boot-9.scm: values?, get-values, values, call-with-values:

2
ice-9/boot-9.scm
View file

@ -254,7 +254,7 @@
(not (eof-object? terminator)))
(string terminator)
"")
(cons (make-shared-substring buf 0 nchars)
(cons (substring buf 0 nchars)
substrings))))))
(new-total (+ total-chars nchars)))
(cond ((not terminator)

2
ice-9/lineio.scm
View file

@ -86,7 +86,7 @@
(let ((c (string-ref (car buffers))))
(if (= 1 (string-length (car buffers)))
(set! buffers (cdr buffers))
(set-car! buffers (make-shared-substring (car buffers) 1)))
(set-car! buffers (substring (car buffers) 1)))
c))))
(propogate-close (lambda () (close-port underlying-port)))

15
ice-9/regex.scm
View file

@ -36,13 +36,10 @@
(vector-ref match 0))
(define-public (match:prefix match)
(make-shared-substring (match:string match)
0
(match:start match 0)))
(substring (match:string match) 0 (match:start match 0)))
(define-public (match:suffix match)
(make-shared-substring (match:string match)
(match:end match 0)))
(substring (match:string match) (match:end match 0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; SCSH compatibility routines.
@ -90,9 +87,7 @@
0))
(start (match:start match matchnum))
(end (match:end match matchnum)))
(and start end (make-shared-substring (match:string match)
start
end))))
(and start end (substring (match:string match) start end))))
(define-public (string-match pattern str . args)
(let ((rx (make-regexp pattern))
@ -167,7 +162,7 @@
(let next-match ((matches (list-matches regexp string))
(start 0))
(if (null? matches)
(display (make-shared-substring string start) port)
(display (substring string start) port)
(let ((m (car matches)))
;; Process all of the items for this match. Don't use
@ -182,7 +177,7 @@
((procedure? item) (display (item m) port))
((eq? item 'pre)
(display
(make-shared-substring string start (match:start m))
(substring string start (match:start m))
port))
((eq? item 'post)
(next-match (cdr matches) (match:end m)))

2
ice-9/slib.scm
View file

@ -162,7 +162,7 @@
(define slib-parent-dir
(let* ((path (%search-load-path "slib/require.scm")))
(if path
(make-shared-substring path 0 (- (string-length path) 17))
(substring path 0 (- (string-length path) 17))
(error "Could not find slib/require.scm in " %load-path))))
(define-public (implementation-vicinity)

60
ice-9/string-fun.scm
View file

@ -92,71 +92,71 @@
(let ((end (cond
((string-index str char) => 1+)
(else (string-length str)))))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(ret (substring str 0 end)
(substring str end))))
(define-public (split-before-char char str ret)
(let ((end (or (string-index str char)
(string-length str))))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(ret (substring str 0 end)
(substring str end))))
(define-public (split-discarding-char char str ret)
(let ((end (string-index str char)))
(if (not end)
(ret str "")
(ret (make-shared-substring str 0 end)
(make-shared-substring str (1+ end))))))
(ret (substring str 0 end)
(substring str (1+ end))))))
(define-public (split-after-char-last char str ret)
(let ((end (cond
((string-rindex str char) => 1+)
(else 0))))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(ret (substring str 0 end)
(substring str end))))
(define-public (split-before-char-last char str ret)
(let ((end (or (string-rindex str char) 0)))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(ret (substring str 0 end)
(substring str end))))
(define-public (split-discarding-char-last char str ret)
(let ((end (string-rindex str char)))
(if (not end)
(ret str "")
(ret (make-shared-substring str 0 end)
(make-shared-substring str (1+ end))))))
(ret (substring str 0 end)
(substring str (1+ end))))))
(define-public (split-before-predicate pred str ret)
(let loop ((n 0))
(cond
((= n (string-length str)) (ret str ""))
((not (pred (string-ref str n))) (loop (1+ n)))
(else (ret (make-shared-substring str 0 n)
(make-shared-substring str n))))))
(else (ret (substring str 0 n)
(substring str n))))))
(define-public (split-after-predicate pred str ret)
(let loop ((n 0))
(cond
((= n (string-length str)) (ret str ""))
((not (pred (string-ref str n))) (loop (1+ n)))
(else (ret (make-shared-substring str 0 (1+ n))
(make-shared-substring str (1+ n)))))))
(else (ret (substring str 0 (1+ n))
(substring str (1+ n)))))))
(define-public (split-discarding-predicate pred str ret)
(let loop ((n 0))
(cond
((= n (string-length str)) (ret str ""))
((not (pred (string-ref str n))) (loop (1+ n)))
(else (ret (make-shared-substring str 0 n)
(make-shared-substring str (1+ n)))))))
(else (ret (substring str 0 n)
(substring str (1+ n)))))))
(define-public (separate-fields-discarding-char ch str ret)
(let loop ((fields '())
(str str))
(cond
((string-rindex str ch)
=> (lambda (w) (loop (cons (make-shared-substring str (+ 1 w)) fields)
(make-shared-substring str 0 w))))
=> (lambda (w) (loop (cons (substring str (+ 1 w)) fields)
(substring str 0 w))))
(else (apply ret str fields)))))
(define-public (separate-fields-after-char ch str ret)
@ -165,8 +165,8 @@
(str str))
(cond
((string-index str ch)
=> (lambda (w) (loop (cons (make-shared-substring str 0 (+ 1 w)) fields)
(make-shared-substring str (+ 1 w)))))
=> (lambda (w) (loop (cons (substring str 0 (+ 1 w)) fields)
(substring str (+ 1 w)))))
(else (apply ret str fields))))))
(define-public (separate-fields-before-char ch str ret)
@ -174,8 +174,8 @@
(str str))
(cond
((string-rindex str ch)
=> (lambda (w) (loop (cons (make-shared-substring str w) fields)
(make-shared-substring str 0 w))))
=> (lambda (w) (loop (cons (substring str w) fields)
(substring str 0 w))))
(else (apply ret str fields)))))
@ -185,14 +185,14 @@
;;;
;;; (define-public ((string-prefix-predicate pred?) prefix str)
;;; (and (<= (string-length prefix) (string-length str))
;;; (pred? prefix (make-shared-substring str 0 (string-length prefix)))))
;;; (pred? prefix (substring str 0 (string-length prefix)))))
;;;
;;; (define-public string-prefix=? (string-prefix-predicate string=?))
;;;
(define-public ((string-prefix-predicate pred?) prefix str)
(and (<= (string-length prefix) (string-length str))
(pred? prefix (make-shared-substring str 0 (string-length prefix)))))
(pred? prefix (substring str 0 (string-length prefix)))))
(define-public string-prefix=? (string-prefix-predicate string=?))
@ -218,7 +218,7 @@
(set! end (1- end)))
(if (< end st)
""
(make-shared-substring s st end))))
(substring s st end))))
(define-public (sans-trailing-whitespace s)
(let ((st 0)
@ -228,7 +228,7 @@
(set! end (1- end)))
(if (< end st)
""
(make-shared-substring s st end))))
(substring s st end))))
(define-public (sans-leading-whitespace s)
(let ((st 0)
@ -238,7 +238,7 @@
(set! st (1+ st)))
(if (< end st)
""
(make-shared-substring s st end))))
(substring s st end))))
(define-public (sans-final-newline str)
(cond
@ -246,7 +246,7 @@
str)
((char=? #\nl (string-ref str (1- (string-length str))))
(make-shared-substring str 0 (1- (string-length str))))
(substring str 0 (1- (string-length str))))
(else str)))